Upgrade to Pod::Parser 1.33

p4raw-id: //depot/perl@25543

6 files changed, 75 insertions, 49 deletions

diff --git a/lib/Pod/Checker.pm b/lib/Pod/Checker.pm
index f20fe84c4c..49162da4a2 100644
--- a/lib/Pod/Checker.pm
+++ b/lib/Pod/Checker.pm
@@ -10,7 +10,7 @@
 package Pod::Checker;
 
 use vars qw($VERSION);
-$VERSION = 1.42;  ## Current version of this package
+$VERSION = 1.43;  ## Current version of this package
 require  5.005;    ## requires this Perl version or later
 
 use Pod::ParseUtils; ## for hyperlinks and lists
@@ -57,7 +57,7 @@ Curious/ambitious users are welcome to propose additional features they wish
 to see in B<Pod::Checker> and B<podchecker> and verify that the checks are
 consistent with L<perlpod>.
 
-The following checks are currently preformed:
+The following checks are currently performed:
 
 =over 4
 
@@ -142,7 +142,7 @@ There is no specification of the formatter after the C<=for> command.
 =item * unresolved internal link I<NAME>
 
 The given link to I<NAME> does not have a matching node in the current
-POD. This also happens when a single word node name is not enclosed in
+POD. This also happend when a single word node name is not enclosed in
 C<"">.
 
 =item * Unknown command "I<CMD>"
@@ -234,7 +234,7 @@ C<=over>/C<=back> block.
 
 =item * =item type mismatch (I<one> vs. I<two>)
 
-A list started with e.g. a bulleted C<=item> and continued with a
+A list started with e.g. a bulletted C<=item> and continued with a
 numbered one. This is obviously inconsistent. For most translators the
 type of the I<first> C<=item> determines the type of the list.
 
@@ -623,9 +623,11 @@ sub poderror {
         if(!%opts || ($opts{-severity} && $opts{-severity} eq 'ERROR'));
     ++($self->{_NUM_WARNINGS})
         if(!%opts || ($opts{-severity} && $opts{-severity} eq 'WARNING'));
-    my $out_fh = $self->output_handle() || \*STDERR;
-    print $out_fh ($severity, $msg, $line, $file, "\n")
-      if($self->{-warnings} || !%opts || $opts{-severity} ne 'WARNING');
+    unless($self->{-quiet}) {
+      my $out_fh = $self->output_handle() || \*STDERR;
+      print $out_fh ($severity, $msg, $line, $file, "\n")
+        if($self->{-warnings} || !%opts || $opts{-severity} ne 'WARNING');
+    }
 }
 
 ##################################
