From: Rafael Garcia-Suarez Date: Sun, 13 Mar 2005 16:41:05 +0000 (+0000) Subject: Upgrade to Pod::Parser 1.30 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=d5c61f7c3478189627500a82494061b415064f59;p=p5sagit%2Fp5-mst-13.2.git Upgrade to Pod::Parser 1.30 p4raw-id: //depot/perl@24034 --- diff --git a/lib/Pod/Checker.pm b/lib/Pod/Checker.pm index 1e01392..aeb550d 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 bfd6f40..7911a55 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 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 d895b10..fa5f61f 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 ecebac8..64c92b6 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 d12e016..fc8fbc1 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 object is also accepted as an output +file handle. This method does I 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} = ""; $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} = ""; $out_fh = \*STDOUT; } - elsif ($outfile =~ /^>&(STDERR|2)$/i) { - ## Not a filename, just a string implying STDERR - $myData{_OUTFILE} = ""; - $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} = ""; + $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 Etchrist@mox.perl.comE =cut 1; +# vim: ts=4 sw=4 et diff --git a/lib/Pod/Select.pm b/lib/Pod/Select.pm index 8b98544..1cc14df 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 Etchrist@mox.perl.comE =cut 1; - +# vim: ts=4 sw=4 et diff --git a/lib/Pod/Usage.pm b/lib/Pod/Usage.pm index 236ef65..16056ac 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 diff --git a/pod/pod2usage.PL b/pod/pod2usage.PL index 1b14c17..ae4aaba 100644 --- a/pod/pod2usage.PL +++ b/pod/pod2usage.PL @@ -15,8 +15,9 @@ use Cwd; # This is so that make depend always knows where to find PL derivatives. $origdir = cwd; chdir(dirname($0)); -$file = basename($0, '.PL'); -$file .= '.com' if $^O eq 'VMS'; +($file = basename($0)) =~ s/\.PL$//; +$file =~ s/\.pl$// if ($^O eq 'os2' or $^O eq 'dos'); # "case-forgiving" +$file =~ s/\.pl$/.com/ if ($^O eq 'VMS'); # "case-forgiving" open OUT,">$file" or die "Can't create $file: $!"; diff --git a/pod/podselect.PL b/pod/podselect.PL index 138e076..7022fd2 100644 --- a/pod/podselect.PL +++ b/pod/podselect.PL @@ -15,8 +15,9 @@ use Cwd; # This is so that make depend always knows where to find PL derivatives. $origdir = cwd; chdir(dirname($0)); -$file = basename($0, '.PL'); -$file .= '.com' if $^O eq 'VMS'; +($file = basename($0)) =~ s/\.PL$//; +$file =~ s/\.pl$// if ($^O eq 'os2' or $^O eq 'dos'); # "case-forgiving" +$file =~ s/\.pl$/.com/ if ($^O eq 'VMS'); # "case-forgiving" open OUT,">$file" or die "Can't create $file: $!"; diff --git a/t/pod/poderrs.xr b/t/pod/poderrs.xr index 3d0dd8c..a8ef58b 100644 --- a/t/pod/poderrs.xr +++ b/t/pod/poderrs.xr @@ -45,4 +45,3 @@ *** ERROR: unresolved internal link 'OoPs' at line 110 in file t/pod/poderrs.t *** ERROR: unresolved internal link 'abc def' at line 114 in file t/pod/poderrs.t *** ERROR: unresolved internal link 'I/O Operators' at line 202 in file t/pod/poderrs.t -*** WARNING: multiple occurrence of link target 'Misc' at line - in file t/pod/poderrs.t