diff options
author | Todd C. Miller <millert@cvs.openbsd.org> | 2008-09-30 12:21:42 +0000 |
---|---|---|
committer | Todd C. Miller <millert@cvs.openbsd.org> | 2008-09-30 12:21:42 +0000 |
commit | 3e87d33336075436081410e5efb42e48d51e5cee (patch) | |
tree | 8232b449b6e708998edb6fd0a1276fdd2014681f /gnu/usr.bin/perl | |
parent | 7cc2926f9b52c44c2c2a46501c85f27a50629983 (diff) |
Remove a couple more bogus man pages and add missing MLINKs. The
makewhatis info for the perl man pages now matches the pages themselves.
Diffstat (limited to 'gnu/usr.bin/perl')
-rw-r--r-- | gnu/usr.bin/perl/Makefile.bsd-wrapper1 | 15 | ||||
-rw-r--r-- | gnu/usr.bin/perl/lib/AnyDBM_File.pm | 2 | ||||
-rw-r--r-- | gnu/usr.bin/perl/lib/Module/Build/ModuleInfo.pm | 2 | ||||
-rw-r--r-- | gnu/usr.bin/perl/lib/Module/Build/Notes.pm | 3 | ||||
-rw-r--r-- | gnu/usr.bin/perl/lib/NEXT.pm | 276 | ||||
-rw-r--r-- | gnu/usr.bin/perl/lib/Net/libnetFAQ.pod | 12 | ||||
-rw-r--r-- | gnu/usr.bin/perl/lib/Pod/Checker.pm | 234 | ||||
-rw-r--r-- | gnu/usr.bin/perl/lib/Pod/Select.pm | 43 | ||||
-rw-r--r-- | gnu/usr.bin/perl/lib/Pod/Usage.pm | 164 | ||||
-rw-r--r-- | gnu/usr.bin/perl/lib/Text/Abbrev.pm | 2 | ||||
-rw-r--r-- | gnu/usr.bin/perl/pod/perlxstut.pod | 2 |
11 files changed, 599 insertions, 156 deletions
diff --git a/gnu/usr.bin/perl/Makefile.bsd-wrapper1 b/gnu/usr.bin/perl/Makefile.bsd-wrapper1 index 44f1e999d8f..48978aead7e 100644 --- a/gnu/usr.bin/perl/Makefile.bsd-wrapper1 +++ b/gnu/usr.bin/perl/Makefile.bsd-wrapper1 @@ -14,9 +14,19 @@ POD2MAN= LD_LIBRARY_PATH=${.OBJDIR} ${.OBJDIR}/perl -I ${.OBJDIR}/lib \ MANLOCALBUILD= yes MLINKS= c2ph.1 pstruct.1 s2p.1 psed.1 perl5100delta.1 perldelta.1\ + Carp.3p carp.3p Carp.3p cluck.3p Carp.3p croak.3p \ + Carp.3p confess.3p Carp.3p shortmess.3p Carp.3p longmess.3p \ Getopt::Std.3p getopt.3p Getopt::Std.3p getopts.3p \ File::Basename.3p dirname.3p File::Basename.3p basename.3p \ - File::Basename.3p fileparse.3p + File::Basename.3p fileparse.3p Search::Dict.3p look.3p \ + ExtUtils::Miniperl.3p writemain.3p \ + IPC::Open2.3p open2.3p IPC::Open3.3p open3.3p \ + Socket.3p sockaddr_in.3p Socket.3p sockaddr_un.3p \ + Socket.3p inet_aton.3p Socket.3p inet_ntoa.3p \ + Tie::Hash.3p Tie::StdHash.3p Tie::Hash.3p Tie::ExtraHash.3p \ + Tie::Scalar.3p Tie::StdScalar.3p diagnostics.3p splain.3p \ + Pod::Checker.3p podchecker.3p Pod::Select.3p podselect.3p \ + Pod::Usage.3p pod2usage.3p MANALL= _quick1= @@ -171,7 +181,6 @@ MANSRCALL= podselect 1 pod/podselect \ prove 1 lib/Test/Harness/bin/prove \ s2p 1 x2p/s2p \ - splain 1 utils/splain \ xsubpp 1 lib/ExtUtils/xsubpp \ AnyDBM_File 3p lib/AnyDBM_File.pm \ Archive::Extract 3p lib/Archive/Extract.pm \ @@ -271,7 +280,6 @@ MANSRCALL= Encode 3p ext/Encode/Encode.pm \ Encode::Alias 3p ext/Encode/lib/Encode/Alias.pm \ Encode::Byte 3p ext/Encode/Byte/Byte.pm \ - Encode::CJKConstants 3p ext/Encode/lib/Encode/CJKConstants.pm \ Encode::CN 3p ext/Encode/CN/CN.pm \ Encode::CN::HZ 3p ext/Encode/lib/Encode/CN/HZ.pm \ Encode::Config 3p ext/Encode/lib/Encode/Config.pm \ @@ -286,7 +294,6 @@ MANSRCALL= Encode::KR 3p ext/Encode/KR/KR.pm \ Encode::KR::2022_KR 3p ext/Encode/lib/Encode/KR/2022_KR.pm \ Encode::MIME::Header 3p ext/Encode/lib/Encode/MIME/Header.pm \ - Encode::MIME::Name 3p lib/Encode/MIME/Name.pm \ Encode::PerlIO 3p ext/Encode/lib/Encode/PerlIO.pod \ Encode::Supported 3p ext/Encode/lib/Encode/Supported.pod \ Encode::Symbol 3p ext/Encode/Symbol/Symbol.pm \ diff --git a/gnu/usr.bin/perl/lib/AnyDBM_File.pm b/gnu/usr.bin/perl/lib/AnyDBM_File.pm index d73abab0f9e..f89100e09f4 100644 --- a/gnu/usr.bin/perl/lib/AnyDBM_File.pm +++ b/gnu/usr.bin/perl/lib/AnyDBM_File.pm @@ -19,8 +19,6 @@ die "No DBM package was successfully found or installed"; AnyDBM_File - provide framework for multiple DBMs -NDBM_File, DB_File, GDBM_File, SDBM_File, ODBM_File - various DBM implementations - =head1 SYNOPSIS use AnyDBM_File; diff --git a/gnu/usr.bin/perl/lib/Module/Build/ModuleInfo.pm b/gnu/usr.bin/perl/lib/Module/Build/ModuleInfo.pm index 66a6671c99f..4b71576dd6a 100644 --- a/gnu/usr.bin/perl/lib/Module/Build/ModuleInfo.pm +++ b/gnu/usr.bin/perl/lib/Module/Build/ModuleInfo.pm @@ -359,7 +359,7 @@ __END__ =head1 NAME -ModuleInfo - Gather package and POD information from a perl module files +Module::Build::ModuleInfo - Gather package and POD information from a perl module files =head1 DESCRIPTION diff --git a/gnu/usr.bin/perl/lib/Module/Build/Notes.pm b/gnu/usr.bin/perl/lib/Module/Build/Notes.pm index 8afdd8c1895..36fec965350 100644 --- a/gnu/usr.bin/perl/lib/Module/Build/Notes.pm +++ b/gnu/usr.bin/perl/lib/Module/Build/Notes.pm @@ -198,8 +198,7 @@ EOF =head1 NAME -$notes_name - Configuration for $module_name - +Module::Build::Notes - Configuration for $module_name =head1 SYNOPSIS diff --git a/gnu/usr.bin/perl/lib/NEXT.pm b/gnu/usr.bin/perl/lib/NEXT.pm index 68b3df25477..a33643adf49 100644 --- a/gnu/usr.bin/perl/lib/NEXT.pm +++ b/gnu/usr.bin/perl/lib/NEXT.pm @@ -1,9 +1,9 @@ package NEXT; -$VERSION = '0.50'; +$VERSION = '0.60_01'; use Carp; use strict; -sub ancestors +sub NEXT::ELSEWHERE::ancestors { my @inlist = shift; my @outlist = (); @@ -15,10 +15,26 @@ sub ancestors return @outlist; } +sub NEXT::ELSEWHERE::ordered_ancestors +{ + my @inlist = shift; + my @outlist = (); + while (my $next = shift @inlist) { + push @outlist, $next; + no strict 'refs'; + push @inlist, @{"$outlist[-1]::ISA"}; + } + return sort { $a->isa($b) ? -1 + : $b->isa($a) ? +1 + : 0 } @outlist; +} + sub AUTOLOAD { my ($self) = @_; - my $caller = (caller(1))[3]; + my $depth = 1; + until ((caller($depth))[3] !~ /^\(eval\)$/) { $depth++ } + my $caller = (caller($depth))[3]; my $wanted = $NEXT::AUTOLOAD || 'NEXT::AUTOLOAD'; undef $NEXT::AUTOLOAD; my ($caller_class, $caller_method) = $caller =~ m{(.*)::(.*)}g; @@ -32,7 +48,8 @@ sub AUTOLOAD unless ($NEXT::NEXT{$self,$wanted_method}) { my @forebears = - ancestors ref $self || $self, $wanted_class; + NEXT::ELSEWHERE::ancestors ref $self || $self, + $wanted_class; while (@forebears) { last if shift @forebears eq $caller_class } @@ -43,9 +60,11 @@ sub AUTOLOAD @{$NEXT::NEXT{$self,$wanted_method}} = map { (*{"${_}::AUTOLOAD"}{CODE}) ? "${_}::AUTOLOAD" : ()} @forebears unless @{$NEXT::NEXT{$self,$wanted_method}||[]}; + $NEXT::SEEN->{$self,*{$caller}{CODE}}++; } my $call_method = shift @{$NEXT::NEXT{$self,$wanted_method}}; - while ($wanted_class =~ /^NEXT:.*:UNSEEN/ && defined $call_method + while ($wanted_class =~ /^NEXT\b.*\b(UNSEEN|DISTINCT)\b/ + && defined $call_method && $NEXT::SEEN->{$self,$call_method}++) { $call_method = shift @{$NEXT::NEXT{$self,$wanted_method}}; } @@ -55,7 +74,7 @@ sub AUTOLOAD croak qq(Can't locate object method "$wanted_method" ), qq(via package "$caller_class"); }; - return shift()->$call_method(@_) if ref $call_method eq 'CODE'; + return $self->$call_method(@_[1..$#_]) if ref $call_method eq 'CODE'; no strict 'refs'; ($wanted_method=${$caller_class."::AUTOLOAD"}) =~ s/.*::// if $wanted_method eq 'AUTOLOAD'; @@ -65,9 +84,79 @@ sub AUTOLOAD no strict 'vars'; package NEXT::UNSEEN; @ISA = 'NEXT'; +package NEXT::DISTINCT; @ISA = 'NEXT'; package NEXT::ACTUAL; @ISA = 'NEXT'; package NEXT::ACTUAL::UNSEEN; @ISA = 'NEXT'; +package NEXT::ACTUAL::DISTINCT; @ISA = 'NEXT'; package NEXT::UNSEEN::ACTUAL; @ISA = 'NEXT'; +package NEXT::DISTINCT::ACTUAL; @ISA = 'NEXT'; + +package EVERY::LAST; @ISA = 'EVERY'; +package EVERY; @ISA = 'NEXT'; +sub AUTOLOAD +{ + my ($self) = @_; + my $depth = 1; + until ((caller($depth))[3] !~ /^\(eval\)$/) { $depth++ } + my $caller = (caller($depth))[3]; + my $wanted = $EVERY::AUTOLOAD || 'EVERY::AUTOLOAD'; + undef $EVERY::AUTOLOAD; + my ($wanted_class, $wanted_method) = $wanted =~ m{(.*)::(.*)}g; + + local $NEXT::ALREADY_IN_EVERY{$self,$wanted_method} = + $NEXT::ALREADY_IN_EVERY{$self,$wanted_method}; + + return if $NEXT::ALREADY_IN_EVERY{$self,$wanted_method}++; + + my @forebears = NEXT::ELSEWHERE::ordered_ancestors ref $self || $self, + $wanted_class; + @forebears = reverse @forebears if $wanted_class =~ /\bLAST\b/; + no strict 'refs'; + my %seen; + my @every = map { my $sub = "${_}::$wanted_method"; + !*{$sub}{CODE} || $seen{$sub}++ ? () : $sub + } @forebears + unless $wanted_method eq 'AUTOLOAD'; + + my $want = wantarray; + if (@every) { + if ($want) { + return map {($_, [$self->$_(@_[1..$#_])])} @every; + } + elsif (defined $want) { + return { map {($_, scalar($self->$_(@_[1..$#_])))} + @every + }; + } + else { + $self->$_(@_[1..$#_]) for @every; + return; + } + } + + @every = map { my $sub = "${_}::AUTOLOAD"; + !*{$sub}{CODE} || $seen{$sub}++ ? () : "${_}::AUTOLOAD" + } @forebears; + if ($want) { + return map { $$_ = ref($self)."::EVERY::".$wanted_method; + ($_, [$self->$_(@_[1..$#_])]); + } @every; + } + elsif (defined $want) { + return { map { $$_ = ref($self)."::EVERY::".$wanted_method; + ($_, scalar($self->$_(@_[1..$#_]))) + } @every + }; + } + else { + for (@every) { + $$_ = ref($self)."::EVERY::".$wanted_method; + $self->$_(@_[1..$#_]); + } + return; + } +} + 1; @@ -75,7 +164,7 @@ __END__ =head1 NAME -NEXT.pm - Provide a pseudo-class NEXT that allows method redispatch +NEXT - Provide a pseudo-class NEXT (et al) that allows method redispatch =head1 SYNOPSIS @@ -112,21 +201,22 @@ NEXT.pm - Provide a pseudo-class NEXT that allows method redispatch # Clean-up calls D::DESTROY, B::DESTROY, A::DESTROY, C::DESTROY + =head1 DESCRIPTION NEXT.pm adds a pseudoclass named C<NEXT> to any program -that uses it. If a method C<m> calls C<$self->NEXT::m()>, the call to +that uses it. If a method C<m> calls C<$self-E<gt>NEXT::m()>, the call to C<m> is redispatched as if the calling method had not originally been found. -In other words, a call to C<$self->NEXT::m()> resumes the depth-first, +In other words, a call to C<$self-E<gt>NEXT::m()> resumes the depth-first, left-to-right search of C<$self>'s class hierarchy that resulted in the original call to C<m>. -Note that this is not the same thing as C<$self->SUPER::m()>, which +Note that this is not the same thing as C<$self-E<gt>SUPER::m()>, which begins a new dispatch that is restricted to searching the ancestors -of the current class. C<$self->NEXT::m()> can backtrack +of the current class. C<$self-E<gt>NEXT::m()> can backtrack past the current class -- to look for a suitable method in other -ancestors of C<$self> -- whereas C<$self->SUPER::m()> cannot. +ancestors of C<$self> -- whereas C<$self-E<gt>SUPER::m()> cannot. A typical use would be in the destructors of a class hierarchy, as illustrated in the synopsis above. Each class in the hierarchy @@ -143,7 +233,7 @@ do better. By default, if a redispatch attempt fails to find another method elsewhere in the objects class hierarchy, it quietly gives up and does -nothing (but see L<"Enforcing redispatch">). This gracious acquiesence +nothing (but see L<"Enforcing redispatch">). This gracious acquiescence is also unlike the (generally annoying) behaviour of C<SUPER>, which throws an exception if it cannot redispatch. @@ -239,30 +329,31 @@ call each method only once during a sequence of redispatches. To cover such cases, you can redispatch methods via: - $self->NEXT::UNSEEN::method(); + $self->NEXT::DISTINCT::method(); rather than: $self->NEXT::method(); -This causes the redispatcher to skip any classes in the hierarchy that it has -already visited in an earlier redispatch. So, for example, if the +This causes the redispatcher to only visit each distinct C<method> method +once. That is, to skip any classes in the hierarchy that it has +already visited during redispatch. So, for example, if the previous example were rewritten: package A; - sub foo { print "called A::foo\n"; shift->NEXT::UNSEEN::foo() } + sub foo { print "called A::foo\n"; shift->NEXT::DISTINCT::foo() } package B; - sub foo { print "called B::foo\n"; shift->NEXT::UNSEEN::foo() } + sub foo { print "called B::foo\n"; shift->NEXT::DISTINCT::foo() } package C; @ISA = qw( A ); - sub foo { print "called C::foo\n"; shift->NEXT::UNSEEN::foo() } + sub foo { print "called C::foo\n"; shift->NEXT::DISTINCT::foo() } package D; @ISA = qw(A B); - sub foo { print "called D::foo\n"; shift->NEXT::UNSEEN::foo() } + sub foo { print "called D::foo\n"; shift->NEXT::DISTINCT::foo() } package E; @ISA = qw(C D); - sub foo { print "called E::foo\n"; shift->NEXT::UNSEEN::foo() } + sub foo { print "called E::foo\n"; shift->NEXT::DISTINCT::foo() } E->foo(); @@ -274,18 +365,155 @@ then it would print: called D::foo called B::foo -and omit the second call to C<A::foo>. +and omit the second call to C<A::foo> (since it would not be distinct +from the first call to C<A::foo>). Note that you can also use: - $self->NEXT::UNSEEN::ACTUAL::method(); + $self->NEXT::DISTINCT::ACTUAL::method(); or: - $self->NEXT::ACTUAL::UNSEEN::method(); + $self->NEXT::ACTUAL::DISTINCT::method(); to get both unique invocation I<and> exception-on-failure. +Note that, for historical compatibility, you can also use +C<NEXT::UNSEEN> instead of C<NEXT::DISTINCT>. + + +=head2 Invoking all versions of a method with a single call + +Yet another pseudo-class that NEXT.pm provides is C<EVERY>. +Its behaviour is considerably simpler than that of the C<NEXT> family. +A call to: + + $obj->EVERY::foo(); + +calls I<every> method named C<foo> that the object in C<$obj> has inherited. +That is: + + use NEXT; + + package A; @ISA = qw(B D X); + sub foo { print "A::foo " } + + package B; @ISA = qw(D X); + sub foo { print "B::foo " } + + package X; @ISA = qw(D); + sub foo { print "X::foo " } + + package D; + sub foo { print "D::foo " } + + package main; + + my $obj = bless {}, 'A'; + $obj->EVERY::foo(); # prints" A::foo B::foo X::foo D::foo + +Prefixing a method call with C<EVERY::> causes every method in the +object's hierarchy with that name to be invoked. As the above example +illustrates, they are not called in Perl's usual "left-most-depth-first" +order. Instead, they are called "breadth-first-dependency-wise". + +That means that the inheritance tree of the object is traversed breadth-first +and the resulting order of classes is used as the sequence in which methods +are called. However, that sequence is modified by imposing a rule that the +appropriate method of a derived class must be called before the same method of +any ancestral class. That's why, in the above example, C<X::foo> is called +before C<D::foo>, even though C<D> comes before C<X> in C<@B::ISA>. + +In general, there's no need to worry about the order of calls. They will be +left-to-right, breadth-first, most-derived-first. This works perfectly for +most inherited methods (including destructors), but is inappropriate for +some kinds of methods (such as constructors, cloners, debuggers, and +initializers) where it's more appropriate that the least-derived methods be +called first (as more-derived methods may rely on the behaviour of their +"ancestors"). In that case, instead of using the C<EVERY> pseudo-class: + + $obj->EVERY::foo(); # prints" A::foo B::foo X::foo D::foo + +you can use the C<EVERY::LAST> pseudo-class: + + $obj->EVERY::LAST::foo(); # prints" D::foo X::foo B::foo A::foo + +which reverses the order of method call. + +Whichever version is used, the actual methods are called in the same +context (list, scalar, or void) as the original call via C<EVERY>, and return: + +=over + +=item * + +A hash of array references in list context. Each entry of the hash has the +fully qualified method name as its key and a reference to an array containing +the method's list-context return values as its value. + +=item * + +A reference to a hash of scalar values in scalar context. Each entry of the hash has the +fully qualified method name as its key and the method's scalar-context return values as its value. + +=item * + +Nothing in void context (obviously). + +=back + +=head2 Using C<EVERY> methods + +The typical way to use an C<EVERY> call is to wrap it in another base +method, that all classes inherit. For example, to ensure that every +destructor an object inherits is actually called (as opposed to just the +left-most-depth-first-est one): + + package Base; + sub DESTROY { $_[0]->EVERY::Destroy } + + package Derived1; + use base 'Base'; + sub Destroy {...} + + package Derived2; + use base 'Base', 'Derived1'; + sub Destroy {...} + +et cetera. Every derived class than needs its own clean-up +behaviour simply adds its own C<Destroy> method (I<not> a C<DESTROY> method), +which the call to C<EVERY::LAST::Destroy> in the inherited destructor +then correctly picks up. + +Likewise, to create a class hierarchy in which every initializer inherited by +a new object is invoked: + + package Base; + sub new { + my ($class, %args) = @_; + my $obj = bless {}, $class; + $obj->EVERY::LAST::Init(\%args); + } + + package Derived1; + use base 'Base'; + sub Init { + my ($argsref) = @_; + ... + } + + package Derived2; + use base 'Base', 'Derived1'; + sub Init { + my ($argsref) = @_; + ... + } + +et cetera. Every derived class than needs some additional initialization +behaviour simply adds its own C<Init> method (I<not> a C<new> method), +which the call to C<EVERY::LAST::Init> in the inherited constructor +then correctly picks up. + =head1 AUTHOR diff --git a/gnu/usr.bin/perl/lib/Net/libnetFAQ.pod b/gnu/usr.bin/perl/lib/Net/libnetFAQ.pod index d370e8462fc..dd7c9318f33 100644 --- a/gnu/usr.bin/perl/lib/Net/libnetFAQ.pod +++ b/gnu/usr.bin/perl/lib/Net/libnetFAQ.pod @@ -1,6 +1,6 @@ =head1 NAME -libnetFAQ - libnet Frequently Asked Questions +Net::libnetFAQ - libnet Frequently Asked Questions =head1 DESCRIPTION @@ -9,7 +9,7 @@ libnetFAQ - libnet Frequently Asked Questions This document is distributed with the libnet distribution, and is also available on the libnet web page at - http://www.pobox.com/~gbarr/libnet/ + http://search.cpan.org/~gbarr/libnet/ =head2 How to contribute to this document @@ -70,7 +70,7 @@ in The latest release and information is also available on the libnet web page at - http://www.pobox.com/~gbarr/libnet/ + http://search.cpan.org/~gbarr/libnet/ =head1 Using Net::FTP @@ -84,7 +84,7 @@ An example taken from an article posted to comp.lang.perl.misc use Net::FTP; - # for debuging: $ftp = Net::FTP->new('site','Debug',10); + # for debugging: $ftp = Net::FTP->new('site','Debug',10); # open a connection and log in! $ftp = Net::FTP->new('target_site.somewhere.xxx'); @@ -301,7 +301,3 @@ being sent or response being received. Copyright (c) 1997 Graham Barr. All rights reserved. -=for html <hr> - -I<$Id: //depot/libnet/Net/libnetFAQ.pod#5 $> - diff --git a/gnu/usr.bin/perl/lib/Pod/Checker.pm b/gnu/usr.bin/perl/lib/Pod/Checker.pm index ae32677db1a..a8910ff65ac 100644 --- a/gnu/usr.bin/perl/lib/Pod/Checker.pm +++ b/gnu/usr.bin/perl/lib/Pod/Checker.pm @@ -10,14 +10,14 @@ package Pod::Checker; use vars qw($VERSION); -$VERSION = 1.098; ## Current version of this package +$VERSION = "1.43_01"; ## Current version of this package require 5.005; ## requires this Perl version or later use Pod::ParseUtils; ## for hyperlinks and lists =head1 NAME -Pod::Checker, podchecker() - check pod documents for syntax errors +Pod::Checker, podchecker - check pod documents for syntax errors =head1 SYNOPSIS @@ -44,7 +44,8 @@ This function can take a hash of options: =item B<-warnings> =E<gt> I<val> -Turn warnings on/off. See L<"Warnings">. +Turn warnings on/off. I<val> is usually 1 for on, but higher values +trigger additional warnings. See L<"Warnings">. =back @@ -52,13 +53,11 @@ Turn warnings on/off. See L<"Warnings">. B<podchecker> will perform syntax checking of Perl5 POD format documentation. -I<NOTE THAT THIS MODULE IS CURRENTLY IN THE BETA STAGE!> +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>. -It is hoped that curious/ambitious user will help flesh out and add the -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 @@ -83,7 +82,7 @@ C<LE<lt>...LE<lt>...E<gt>...E<gt>>). =item * -Check for malformed or nonexisting entities C<EE<lt>...E<gt>>. +Check for malformed or non-existing entities C<EE<lt>...E<gt>>. =item * @@ -143,14 +142,14 @@ 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 happend when a single word node name is not enclosed in +POD. This also happened when a single word node name is not enclosed in C<"">. =item * Unknown command "I<CMD>" An invalid POD command has been found. Valid are C<=head1>, C<=head2>, -C<=over>, C<=item>, C<=back>, C<=begin>, C<=end>, C<=for>, C<=pod>, -C<=cut> +C<=head3>, C<=head4>, C<=over>, C<=item>, C<=back>, C<=begin>, C<=end>, +C<=for>, C<=pod>, C<=cut> =item * Unknown interior-sequence "I<SEQ>" @@ -201,10 +200,11 @@ These may not necessarily cause trouble, but indicate mediocre style. =over 4 -=item * multiple occurence of link target I<name> +=item * multiple occurrence of link target I<name> 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 @@ -212,15 +212,14 @@ There is some whitespace on a seemingly empty line. POD is very sensitive to such things, so this is flagged. B<vi> users switch on the B<list> option to avoid this problem. +=begin _disabled_ + =item * file does not start with =head The file starts with a different POD directive than head. This is most probably something you do not want. -=item * No numeric argument for =over - -The C<=over> command is supposed to have a numeric argument (the -indentation). +=end _disabled_ =item * previous =item has no contents @@ -235,7 +234,7 @@ C<=over>/C<=back> block. =item * =item type mismatch (I<one> vs. I<two>) -A list started with e.g. a bulletted C<=item> and continued with a +A list started with e.g. a bullet-like 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. @@ -243,7 +242,8 @@ type of the I<first> C<=item> determines the type of the list. Angle brackets not written as C<E<lt>ltE<gt>> and C<E<lt>gtE<gt>> can potentially cause errors as they could be misinterpreted as -markup commands. +markup commands. This is only printed when the -warnings level is +greater than 1. =item * Unknown entity @@ -273,11 +273,41 @@ The NAME section (C<=head1 NAME>) should consist of a single paragraph with the script/module name, followed by a dash `-' and a very short description of what the thing is good for. -=item * Hyperlinks +=item * =headI<n> without preceding higher level + +For example if there is a C<=head2> in the POD file prior to a +C<=head1>. + +=back + +=head2 Hyperlinks + +There are some warnings with respect to malformed hyperlinks: + +=over 4 + +=item * ignoring leading/trailing whitespace in link + +There is whitespace at the beginning or the end of the contents of +LE<lt>...E<gt>. + +=item * (section) in '$page' deprecated + +There is a section detected in the page name of LE<lt>...E<gt>, e.g. +C<LE<lt>passwd(2)E<gt>>. POD hyperlinks may point to POD documents only. +Please write C<CE<lt>passwd(2)E<gt>> instead. Some formatters are able +to expand this to appropriate code. For links to (builtin) functions, +please say C<LE<lt>perlfunc/mkdirE<gt>>, without (). -There are some warnings wrt. hyperlinks: -Leading/trailing whitespace, newlines in hyperlinks, -brackets C<()>. +=item * alternative text/node '%s' contains non-escaped | or / + +The characters C<|> and C</> are special in the LE<lt>...E<gt> context. +Although the hyperlink parser does its best to determine which "/" is +text and which is a delimiter in case of doubt, one ought to escape +these literal characters like this: + + / E<sol> + | E<verbar> =back @@ -288,7 +318,7 @@ there were no POD commands at all found in the file. =head1 EXAMPLES -I<[T.B.D.]> +See L</SYNOPSIS> =head1 INTERFACE @@ -298,6 +328,13 @@ POD translators can use this feature to syntax-check and get the nodes in a first pass before actually starting to convert. This is expensive in terms of execution time, but allows for very robust conversions. +Since PodParser-1.24 the B<Pod::Checker> module uses only the B<poderror> +method to print errors and warnings. The summary output (e.g. +"Pod syntax OK") has been dropped from the module and has been included in +B<podchecker> (the script). This allows users of B<Pod::Checker> to +control completely the output behavior. Users of B<podchecker> (the script) +get the well-known behavior. + =cut ############################################################################# @@ -307,7 +344,6 @@ use strict; use Carp; use Exporter; use Pod::Parser; -require VMS::Filespec if $^O eq 'VMS'; use vars qw(@ISA @EXPORT); @ISA = qw(Pod::Parser); @@ -320,12 +356,15 @@ my %VALID_COMMANDS = ( 'cut' => 1, 'head1' => 1, 'head2' => 1, + 'head3' => 1, + 'head4' => 1, 'over' => 1, 'back' => 1, 'item' => 1, 'for' => 1, 'begin' => 1, 'end' => 1, + 'encoding' => '1', ); my %VALID_SEQUENCES = ( @@ -471,7 +510,6 @@ sub podchecker( $ ; $ % ) { ## Now create a pod checker my $checker = new Pod::Checker(%options); - $checker->parseopts(-process_cut_cmd => 1, -warnings => 1); ## Now check the pod document for errors $checker->parse_from_file($infile, $outfile); @@ -486,6 +524,27 @@ sub podchecker( $ ; $ % ) { ## Method definitions begin here ##------------------------------- +################################## + +=over 4 + +=item C<Pod::Checker-E<gt>new( %options )> + +Return a reference to a new Pod::Checker object that inherits from +Pod::Parser and is used for calling the required methods later. The +following options are recognized: + +C<-warnings =E<gt> num> + Print warnings if C<num> is true. The higher the value of C<num>, +the more warnings are printed. Currently there are only levels 1 and 2. + +C<-quiet =E<gt> num> + If C<num> is true, do not print any errors/warnings. This is useful +when Pod::Checker is used to munge POD code into plain text from within +POD formatters. + +=cut + ## sub new { ## my $this = shift; ## my $class = ref($this) || $this; @@ -501,7 +560,10 @@ sub initialize { ## Initialize number of errors, and setup an error function to ## increment this number and then print to the designated output. $self->{_NUM_ERRORS} = 0; - $self->errorsub('poderror'); # set the error handling subroutine + $self->{_NUM_WARNINGS} = 0; + $self->{-quiet} ||= 0; + # set the error handling subroutine + $self->errorsub($self->{-quiet} ? sub { 1; } : 'poderror'); $self->{_commands} = 0; # total number of POD commands encountered $self->{_list_stack} = []; # stack for nested lists $self->{_have_begin} = ''; # stores =begin @@ -511,12 +573,11 @@ sub initialize { # print warnings? $self->{-warnings} = 1 unless(defined $self->{-warnings}); $self->{_current_head1} = ''; # the current =head1 block + $self->parseopts(-process_cut_cmd => 1, -warnings => $self->{-warnings}); } ################################## -=over 4 - =item C<$checker-E<gt>poderror( @args )> =item C<$checker-E<gt>poderror( {%opts}, @args )> @@ -547,7 +608,6 @@ The error level, should be 'WARNING' or 'ERROR'. sub poderror { my $self = shift; my %opts = (ref $_[0]) ? %{shift()} : (); - $opts{-file} = VMS::Filespec::unixify($opts{-file}) if (exists($opts{-file}) && $^O eq 'VMS'); ## Retrieve options chomp( my $msg = ($opts{-msg} || "")."@_" ); @@ -562,9 +622,13 @@ sub poderror { ## Increment error count and print message " ++($self->{_NUM_ERRORS}) if(!%opts || ($opts{-severity} && $opts{-severity} eq 'ERROR')); - my $out_fh = $self->output_handle(); - print $out_fh ($severity, $msg, $line, $file, "\n") - if($self->{-warnings} || !%opts || $opts{-severity} ne 'WARNING'); + ++($self->{_NUM_WARNINGS}) + if(!%opts || ($opts{-severity} && $opts{-severity} eq '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'); + } } ################################## @@ -581,6 +645,18 @@ sub num_errors { ################################## +=item C<$checker-E<gt>num_warnings()> + +Set (if argument specified) and retrieve the number of warnings found. + +=cut + +sub num_warnings { + return (@_ > 1) ? ($_[0]->{_NUM_WARNINGS} = $_[1]) : $_[0]->{_NUM_WARNINGS}; +} + +################################## + =item C<$checker-E<gt>name()> Set (if argument specified) and retrieve the canonical name of POD as @@ -599,7 +675,7 @@ sub name { Add (if argument specified) and retrieve the nodes (as defined by C<=headX> and C<=item>) of the current POD. The nodes are returned in the order of -their occurence. They consist of plain text, each piece of whitespace is +their occurrence. They consist of plain text, each piece of whitespace is collapsed to a single blank. =cut @@ -648,7 +724,7 @@ sub idx { =item C<$checker-E<gt>hyperlink()> Add (if argument specified) and retrieve the hyperlinks (as defined by -C<LE<lt>E<gt>>) of the current POD. They consist of an 2-item array: line +C<LE<lt>E<gt>>) of the current POD. They consist of a 2-item array: line number and C<Pod::Hyperlink> object. =back @@ -672,11 +748,8 @@ sub end_pod { ## print the number of errors found my $self = shift; my $infile = $self->input_file(); - $infile = VMS::Filespec::unixify($infile) if $^O eq 'VMS'; - my $out_fh = $self->output_handle(); if(@{$self->{_list_stack}}) { - # _TODO_ display, but don't count them for now my $list; while(($list = $self->_close_list('EOF',$infile)) && $list->indent() ne 'auto') { @@ -691,12 +764,15 @@ sub end_pod { my %nodes; foreach($self->node()) { $nodes{$_} = 1; - if(/^(\S+)\s+/) { + if(/^(\S+)\s+\S/) { # we have more than one word. Use the first as a node, too. # This is used heavily in perlfunc.pod $nodes{$1} ||= 2; # derived node } } + foreach($self->idx()) { + $nodes{$_} = 3; # index node + } foreach($self->hyperlink()) { my ($line,$link) = @$_; # _TODO_ what if there is a link to the page itself by the name, @@ -714,26 +790,17 @@ 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 occurence of link target '$_'"}); + -msg => "multiple occurrence of link target '$_'"}); + } } - ## Print the number of errors found - my $num_errors = $self->num_errors(); - if ($num_errors > 0) { - printf $out_fh ("$infile has $num_errors pod syntax %s.\n", - ($num_errors == 1) ? "error" : "errors"); - } - elsif($self->{_commands} == 0) { - print $out_fh "$infile does not contain any pod commands.\n"; - $self->num_errors(-1); - } - else { - print $out_fh "$infile pod syntax OK.\n"; - } + # no POD found here + $self->num_errors(-1) if($self->{_commands} == 0); } # check a POD command directive @@ -746,24 +813,23 @@ sub command { $self->poderror({ -line => $line, -file => $file, -severity => 'ERROR', -msg => "Unknown command '$cmd'" }); } - else { - # found a valid command - if(!$self->{_commands}++ && $cmd !~ /^head/) { - $self->poderror({ -line => $line, -file => $file, - -severity => 'WARNING', - -msg => "file does not start with =head" }); - } - ## check syntax of particular command + else { # found a valid command + $self->{_commands}++; # delete this line if below is enabled again + + ##### following check disabled due to strong request + #if(!$self->{_commands}++ && $cmd !~ /^head/) { + # $self->poderror({ -line => $line, -file => $file, + # -severity => 'WARNING', + # -msg => "file does not start with =head" }); + #} + + # check syntax of particular command if($cmd eq 'over') { # check for argument $arg = $self->interpolate_and_check($paragraph, $line,$file); my $indent = 4; # default if($arg && $arg =~ /^\s*(\d+)\s*$/) { $indent = $1; - } else { - $self->poderror({ -line => $line, -file => $file, - -severity => 'WARNING', - -msg => "No numeric argument for =over"}); } # start a new list $self->_open_list($indent,$line,$file); @@ -859,17 +925,24 @@ sub command { } } elsif($cmd =~ /^head(\d+)/) { + my $hnum = $1; + $self->{"_have_head_$hnum"}++; # count head types + if($hnum > 1 && !$self->{"_have_head_".($hnum -1)}) { + $self->poderror({ -line => $line, -file => $file, + -severity => 'WARNING', + -msg => "=head$hnum without preceding higher level"}); + } # check whether the previous =head section had some contents if(defined $self->{_commands_in_head} && $self->{_commands_in_head} == 0 && defined $self->{_last_head} && - $self->{_last_head} >= $1) { + $self->{_last_head} >= $hnum) { $self->poderror({ -line => $line, -file => $file, -severity => 'WARNING', -msg => "empty section in previous paragraph"}); } $self->{_commands_in_head} = -1; - $self->{_last_head} = $1; + $self->{_last_head} = $hnum; # check if there is an open list if(@{$self->{_list_stack}}) { my $list; @@ -1003,16 +1076,17 @@ sub _check_ptree { foreach(@$ptree) { # regular text chunk unless(ref) { - my $count; # count the unescaped angle brackets - my $i = $_; - if($count = $i =~ tr/<>/<>/) { + # complain only when warning level is greater than 1 + if($self->{-warnings} && $self->{-warnings}>1) { + my $count; + if($count = tr/<>/<>/) { $self->poderror({ -line => $line, -file => $file, -severity => 'WARNING', - -msg => "$count unescaped <> in paragraph" }) - if($self->{-warnings}); + -msg => "$count unescaped <> in paragraph" }); + } } - $text .= $i; + $text .= $_; next; } # have an interior sequence @@ -1030,7 +1104,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 @@ -1185,8 +1259,10 @@ __END__ =head1 AUTHOR +Please report bugs using L<http://rt.cpan.org>. + Brad Appleton E<lt>bradapp@enteract.comE<gt> (initial version), -Marek Rouchal E<lt>marek@saftsack.fs.uni-bayreuth.deE<gt> +Marek Rouchal E<lt>marekr@cpan.orgE<gt> Based on code for B<Pod::Text::pod2text()> written by Tom Christiansen E<lt>tchrist@mox.perl.comE<gt> diff --git a/gnu/usr.bin/perl/lib/Pod/Select.pm b/gnu/usr.bin/perl/lib/Pod/Select.pm index 5dd1595107e..07839f0b9cd 100644 --- a/gnu/usr.bin/perl/lib/Pod/Select.pm +++ b/gnu/usr.bin/perl/lib/Pod/Select.pm @@ -10,14 +10,14 @@ package Pod::Select; use vars qw($VERSION); -$VERSION = 1.12; ## Current version of this package +$VERSION = 1.35; ## Current version of this package require 5.005; ## requires this Perl version or later ############################################################################# =head1 NAME -Pod::Select, podselect() - extract selected sections of POD from input +Pod::Select, podselect - extract selected sections of POD from input =head1 SYNOPSIS @@ -92,7 +92,7 @@ The formal syntax of a section specification is: =over 4 -=item +=item * I<head1-title-regex>/I<head2-title-regex>/... @@ -109,33 +109,39 @@ Some example section specifications follow. =over 4 -=item +=item * + Match the C<NAME> and C<SYNOPSIS> sections and all of their subsections: C<NAME|SYNOPSIS> -=item +=item * + Match only the C<Question> and C<Answer> subsections of the C<DESCRIPTION> section: C<DESCRIPTION/Question|Answer> -=item +=item * + Match the C<Comments> subsection of I<all> sections: C</Comments> -=item +=item * + Match all subsections of C<DESCRIPTION> I<except> for C<Comments>: C<DESCRIPTION/!Comments> -=item +=item * + Match the C<DESCRIPTION> section but do I<not> match any of its subsections: C<DESCRIPTION/!.+> -=item +=item * + Match all top level sections but none of their subsections: C</!.+> @@ -160,7 +166,7 @@ The formal syntax of a range specification is: =over 4 -=item +=item * /I<start-range-regex>/[../I<end-range-regex>/] @@ -175,7 +181,7 @@ Where I<cmd-expr> is intended to match the name of one or more POD commands, and I<text-expr> is intended to match the paragraph text for the command. If a range-regex is supposed to match a POD command, then the first character of the regex (the one after the initial '/') -absolutely I<must> be an single '=' character; it may not be anything +absolutely I<must> be a single '=' character; it may not be anything else (not even a regex meta-character) if it is supposed to match against the name of a POD command. @@ -499,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)); @@ -568,22 +575,22 @@ are used. All other arguments should correspond to the names of input files containing POD sections. A file name of "-" or "<&STDIN" will -be interpeted to mean standard input (which is the default if no +be interpreted to mean standard input (which is the default if no filenames are given). =cut 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, %{$_}); ##------------------------------------------------------------- @@ -734,6 +741,8 @@ L<Pod::Parser> =head1 AUTHOR +Please report bugs using L<http://rt.cpan.org>. + Brad Appleton E<lt>bradapp@enteract.comE<gt> Based on code for B<pod2text> written by @@ -742,4 +751,4 @@ Tom Christiansen E<lt>tchrist@mox.perl.comE<gt> =cut 1; - +# vim: ts=4 sw=4 et diff --git a/gnu/usr.bin/perl/lib/Pod/Usage.pm b/gnu/usr.bin/perl/lib/Pod/Usage.pm index aa8f712dcf5..11f15fe0574 100644 --- a/gnu/usr.bin/perl/lib/Pod/Usage.pm +++ b/gnu/usr.bin/perl/lib/Pod/Usage.pm @@ -10,12 +10,12 @@ package Pod::Usage; use vars qw($VERSION); -$VERSION = 1.12; ## Current version of this package +$VERSION = "1.35"; ## Current version of this package require 5.005; ## requires this Perl version or later =head1 NAME -Pod::Usage, pod2usage() - print a usage message from embedded pod documentation +Pod::Usage, pod2usage - print a usage message from embedded pod documentation =head1 SYNOPSIS @@ -40,13 +40,16 @@ 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 arguments corresponding to an associative array (a "hash"). When a single argument is given, it should correspond to exactly one of the following: -=over +=over 4 =item * @@ -68,7 +71,7 @@ assumed to be a hash. If a hash is supplied (either as a reference or as a list) it should contain one or more elements with the following keys: -=over +=over 4 =item C<-message> @@ -80,6 +83,9 @@ program's usage message. =item C<-exitval> The desired exit status to pass to the B<exit()> function. +This should be an integer, or else the string "NOEXIT" to +indicate that control should simply be returned without +terminating the invoking process. =item C<-verbose> @@ -90,6 +96,15 @@ 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 -sections +parameter; then these sections are extracted (see L<Pod::Select>) +and printed. + +=item C<-sections> + +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 @@ -112,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 @@ -129,7 +152,7 @@ Unless they are explicitly specified, the default values for the exit status, verbose level, and output stream to use are determined as follows: -=over +=over 4 =item * @@ -159,7 +182,7 @@ Although the above may seem a bit confusing at first, it generally does "the right thing" in most situations. This determination of the default values to use is based upon the following typical Unix conventions: -=over +=over 4 =item * @@ -189,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 -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 +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 more verbose description of program usage in this case. =back @@ -376,14 +399,21 @@ 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>. + Brad Appleton E<lt>bradapp@enteract.comE<gt> Based on code for B<Pod::Text::pod2text()> written by Tom Christiansen E<lt>tchrist@mox.perl.comE<gt> -=head1 ACKNOWLEDGEMENTS +=head1 ACKNOWLEDGMENTS Steven McDougall E<lt>swmcd@world.std.comE<gt> for his help and patience with re-writing this manpage. @@ -395,6 +425,7 @@ with re-writing this manpage. use strict; #use diagnostics; use Carp; +use Config; use Exporter; use File::Spec; @@ -419,7 +450,7 @@ BEGIN { ##--------------------------------- sub pod2usage { - local($_) = shift || ""; + local($_) = shift; my %opts; ## Collect arguments if (@_ > 0) { @@ -427,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'); @@ -461,11 +495,13 @@ sub pod2usage { $opts{"-exitval"} = ($opts{"-verbose"} > 0) ? 1 : 2; } elsif (! defined $opts{"-verbose"}) { - $opts{"-verbose"} = ($opts{"-exitval"} < 2); + $opts{"-verbose"} = (lc($opts{"-exitval"}) eq "noexit" || + $opts{"-exitval"} < 2); } ## Default the output file - $opts{"-output"} = ($opts{"-exitval"} < 2) ? \*STDOUT : \*STDERR + $opts{"-output"} = (lc($opts{"-exitval"}) eq "noexit" || + $opts{"-exitval"} < 2) ? \*STDOUT : \*STDERR unless (defined $opts{"-output"}); ## Default the input file $opts{"-input"} = $0 unless (defined $opts{"-input"}); @@ -474,7 +510,7 @@ sub pod2usage { unless ((ref $opts{"-input"}) || (-e $opts{"-input"})) { my ($dirname, $basename) = ('', $opts{"-input"}); my $pathsep = ($^O =~ /^(?:dos|os2|MSWin32)$/) ? ";" - : (($^O eq 'MacOS') ? ',' : ":"); + : (($^O eq 'MacOS' || $^O eq 'VMS') ? ',' : ":"); my $pathspec = $opts{"-pathlist"} || $ENV{PATH} || $ENV{PERL5LIB}; my @paths = (ref $pathspec) ? @$pathspec : split($pathsep, $pathspec); @@ -487,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)' . @@ -495,10 +531,33 @@ sub pod2usage { '(?:\s*(?:AND|\/)\s*(?:OPTIONS|ARGUMENTS))?'; $parser->select( 'SYNOPSIS', $opt_re, "DESCRIPTION/$opt_re" ); } + elsif ($opts{"-verbose"} >= 2 && $opts{"-verbose"} != 99) { + $parser->select('.*'); + } + elsif ($opts{"-verbose"} == 99) { + $parser->select( $opts{"-sections"} ); + $opts{"-verbose"} = 1; + } ## Now translate the pod document and then exit with the desired status - $parser->parse_from_file($opts{"-input"}, $opts{"-output"}); - exit($opts{"-exitval"}); + if ( !$opts{"-noperldoc"} + and $opts{"-verbose"} >= 2 + and !ref($opts{"-input"}) + and $opts{"-output"} == \*STDOUT ) + { + ## spit out the entire PODs. Might as well invoke perldoc + my $progpath = File::Spec->catfile($Config{scriptdir}, "perldoc"); + system($progpath, $opts{"-input"}); + if($?) { + # RT16091: fall back to more if perldoc failed + system($ENV{PAGER} || 'more', $opts{"-input"}); + } + } + else { + $parser->parse_from_file($opts{"-input"}, $opts{"-output"}); + } + + exit($opts{"-exitval"}) unless (lc($opts{"-exitval"}) eq 'noexit'); } ##--------------------------------------------------------------------------- @@ -513,10 +572,80 @@ 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; + } +} + +# 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. +sub _handle_element_end { + my ($self, $element) = @_; + if ($element eq 'head1') { + $$self{USAGE_HEAD1} = $$self{PENDING}[-1][1]; + if ($self->{USAGE_OPTIONS}->{-verbose} < 2) { + $$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}; + if (!$$self{USAGE_SELECT} || !@{ $$self{USAGE_SELECT} }) { + $$self{USAGE_SKIPPING} = 0; + } else { + 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. + if($self->{USAGE_OPTIONS}->{-verbose} < 2) { + 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 @@ -542,3 +671,4 @@ sub preprocess_paragraph { return $self->SUPER::preprocess_paragraph($_); } +1; # keep require happy diff --git a/gnu/usr.bin/perl/lib/Text/Abbrev.pm b/gnu/usr.bin/perl/lib/Text/Abbrev.pm index c6be63bcc60..07a6e4f464f 100644 --- a/gnu/usr.bin/perl/lib/Text/Abbrev.pm +++ b/gnu/usr.bin/perl/lib/Text/Abbrev.pm @@ -6,7 +6,7 @@ our $VERSION = '1.01'; =head1 NAME -abbrev - create an abbreviation table from a list +Text::Abbrev - create an abbreviation table from a list =head1 SYNOPSIS diff --git a/gnu/usr.bin/perl/pod/perlxstut.pod b/gnu/usr.bin/perl/pod/perlxstut.pod index 19d2fc1d2d7..12d54f7ff8a 100644 --- a/gnu/usr.bin/perl/pod/perlxstut.pod +++ b/gnu/usr.bin/perl/pod/perlxstut.pod @@ -1,6 +1,6 @@ =head1 NAME -perlXStut - Tutorial for writing XSUBs +perlxstut - Tutorial for writing XSUBs =head1 DESCRIPTION |