@@ -1101,7 +1103,7 @@ sub _check_ptree {
         }
         if($nestlist =~ /$cmd/) {
             $self->poderror({ -line => $line, -file => $file,
-                 -severity => 'ERROR', 
+                 -severity => 'WARNING', 
                  -msg => "nested commands $cmd<...$cmd<...>...>"});
             # _TODO_ should we add the contents anyway?
             # expand it anyway, see below
diff --git a/lib/Pod/InputObjects.pm b/lib/Pod/InputObjects.pm
index 222061f55e..fa5f61f9a7 100644
--- a/lib/Pod/InputObjects.pm
+++ b/lib/Pod/InputObjects.pm
@@ -183,7 +183,7 @@ sub name {
         my $handle = $pod_input->handle();
 
 Returns a reference to the handle object from which input is read (the
-one used to construct this input source object).
+one used to contructed this input source object).
 
 =end __PRIVATE__
 
diff --git a/lib/Pod/ParseUtils.pm b/lib/Pod/ParseUtils.pm
index 64c92b6da6..878860121d 100644
--- a/lib/Pod/ParseUtils.pm
+++ b/lib/Pod/ParseUtils.pm
@@ -10,7 +10,7 @@
 package Pod::ParseUtils;
 
 use vars qw($VERSION);
-$VERSION = 1.30;   ## Current version of this package
+$VERSION = 1.33;   ## Current version of this package
 require  5.005;    ## requires this Perl version or later
 
 =head1 NAME
@@ -357,7 +357,7 @@ sub parse {
         $type = 'item';
     }
     # non-standard: Hyperlink
-    elsif(m!^((?:http|ftp|mailto|news):.+)$!i) {
+    elsif(m!^(\w+:[^:\s]\S*)$!i) {
         $node = $1;
         $type = 'hyperlink';
     }
@@ -371,7 +371,7 @@ sub parse {
         ($alttext, $node) = ($1,$2);
     }
     # nonstandard: alttext and hyperlink
-    elsif(m!^(.*?)\s*[|]\s*((?:http|ftp|mailto|news):.+)$!) {
+    elsif(m!^(.*?)\s*[|]\s*(\w+:[^:\s]\S*)$!) {
         ($alttext, $node) = ($1,$2);
         $type = 'hyperlink';
     }
diff --git a/lib/Pod/Parser.pm b/lib/Pod/Parser.pm
index 6c3f161815..a5fde84850 100644
--- a/lib/Pod/Parser.pm
+++ b/lib/Pod/Parser.pm
@@ -10,7 +10,7 @@
 package Pod::Parser;
 
 use vars qw($VERSION);
-$VERSION = 1.30;  ## Current version of this package
+$VERSION = 1.32;  ## Current version of this package
 require  5.005;    ## requires this Perl version or later
 
 #############################################################################
@@ -118,7 +118,7 @@ You may also want to override the B<begin_input()> and B<end_input()>
 methods for your subclass (to perform any needed per-file and/or
 per-document initialization or cleanup).
 
-If you need to perform any preprocessing of input before it is parsed
+If you need to perform any preprocesssing of input before it is parsed
 you may want to override one or more of B<preprocess_line()> and/or
 B<preprocess_paragraph()>.
 
@@ -140,7 +140,7 @@ to avoid name collisions.
 
 For the most part, the B<Pod::Parser> base class should be able to
 do most of the input parsing for you and leave you free to worry about
-how to interpret the commands and translate the result.
+how to intepret the commands and translate the result.
 
 Note that all we have described here in this quick overview is the
 simplest most straightforward use of B<Pod::Parser> to do stream-based
@@ -651,7 +651,7 @@ them in simple bottom-up order.
 
 The parameter C<$text> is a string or block of text to be parsed
 for interior sequences; and the parameter C<$line_num> is the
-line number corresponding to the beginning of C<$text>.
+line number curresponding to the beginning of C<$text>.
 
 B<parse_text()> will parse the given text into a parse-tree of "nodes."
 and interior-sequences.  Each "node" in the parse tree is either a
@@ -1066,7 +1066,6 @@ sub parse_from_filehandle {
     while (defined ($textline = $tied_fh ? <$in_fh> : $in_fh->getline)) {
         $textline = $self->preprocess_line($textline, ++$nlines);
         next  unless ((defined $textline)  &&  (length $textline));
-        $_ = $paragraph;  ## save previous contents
 
         if ((! length $paragraph) && ($textline =~ /^==/)) {
             ## '==' denotes a one-line command paragraph
@@ -1157,20 +1156,13 @@ sub parse_from_file {
     my $self = shift;
     my %opts = (ref $_[0] eq 'HASH') ? %{ shift() } : ();
     my ($infile, $outfile) = @_;
-    my ($in_fh,  $out_fh) = (gensym, gensym)  if ($] < 5.6);
+    my ($in_fh,  $out_fh) = (gensym(), gensym())  if ($] < 5.006);
     my ($close_input, $close_output) = (0, 0);
     local *myData = $self;
     local *_;
 
     ## Is $infile a filename or a (possibly implied) filehandle
-    $infile  = '-'  unless ((defined $infile) && (length $infile));
-    if (($infile  eq '-') || ($infile =~ /^<&(STDIN|0)$/i)) {
-        ## Not a filename, just a string implying STDIN
-        $infile ||= '-';
-        $myData{_INFILE} = "<standard input>";
-        $in_fh = \*STDIN;
-    }
-    elsif (ref $infile) {
+    if (defined $infile && ref $infile) {
         if (ref($infile) =~ /^(SCALAR|ARRAY|HASH|CODE|REF)$/) {
             croak "Input from $1 reference not supported!\n";
         }
@@ -1179,6 +1171,14 @@ sub parse_from_file {
         $myData{_INFILE} = ${$infile};
         $in_fh = $infile;
     }
+    elsif (!defined($infile) || !length($infile) || ($infile eq '-')
+        || ($infile =~ /^<&(?:STDIN|0)$/i))
+    {
+        ## Not a filename, just a string implying STDIN
+        $infile ||= '-';
+        $myData{_INFILE} = "<standard input>";
+        $in_fh = \*STDIN;
+    }
     else {
         ## We have a filename, open it for reading
         $myData{_INFILE} = $infile;
@@ -1194,20 +1194,7 @@ sub parse_from_file {
     ## already
 
     ## Is $outfile a filename, a (possibly implied) filehandle, maybe a ref?
-    if (!defined($outfile) || !length($outfile) || ($outfile eq '-')
-        || ($outfile =~ /^>&?(?:STDOUT|1)$/i))
-    {
-        if (defined $myData{_TOP_STREAM}) {
-            $out_fh = $myData{_OUTPUT};
-        }
-        else {
-            ## Not a filename, just a string implying STDOUT
-            $outfile ||= '-';
-            $myData{_OUTFILE} = "<standard output>";
-            $out_fh  = \*STDOUT;
-        }
-    }
-    elsif (ref $outfile) {
+    if (ref $outfile) {
         ## we need to check for ref() first, as other checks involve reading
         if (ref($outfile) =~ /^(ARRAY|HASH|CODE)$/) {
             croak "Output to $1 reference not supported!\n";
@@ -1227,6 +1214,19 @@ sub parse_from_file {
             $out_fh = $outfile;
         }
     }
+    elsif (!defined($outfile) || !length($outfile) || ($outfile eq '-')
+        || ($outfile =~ /^>&?(?:STDOUT|1)$/i))
+    {
+        if (defined $myData{_TOP_STREAM}) {
+            $out_fh = $myData{_OUTPUT};
+        }
+        else {
+            ## Not a filename, just a string implying STDOUT
+            $outfile ||= '-';
+            $myData{_OUTFILE} = "<standard output>";
+            $out_fh  = \*STDOUT;
+        }
+    }
     elsif ($outfile =~ /^>&(STDERR|2)$/i) {
         ## Not a filename, just a string implying STDERR
         $myData{_OUTFILE} = "<standard error>";
diff --git a/lib/Pod/Select.pm b/lib/Pod/Select.pm
index d0cbec6901..1cc14dff4b 100644
--- a/lib/Pod/Select.pm
+++ b/lib/Pod/Select.pm
@@ -428,7 +428,7 @@ sub clear_selections {
 Returns a value of true if the given section and subsection heading
 titles match any of the currently selected section specifications in
 effect from prior calls to B<select()> and B<add_selection()> (or if
-there are no explicitly selected/deselected sections).
+there are no explictly selected/deselected sections).
 
 The arguments C<$heading1>, C<$heading2>, etc. are the heading titles of
 the corresponding sections, subsections, etc. to try and match.  If
@@ -575,7 +575,7 @@ are used.
 
 All other arguments should correspond to the names of input files
 containing POD sections. A file name of "-" or "<&STDIN" will
-be interpreted to mean standard input (which is the default if no
+be interpeted to mean standard input (which is the default if no
 filenames are given).
 
 =cut 
diff --git a/lib/Pod/Usage.pm b/lib/Pod/Usage.pm
index 0827dcc4d2..c298e941f2 100644
--- a/lib/Pod/Usage.pm
+++ b/lib/Pod/Usage.pm
@@ -10,7 +10,7 @@
 package Pod::Usage;
 
 use vars qw($VERSION);
-$VERSION = 1.30;  ## Current version of this package
+$VERSION = 1.33;  ## Current version of this package
 require  5.005;    ## requires this Perl version or later
 
 =head1 NAME
@@ -40,6 +40,9 @@ Pod::Usage, pod2usage() - print a usage message from embedded pod documentation
                -verbose => $verbose_level,  
                -output  => $filehandle   );
 
+  pod2usage(   -verbose => 2,
+               -noperldoc => 1  )
+
 =head1 ARGUMENTS
 
 B<pod2usage> should be given either a single argument, or a list of
@@ -94,7 +97,8 @@ is 1, then the "SYNOPSIS" section, along with any section entitled
 corresponding value is 2 or more then the entire manpage is printed.
 
 The special verbosity level 99 requires to also specify the -section
-parameter; then these sections are extracted and printed.
+parameter; then these sections are extracted (see L<Pod::Select>)
+and printed.
 
 =item C<-section>
 
@@ -123,6 +127,14 @@ to an array, or by a string of directory paths which use the same path
 separator as C<$ENV{PATH}> on your system (e.g., C<:> for Unix, C<;> for
 MSWin32 and DOS).
 
+=item C<-noperldoc>
+
+By default, Pod::Usage will call L<perldoc> when -verbose >= 2 is
+specified. This does not work well e.g. if the script was packed
+with L<PAR>. The -noperldoc option suppresses the external call to
+L<perldoc> and uses the simple text formatter (L<Pod::Text>) to 
+output the POD.
+
 =back
 
 =head1 DESCRIPTION
@@ -200,8 +212,8 @@ to C<STDOUT>, just in case the user wants to pipe the output to a pager
 =item *
 
 If program usage has been explicitly requested by the user, it is often
-desirable to exit with a status of 1 (as opposed to 0) after issuing
-the user-requested usage message.  It is also desirable to give a
+desireable to exit with a status of 1 (as opposed to 0) after issuing
+the user-requested usage message.  It is also desireable to give a
 more verbose description of program usage in this case.
 
 =back
@@ -387,6 +399,11 @@ similar to the following:
 
     pod2usage(-exitval => 2, -input => "/path/to/your/pod/docs");
 
+In the pathological case that a script is called via a relative path
+I<and> the script itself changes the current working directory
+(see L<perlfunc/chdir>) I<before> calling pod2usage, Pod::Usage will
+fail even on robust platforms. Don't do that.
+
 =head1 AUTHOR
 
 Please report bugs using L<http://rt.cpan.org>.
@@ -433,7 +450,7 @@ BEGIN {
 ##---------------------------------
 
 sub pod2usage {
-    local($_) = shift || "";
+    local($_) = shift;
     my %opts;
     ## Collect arguments
     if (@_ > 0) {
@@ -441,6 +458,9 @@ sub pod2usage {
         ## the user forgot to pass a reference to it.
         %opts = ($_, @_);
     }
+    elsif (!defined $_) {
+      $_ = "";
+    }
     elsif (ref $_) {
         ## User passed a ref to a hash
         %opts = %{$_}  if (ref($_) eq 'HASH');
@@ -503,7 +523,7 @@ sub pod2usage {
     ## Now create a pod reader and constrain it to the desired sections.
     my $parser = new Pod::Usage(USAGE_OPTIONS => \%opts);
     if ($opts{"-verbose"} == 0) {
-        $parser->select("SYNOPSIS");
+        $parser->select('SYNOPSIS\s*');
     }
     elsif ($opts{"-verbose"} == 1) {
         my $opt_re = '(?i)' .
@@ -517,7 +537,8 @@ sub pod2usage {
     }
 
     ## Now translate the pod document and then exit with the desired status
-    if ( $opts{"-verbose"} >= 2 
+    if ( !$opts{"-noperldoc"}
+             and  $opts{"-verbose"} >= 2 
              and  !ref($opts{"-input"})
              and  $opts{"-output"} == \*STDOUT )
     {
@@ -562,6 +583,9 @@ sub select {
     }
 }
 
+# Override Pod::Text->seq_i to return just "arg", not "*arg*".
+sub seq_i { return $_[1] }
+
 # This overrides the Pod::Text method to do something very akin to what
 # Pod::Select did as well as the work done below by preprocess_paragraph.
 # Note that the below is very, very specific to Pod::Text.