Upgrade to Pod::Parser 1.30

p4raw-id: //depot/perl@24034

7 files changed, 139 insertions, 38 deletions

diff --git a/lib/Pod/Checker.pm b/lib/Pod/Checker.pm
index 1e01392af0..aeb550d521 100644
--- a/lib/Pod/Checker.pm
+++ b/lib/Pod/Checker.pm
@@ -204,6 +204,7 @@ These may not necessarily cause trouble, but indicate mediocre style.
 
 The POD file has some C<=item> and/or C<=head> commands that have
 the same text. Potential hyperlinks to such a text cannot be unique then.
+This warning is printed only with warning level greater than one.
 
 =item * line containing nothing but whitespace in paragraph
 
@@ -786,11 +787,13 @@ sub end_pod {
 
     # check the internal nodes for uniqueness. This pertains to
     # =headX, =item and X<...>
-    foreach(grep($self->{_unique_nodes}->{$_} > 1,
-      keys %{$self->{_unique_nodes}})) {
-        $self->poderror({ -line => '-', -file => $infile,
+    if($self->{-warnings} && $self->{-warnings}>1) {
+      foreach(grep($self->{_unique_nodes}->{$_} > 1,
+        keys %{$self->{_unique_nodes}})) {
+          $self->poderror({ -line => '-', -file => $infile,
             -severity => 'WARNING',
             -msg => "multiple occurrence of link target '$_'"});
+      }
     }
 
     # no POD found here
diff --git a/lib/Pod/Find.pm b/lib/Pod/Find.pm
index bfd6f4067e..7911a55cf5 100644
--- a/lib/Pod/Find.pm
+++ b/lib/Pod/Find.pm
@@ -13,7 +13,7 @@
 package Pod::Find;
 
 use vars qw($VERSION);
-$VERSION = 0.24_01;   ## Current version of this package
+$VERSION = 1.30;   ## Current version of this package
 require  5.005;   ## requires this Perl version or later
 use Carp;
 
@@ -43,6 +43,9 @@ so be sure to specify them in the B<use> statement if you need them:
 
   use Pod::Find qw(pod_find);
 
+From this version on the typical SCM (software configuration management)
+files/directories like RCS, CVS, SCCS, .svn are ignored.
+
 =cut
 
 use strict;
diff --git a/lib/Pod/InputObjects.pm b/lib/Pod/InputObjects.pm
index d895b104a4..fa5f61f9a7 100644
--- a/lib/Pod/InputObjects.pm
+++ b/lib/Pod/InputObjects.pm
@@ -11,7 +11,7 @@
 package Pod::InputObjects;
 
 use vars qw($VERSION);
-$VERSION = 1.14;  ## Current version of this package
+$VERSION = 1.30;  ## Current version of this package
 require  5.005;    ## requires this Perl version or later
 
 #############################################################################
diff --git a/lib/Pod/ParseUtils.pm b/lib/Pod/ParseUtils.pm
index ecebac8a08..64c92b6da6 100644
--- a/lib/Pod/ParseUtils.pm
+++ b/lib/Pod/ParseUtils.pm
@@ -10,7 +10,7 @@
 package Pod::ParseUtils;
 
 use vars qw($VERSION);
-$VERSION = 1.20;   ## Current version of this package
+$VERSION = 1.30;   ## Current version of this package
 require  5.005;    ## requires this Perl version or later
 
 =head1 NAME
diff --git a/lib/Pod/Parser.pm b/lib/Pod/Parser.pm
index d12e01624a..fc8fbc1007 100644
--- a/lib/Pod/Parser.pm
+++ b/lib/Pod/Parser.pm
@@ -10,7 +10,7 @@
 package Pod::Parser;
 
 use vars qw($VERSION);
-$VERSION = 1.14;  ## Current version of this package
+$VERSION = 1.30;  ## Current version of this package
 require  5.005;    ## requires this Perl version or later
 
 #############################################################################
@@ -1146,6 +1146,8 @@ performed). If the special output filename ">&STDERR" is given then the
 STDERR filehandle is used for output (and no open or close is
 performed). If no output filehandle is currently in use and no output
 filename is specified, then "-" is implied.
+Alternatively, an L<IO::String> object is also accepted as an output
+file handle.
 
 This method does I<not> usually need to be overridden by subclasses.
 
@@ -1158,16 +1160,20 @@ sub parse_from_file {
     my ($in_fh,  $out_fh) = (gensym, gensym)  if ($] < 5.6);
     my ($close_input, $close_output) = (0, 0);
     local *myData = $self;
-    local $_;
+    local *_;
 
     ## Is $infile a filename or a (possibly implied) filehandle
-    $infile  = '-'  unless ((defined $infile)  && (length $infile));
+    $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 (ref($infile) =~ /^(SCALAR|ARRAY|HASH|CODE|REF)$/) {
+            croak "Input from $1 reference not supported!\n";
+        }
         ## Must be a filehandle-ref (or else assume its a ref to an object
         ## that supports the common IO read operations).
         $myData{_INFILE} = ${$infile};
@@ -1186,37 +1192,53 @@ sub parse_from_file {
     ## the entire document (but *not* if this is an included file). We
     ## determine this by seeing if the input stream stack has been set-up
     ## already
-    ## 
-    unless ((defined $outfile) && (length $outfile)) {
-        (defined $myData{_TOP_STREAM}) && ($out_fh  = $myData{_OUTPUT})
-                                       || ($outfile = '-');
-    }
-    ## Is $outfile a filename or a (possibly implied) filehandle
-    if ((defined $outfile) && (length $outfile)) {
-        if (($outfile  eq '-') || ($outfile =~ /^>&?(?:STDOUT|1)$/i)) {
+
+    ## 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 ($outfile =~ /^>&(STDERR|2)$/i) {
-            ## Not a filename, just a string implying STDERR
-            $myData{_OUTFILE} = "<standard error>";
-            $out_fh  = \*STDERR;
+    }
+    elsif (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";
+        }
+        elsif (ref($outfile) eq 'SCALAR') {
+#           # NOTE: IO::String isn't a part of the perl distribution,
+#           #       so probably we shouldn't support this case...
+#           require IO::String;
+#           $myData{_OUTFILE} = "$outfile";
+#           $out_fh = IO::String->new($outfile);
+            croak "Output to SCALAR reference not supported!\n";
         }
-        elsif (ref $outfile) {
+        else {
             ## Must be a filehandle-ref (or else assume its a ref to an
             ## object that supports the common IO write operations).
             $myData{_OUTFILE} = ${$outfile};
             $out_fh = $outfile;
         }
-        else {
-            ## We have a filename, open it for writing
-            $myData{_OUTFILE} = $outfile;
-            (-d $outfile) and croak "$outfile is a directory, not POD input!\n";
-            open($out_fh, "> $outfile")  or
-                 croak "Can't open $outfile for writing: $!\n";
-            $close_output = 1;
-        }
+    }
+    elsif ($outfile =~ /^>&(STDERR|2)$/i) {
+        ## Not a filename, just a string implying STDERR
+        $myData{_OUTFILE} = "<standard error>";
+        $out_fh  = \*STDERR;
+    }
+    else {
+        ## We have a filename, open it for writing
+        $myData{_OUTFILE} = $outfile;
+        (-d $outfile) and croak "$outfile is a directory, not POD input!\n";
+        open($out_fh, "> $outfile")  or
+             croak "Can't open $outfile for writing: $!\n";
+        $close_output = 1;
     }
 
     ## Whew! That was a lot of work to set up reasonably/robust behavior
@@ -1774,3 +1796,4 @@ Tom Christiansen E<lt>tchrist@mox.perl.comE<gt>
 =cut
 
 1;
+# vim: ts=4 sw=4 et
diff --git a/lib/Pod/Select.pm b/lib/Pod/Select.pm
index 8b98544338..1cc14dff4b 100644
--- a/lib/Pod/Select.pm
+++ b/lib/Pod/Select.pm
@@ -10,7 +10,7 @@
 package Pod::Select;
 
 use vars qw($VERSION);
-$VERSION = 1.13;  ## Current version of this package
+$VERSION = 1.30;  ## Current version of this package
 require  5.005;    ## requires this Perl version or later
 
 #############################################################################
@@ -505,7 +505,8 @@ sub is_selected {
 
     ## Keep track of current sections levels and headings
     $_ = $paragraph;
-    if (/^=((?:sub)*)(?:head(?:ing)?|sec(?:tion)?)(\d*)\s+(.*)\s*$/) {
+    if (/^=((?:sub)*)(?:head(?:ing)?|sec(?:tion)?)(\d*)\s+(.*)\s*$/)
+    {
         ## This is a section heading command
         my ($level, $heading) = ($2, $3);
         $level = 1 + (length($1) / 3)  if ((! length $level) || (length $1));
@@ -581,15 +582,15 @@ filenames are given).
 
 sub podselect {
     my(@argv) = @_;
-    my %defaults   = ();
+    my %defaults = ();
     my $pod_parser = new Pod::Select(%defaults);
     my $num_inputs = 0;
     my $output = ">&STDOUT";
-    my %opts = ();
+    my %opts;
     local $_;
     for (@argv) {
         if (ref($_)) {
-            next unless (ref($_) eq 'HASH');
+        next unless (ref($_) eq 'HASH');
             %opts = (%defaults, %{$_});
 
             ##-------------------------------------------------------------
@@ -750,4 +751,4 @@ Tom Christiansen E<lt>tchrist@mox.perl.comE<gt>
 =cut
 
 1;
-
+# vim: ts=4 sw=4 et
diff --git a/lib/Pod/Usage.pm b/lib/Pod/Usage.pm
index 236ef65c56..16056ac688 100644
--- a/lib/Pod/Usage.pm
+++ b/lib/Pod/Usage.pm
@@ -10,7 +10,7 @@
 package Pod::Usage;
 
 use vars qw($VERSION);
-$VERSION = 1.16_01;  ## Current version of this package
+$VERSION = 1.30;  ## Current version of this package
 require  5.005;    ## requires this Perl version or later
 
 =head1 NAME
@@ -93,6 +93,14 @@ is 1, then the "SYNOPSIS" section, along with any section entitled
 "OPTIONS", "ARGUMENTS", or "OPTIONS AND ARGUMENTS" is printed.  If the
 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.
+
+=item C<-section>
+
+A string representing a selection list for sections to be printed
+when -verbose is set to 99, e.g. C<"NAME|SYNOPSIS|DESCRIPTION|VERSION">.
+
 =item C<-output>
 
 A reference to a filehandle, or the pathname of a file to which the
@@ -503,6 +511,10 @@ sub pod2usage {
                      '(?:\s*(?:AND|\/)\s*(?:OPTIONS|ARGUMENTS))?';
         $parser->select( 'SYNOPSIS', $opt_re, "DESCRIPTION/$opt_re" );
     }
+    elsif ($opts{"-verbose"} == 99) {
+        $parser->select( $opts{"-sections"} );
+        $opts{"-verbose"} = 1;
+    }
 
     ## Now translate the pod document and then exit with the desired status
     if ( $opts{"-verbose"} >= 2 
@@ -532,10 +544,69 @@ sub new {
     my %params = @_;
     my $self = {%params};
     bless $self, $class;
-    $self->initialize();
+    if ($self->can('initialize')) {
+        $self->initialize();
+    } else {
+        $self = $self->SUPER::new();
+        %$self = (%$self, %params);
+    }
     return $self;
 }
 
+sub select {
+    my ($self, @res) = @_;
+    if ($ISA[0]->can('select')) {
+        $self->SUPER::select(@_);
+    } else {
+        $self->{USAGE_SELECT} = \@res;
+    }
+}
+
+# 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.
+sub _handle_element_end {
+    my ($self, $element) = @_;
+    if ($element eq 'head1') {
+        $$self{USAGE_HEAD1} = $$self{PENDING}[-1][1];
+        $$self{PENDING}[-1][1] =~ s/^\s*SYNOPSIS\s*$/USAGE/;
+    } elsif ($element eq 'head2') {
+        $$self{USAGE_HEAD2} = $$self{PENDING}[-1][1];
+    }
+    if ($element eq 'head1' || $element eq 'head2') {
+        $$self{USAGE_SKIPPING} = 1;
+        my $heading = $$self{USAGE_HEAD1};
+        $heading .= '/' . $$self{USAGE_HEAD2} if defined $$self{USAGE_HEAD2};
+        for (@{ $$self{USAGE_SELECT} }) {
+            if ($heading =~ /^$_\s*$/) {
+                $$self{USAGE_SKIPPING} = 0;
+                last;
+            }
+        }
+
+        # Try to do some lowercasing instead of all-caps in headings, and use
+        # a colon to end all headings.
+        local $_ = $$self{PENDING}[-1][1];
+        s{([A-Z])([A-Z]+)}{((length($2) > 2) ? $1 : lc($1)) . lc($2)}ge;
+        s/\s*$/:/  unless (/:\s*$/);
+        $_ .= "\n";
+        $$self{PENDING}[-1][1] = $_;
+    }
+    if ($$self{USAGE_SKIPPING}) {
+        pop @{ $$self{PENDING} };
+    } else {
+        $self->SUPER::_handle_element_end($element);
+    }
+}
+
+sub start_document {
+    my $self = shift;
+    $self->SUPER::start_document();
+    my $msg = $self->{USAGE_OPTIONS}->{-message}  or  return 1;
+    my $out_fh = $self->output_fh();
+    print $out_fh "$msg\n";
+}
+
 sub begin_pod {
     my $self = shift;
     $self->SUPER::begin_pod();  ## Have to call superclass