X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FPod%2FUsage.pm;h=40e517efac4ee5210f23726da9df12c2c4a30f7c;hb=1e73acc8af3eecb1b36ee831483e1e9a7b3d1662;hp=6e6fb7bb808a0e12c672a543680fdfa973c29032;hpb=1d7c184104c076988718a01b77c8706aae05b092;p=p5sagit%2Fp5-mst-13.2.git diff --git a/lib/Pod/Usage.pm b/lib/Pod/Usage.pm index 6e6fb7b..40e517e 100644 --- a/lib/Pod/Usage.pm +++ b/lib/Pod/Usage.pm @@ -1,7 +1,7 @@ ############################################################################# # Pod/Usage.pm -- print usage messages for the running script. # -# Copyright (C) 1996-1999 by Bradford Appleton. All rights reserved. +# Copyright (C) 1996-2000 by Bradford Appleton. All rights reserved. # This file is part of "PodParser". PodParser is free software; # you can redistribute it and/or modify it under the same terms # as Perl itself. @@ -10,8 +10,8 @@ package Pod::Usage; use vars qw($VERSION); -$VERSION = 1.090; ## Current version of this package -require 5.004; ## requires this Perl version or later +$VERSION = "1.33_01"; ## Current version of this package +require 5.005; ## requires this Perl version or later =head1 NAME @@ -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 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 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) +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 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 @@ -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 * @@ -311,22 +334,58 @@ command line syntax error is detected. They should also provide an option (usually C<-H> or C<-help>) to print a (possibly more verbose) usage message to C. Some scripts may even wish to go so far as to provide a means of printing their complete documentation to C -(perhaps by allowing a C<-man> option). The following example uses -B in combination with B to do all of these +(perhaps by allowing a C<-man> option). The following complete example +uses B in combination with B to do all of these things: use Getopt::Long; use Pod::Usage; + my $man = 0; + my $help = 0; ## Parse options and print usage if there is a syntax error, ## or if usage was explicitly requested. - GetOptions("help", "man", "flag1") || pod2usage(2); - pod2usage(1) if ($opt_help); - pod2usage(-verbose => 2) if ($opt_man); + GetOptions('help|?' => \$help, man => \$man) or pod2usage(2); + pod2usage(1) if $help; + pod2usage(-verbose => 2) if $man; ## If no arguments were given, then allow STDIN to be used only ## if it's not connected to a terminal (otherwise print usage) pod2usage("$0: No files given.") if ((@ARGV == 0) && (-t STDIN)); + __END__ + + =head1 NAME + + sample - Using GetOpt::Long and Pod::Usage + + =head1 SYNOPSIS + + sample [options] [file ...] + + Options: + -help brief help message + -man full documentation + + =head1 OPTIONS + + =over 8 + + =item B<-help> + + Print a brief help message and exits. + + =item B<-man> + + Prints the manual page and exits. + + =back + + =head1 DESCRIPTION + + B will read the given input file(s) and do something + useful with the contents thereof. + + =cut =head1 CAVEATS @@ -340,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 @@ -359,6 +425,7 @@ with re-writing this manpage. use strict; #use diagnostics; use Carp; +use Config; use Exporter; use File::Spec; @@ -383,7 +450,7 @@ BEGIN { ##--------------------------------- sub pod2usage { - local($_) = shift || ""; + local($_) = shift; my %opts; ## Collect arguments if (@_ > 0) { @@ -391,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'); @@ -425,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"}); @@ -438,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); @@ -451,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)' . @@ -459,10 +531,29 @@ 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"}); + } + else { + $parser->parse_from_file($opts{"-input"}, $opts{"-output"}); + } + + exit($opts{"-exitval"}) unless (lc($opts{"-exitval"}) eq 'noexit'); } ##--------------------------------------------------------------------------- @@ -477,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 @@ -506,3 +663,4 @@ sub preprocess_paragraph { return $self->SUPER::preprocess_paragraph($_); } +1; # keep require happy