X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FPod%2FUsage.pm;h=40e517efac4ee5210f23726da9df12c2c4a30f7c;hb=1e73acc8af3eecb1b36ee831483e1e9a7b3d1662;hp=9898a97c00b7f149b5e13b8c211656ad82cef3ff;hpb=98c7bfd488ae0b104d3bdd0c2f363b258374696b;p=p5sagit%2Fp5-mst-13.2.git diff --git a/lib/Pod/Usage.pm b/lib/Pod/Usage.pm index 9898a97..40e517e 100644 --- a/lib/Pod/Usage.pm +++ b/lib/Pod/Usage.pm @@ -10,7 +10,7 @@ package Pod::Usage; use vars qw($VERSION); -$VERSION = 1.14; ## Current version of this package +$VERSION = "1.33_01"; ## 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 should be given either a single argument, or a list of @@ -93,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) +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 @@ -115,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 when -verbose >= 2 is +specified. This does not work well e.g. if the script was packed +with L. The -noperldoc option suppresses the external call to +L and uses the simple text formatter (L) to +output the POD. + =back =head1 DESCRIPTION @@ -379,8 +399,15 @@ 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 the script itself changes the current working directory +(see L) I calling pod2usage, Pod::Usage will +fail even on robust platforms. Don't do that. + =head1 AUTHOR +Please report bugs using L. + Brad Appleton Ebradapp@enteract.comE Based on code for B written by @@ -423,7 +450,7 @@ BEGIN { ##--------------------------------- sub pod2usage { - local($_) = shift || ""; + local($_) = shift; my %opts; ## Collect arguments if (@_ > 0) { @@ -431,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'); @@ -465,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"}); @@ -491,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)' . @@ -499,9 +531,17 @@ 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 - if ( $opts{"-verbose"} >= 2 + if ( !$opts{"-noperldoc"} + and $opts{"-verbose"} >= 2 and !ref($opts{"-input"}) and $opts{"-output"} == \*STDOUT ) { @@ -528,10 +568,76 @@ 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}; + 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