1N/A#############################################################################
1N/A# Pod/Usage.pm -- print usage messages for the running script.
1N/A#
1N/A# Copyright (C) 1996-2000 by Bradford Appleton. All rights reserved.
1N/A# This file is part of "PodParser". PodParser is free software;
1N/A# you can redistribute it and/or modify it under the same terms
1N/A# as Perl itself.
1N/A#############################################################################
1N/A
1N/Apackage Pod::Usage;
1N/A
1N/Ause vars qw($VERSION);
1N/A$VERSION = 1.16; ## Current version of this package
1N/Arequire 5.005; ## requires this Perl version or later
1N/A
1N/A=head1 NAME
1N/A
1N/APod::Usage, pod2usage() - print a usage message from embedded pod documentation
1N/A
1N/A=head1 SYNOPSIS
1N/A
1N/A use Pod::Usage
1N/A
1N/A my $message_text = "This text precedes the usage message.";
1N/A my $exit_status = 2; ## The exit status to use
1N/A my $verbose_level = 0; ## The verbose level to use
1N/A my $filehandle = \*STDERR; ## The filehandle to write to
1N/A
1N/A pod2usage($message_text);
1N/A
1N/A pod2usage($exit_status);
1N/A
1N/A pod2usage( { -message => $message_text ,
1N/A -exitval => $exit_status ,
1N/A -verbose => $verbose_level,
1N/A -output => $filehandle } );
1N/A
1N/A pod2usage( -msg => $message_text ,
1N/A -exitval => $exit_status ,
1N/A -verbose => $verbose_level,
1N/A -output => $filehandle );
1N/A
1N/A=head1 ARGUMENTS
1N/A
1N/AB<pod2usage> should be given either a single argument, or a list of
1N/Aarguments corresponding to an associative array (a "hash"). When a single
1N/Aargument is given, it should correspond to exactly one of the following:
1N/A
1N/A=over 4
1N/A
1N/A=item *
1N/A
1N/AA string containing the text of a message to print I<before> printing
1N/Athe usage message
1N/A
1N/A=item *
1N/A
1N/AA numeric value corresponding to the desired exit status
1N/A
1N/A=item *
1N/A
1N/AA reference to a hash
1N/A
1N/A=back
1N/A
1N/AIf more than one argument is given then the entire argument list is
1N/Aassumed to be a hash. If a hash is supplied (either as a reference or
1N/Aas a list) it should contain one or more elements with the following
1N/Akeys:
1N/A
1N/A=over 4
1N/A
1N/A=item C<-message>
1N/A
1N/A=item C<-msg>
1N/A
1N/AThe text of a message to print immediately prior to printing the
1N/Aprogram's usage message.
1N/A
1N/A=item C<-exitval>
1N/A
1N/AThe desired exit status to pass to the B<exit()> function.
1N/AThis should be an integer, or else the string "NOEXIT" to
1N/Aindicate that control should simply be returned without
1N/Aterminating the invoking process.
1N/A
1N/A=item C<-verbose>
1N/A
1N/AThe desired level of "verboseness" to use when printing the usage
1N/Amessage. If the corresponding value is 0, then only the "SYNOPSIS"
1N/Asection of the pod documentation is printed. If the corresponding value
1N/Ais 1, then the "SYNOPSIS" section, along with any section entitled
1N/A"OPTIONS", "ARGUMENTS", or "OPTIONS AND ARGUMENTS" is printed. If the
1N/Acorresponding value is 2 or more then the entire manpage is printed.
1N/A
1N/A=item C<-output>
1N/A
1N/AA reference to a filehandle, or the pathname of a file to which the
1N/Ausage message should be written. The default is C<\*STDERR> unless the
1N/Aexit value is less than 2 (in which case the default is C<\*STDOUT>).
1N/A
1N/A=item C<-input>
1N/A
1N/AA reference to a filehandle, or the pathname of a file from which the
1N/Ainvoking script's pod documentation should be read. It defaults to the
1N/Afile indicated by C<$0> (C<$PROGRAM_NAME> for users of F<English.pm>).
1N/A
1N/A=item C<-pathlist>
1N/A
1N/AA list of directory paths. If the input file does not exist, then it
1N/Awill be searched for in the given directory list (in the order the
1N/Adirectories appear in the list). It defaults to the list of directories
1N/Aimplied by C<$ENV{PATH}>. The list may be specified either by a reference
1N/Ato an array, or by a string of directory paths which use the same path
1N/Aseparator as C<$ENV{PATH}> on your system (e.g., C<:> for Unix, C<;> for
1N/AMSWin32 and DOS).
1N/A
1N/A=back
1N/A
1N/A=head1 DESCRIPTION
1N/A
1N/AB<pod2usage> will print a usage message for the invoking script (using
1N/Aits embedded pod documentation) and then exit the script with the
1N/Adesired exit status. The usage message printed may have any one of three
1N/Alevels of "verboseness": If the verbose level is 0, then only a synopsis
1N/Ais printed. If the verbose level is 1, then the synopsis is printed
1N/Aalong with a description (if present) of the command line options and
1N/Aarguments. If the verbose level is 2, then the entire manual page is
1N/Aprinted.
1N/A
1N/AUnless they are explicitly specified, the default values for the exit
1N/Astatus, verbose level, and output stream to use are determined as
1N/Afollows:
1N/A
1N/A=over 4
1N/A
1N/A=item *
1N/A
1N/AIf neither the exit status nor the verbose level is specified, then the
1N/Adefault is to use an exit status of 2 with a verbose level of 0.
1N/A
1N/A=item *
1N/A
1N/AIf an exit status I<is> specified but the verbose level is I<not>, then the
1N/Averbose level will default to 1 if the exit status is less than 2 and
1N/Awill default to 0 otherwise.
1N/A
1N/A=item *
1N/A
1N/AIf an exit status is I<not> specified but verbose level I<is> given, then
1N/Athe exit status will default to 2 if the verbose level is 0 and will
1N/Adefault to 1 otherwise.
1N/A
1N/A=item *
1N/A
1N/AIf the exit status used is less than 2, then output is printed on
1N/AC<STDOUT>. Otherwise output is printed on C<STDERR>.
1N/A
1N/A=back
1N/A
1N/AAlthough the above may seem a bit confusing at first, it generally does
1N/A"the right thing" in most situations. This determination of the default
1N/Avalues to use is based upon the following typical Unix conventions:
1N/A
1N/A=over 4
1N/A
1N/A=item *
1N/A
1N/AAn exit status of 0 implies "success". For example, B<diff(1)> exits
1N/Awith a status of 0 if the two files have the same contents.
1N/A
1N/A=item *
1N/A
1N/AAn exit status of 1 implies possibly abnormal, but non-defective, program
1N/Atermination. For example, B<grep(1)> exits with a status of 1 if
1N/Ait did I<not> find a matching line for the given regular expression.
1N/A
1N/A=item *
1N/A
1N/AAn exit status of 2 or more implies a fatal error. For example, B<ls(1)>
1N/Aexits with a status of 2 if you specify an illegal (unknown) option on
1N/Athe command line.
1N/A
1N/A=item *
1N/A
1N/AUsage messages issued as a result of bad command-line syntax should go
1N/Ato C<STDERR>. However, usage messages issued due to an explicit request
1N/Ato print usage (like specifying B<-help> on the command line) should go
1N/Ato C<STDOUT>, just in case the user wants to pipe the output to a pager
1N/A(such as B<more(1)>).
1N/A
1N/A=item *
1N/A
1N/AIf program usage has been explicitly requested by the user, it is often
1N/Adesireable to exit with a status of 1 (as opposed to 0) after issuing
1N/Athe user-requested usage message. It is also desireable to give a
1N/Amore verbose description of program usage in this case.
1N/A
1N/A=back
1N/A
1N/AB<pod2usage> doesn't force the above conventions upon you, but it will
1N/Ause them by default if you don't expressly tell it to do otherwise. The
1N/Aability of B<pod2usage()> to accept a single number or a string makes it
1N/Aconvenient to use as an innocent looking error message handling function:
1N/A
1N/A use Pod::Usage;
1N/A use Getopt::Long;
1N/A
1N/A ## Parse options
1N/A GetOptions("help", "man", "flag1") || pod2usage(2);
1N/A pod2usage(1) if ($opt_help);
1N/A pod2usage(-verbose => 2) if ($opt_man);
1N/A
1N/A ## Check for too many filenames
1N/A pod2usage("$0: Too many files given.\n") if (@ARGV > 1);
1N/A
1N/ASome user's however may feel that the above "economy of expression" is
1N/Anot particularly readable nor consistent and may instead choose to do
1N/Asomething more like the following:
1N/A
1N/A use Pod::Usage;
1N/A use Getopt::Long;
1N/A
1N/A ## Parse options
1N/A GetOptions("help", "man", "flag1") || pod2usage(-verbose => 0);
1N/A pod2usage(-verbose => 1) if ($opt_help);
1N/A pod2usage(-verbose => 2) if ($opt_man);
1N/A
1N/A ## Check for too many filenames
1N/A pod2usage(-verbose => 2, -message => "$0: Too many files given.\n")
1N/A if (@ARGV > 1);
1N/A
1N/AAs with all things in Perl, I<there's more than one way to do it>, and
1N/AB<pod2usage()> adheres to this philosophy. If you are interested in
1N/Aseeing a number of different ways to invoke B<pod2usage> (although by no
1N/Ameans exhaustive), please refer to L<"EXAMPLES">.
1N/A
1N/A=head1 EXAMPLES
1N/A
1N/AEach of the following invocations of C<pod2usage()> will print just the
1N/A"SYNOPSIS" section to C<STDERR> and will exit with a status of 2:
1N/A
1N/A pod2usage();
1N/A
1N/A pod2usage(2);
1N/A
1N/A pod2usage(-verbose => 0);
1N/A
1N/A pod2usage(-exitval => 2);
1N/A
1N/A pod2usage({-exitval => 2, -output => \*STDERR});
1N/A
1N/A pod2usage({-verbose => 0, -output => \*STDERR});
1N/A
1N/A pod2usage(-exitval => 2, -verbose => 0);
1N/A
1N/A pod2usage(-exitval => 2, -verbose => 0, -output => \*STDERR);
1N/A
1N/AEach of the following invocations of C<pod2usage()> will print a message
1N/Aof "Syntax error." (followed by a newline) to C<STDERR>, immediately
1N/Afollowed by just the "SYNOPSIS" section (also printed to C<STDERR>) and
1N/Awill exit with a status of 2:
1N/A
1N/A pod2usage("Syntax error.");
1N/A
1N/A pod2usage(-message => "Syntax error.", -verbose => 0);
1N/A
1N/A pod2usage(-msg => "Syntax error.", -exitval => 2);
1N/A
1N/A pod2usage({-msg => "Syntax error.", -exitval => 2, -output => \*STDERR});
1N/A
1N/A pod2usage({-msg => "Syntax error.", -verbose => 0, -output => \*STDERR});
1N/A
1N/A pod2usage(-msg => "Syntax error.", -exitval => 2, -verbose => 0);
1N/A
1N/A pod2usage(-message => "Syntax error.",
1N/A -exitval => 2,
1N/A -verbose => 0,
1N/A -output => \*STDERR);
1N/A
1N/AEach of the following invocations of C<pod2usage()> will print the
1N/A"SYNOPSIS" section and any "OPTIONS" and/or "ARGUMENTS" sections to
1N/AC<STDOUT> and will exit with a status of 1:
1N/A
1N/A pod2usage(1);
1N/A
1N/A pod2usage(-verbose => 1);
1N/A
1N/A pod2usage(-exitval => 1);
1N/A
1N/A pod2usage({-exitval => 1, -output => \*STDOUT});
1N/A
1N/A pod2usage({-verbose => 1, -output => \*STDOUT});
1N/A
1N/A pod2usage(-exitval => 1, -verbose => 1);
1N/A
1N/A pod2usage(-exitval => 1, -verbose => 1, -output => \*STDOUT});
1N/A
1N/AEach of the following invocations of C<pod2usage()> will print the
1N/Aentire manual page to C<STDOUT> and will exit with a status of 1:
1N/A
1N/A pod2usage(-verbose => 2);
1N/A
1N/A pod2usage({-verbose => 2, -output => \*STDOUT});
1N/A
1N/A pod2usage(-exitval => 1, -verbose => 2);
1N/A
1N/A pod2usage({-exitval => 1, -verbose => 2, -output => \*STDOUT});
1N/A
1N/A=head2 Recommended Use
1N/A
1N/AMost scripts should print some type of usage message to C<STDERR> when a
1N/Acommand line syntax error is detected. They should also provide an
1N/Aoption (usually C<-H> or C<-help>) to print a (possibly more verbose)
1N/Ausage message to C<STDOUT>. Some scripts may even wish to go so far as to
1N/Aprovide a means of printing their complete documentation to C<STDOUT>
1N/A(perhaps by allowing a C<-man> option). The following complete example
1N/Auses B<Pod::Usage> in combination with B<Getopt::Long> to do all of these
1N/Athings:
1N/A
1N/A use Getopt::Long;
1N/A use Pod::Usage;
1N/A
1N/A my $man = 0;
1N/A my $help = 0;
1N/A ## Parse options and print usage if there is a syntax error,
1N/A ## or if usage was explicitly requested.
1N/A GetOptions('help|?' => \$help, man => \$man) or pod2usage(2);
1N/A pod2usage(1) if $help;
1N/A pod2usage(-verbose => 2) if $man;
1N/A
1N/A ## If no arguments were given, then allow STDIN to be used only
1N/A ## if it's not connected to a terminal (otherwise print usage)
1N/A pod2usage("$0: No files given.") if ((@ARGV == 0) && (-t STDIN));
1N/A __END__
1N/A
1N/A =head1 NAME
1N/A
1N/A sample - Using GetOpt::Long and Pod::Usage
1N/A
1N/A =head1 SYNOPSIS
1N/A
1N/A sample [options] [file ...]
1N/A
1N/A Options:
1N/A -help brief help message
1N/A -man full documentation
1N/A
1N/A =head1 OPTIONS
1N/A
1N/A =over 8
1N/A
1N/A =item B<-help>
1N/A
1N/A Print a brief help message and exits.
1N/A
1N/A =item B<-man>
1N/A
1N/A Prints the manual page and exits.
1N/A
1N/A =back
1N/A
1N/A =head1 DESCRIPTION
1N/A
1N/A B<This program> will read the given input file(s) and do something
1N/A useful with the contents thereof.
1N/A
1N/A =cut
1N/A
1N/A=head1 CAVEATS
1N/A
1N/ABy default, B<pod2usage()> will use C<$0> as the path to the pod input
1N/Afile. Unfortunately, not all systems on which Perl runs will set C<$0>
1N/Aproperly (although if C<$0> isn't found, B<pod2usage()> will search
1N/AC<$ENV{PATH}> or else the list specified by the C<-pathlist> option).
1N/AIf this is the case for your system, you may need to explicitly specify
1N/Athe path to the pod docs for the invoking script using something
1N/Asimilar to the following:
1N/A
1N/A pod2usage(-exitval => 2, -input => "/path/to/your/pod/docs");
1N/A
1N/A=head1 AUTHOR
1N/A
1N/APlease report bugs using L<http://rt.cpan.org>.
1N/A
1N/ABrad Appleton E<lt>bradapp@enteract.comE<gt>
1N/A
1N/ABased on code for B<Pod::Text::pod2text()> written by
1N/ATom Christiansen E<lt>tchrist@mox.perl.comE<gt>
1N/A
1N/A=head1 ACKNOWLEDGEMENTS
1N/A
1N/ASteven McDougall E<lt>swmcd@world.std.comE<gt> for his help and patience
1N/Awith re-writing this manpage.
1N/A
1N/A=cut
1N/A
1N/A#############################################################################
1N/A
1N/Ause strict;
1N/A#use diagnostics;
1N/Ause Carp;
1N/Ause Config;
1N/Ause Exporter;
1N/Ause File::Spec;
1N/A
1N/Ause vars qw(@ISA @EXPORT);
1N/A@EXPORT = qw(&pod2usage);
1N/ABEGIN {
1N/A if ( $] >= 5.005_58 ) {
1N/A require Pod::Text;
1N/A @ISA = qw( Pod::Text );
1N/A }
1N/A else {
1N/A require Pod::PlainText;
1N/A @ISA = qw( Pod::PlainText );
1N/A }
1N/A}
1N/A
1N/A
1N/A##---------------------------------------------------------------------------
1N/A
1N/A##---------------------------------
1N/A## Function definitions begin here
1N/A##---------------------------------
1N/A
1N/Asub pod2usage {
1N/A local($_) = shift || "";
1N/A my %opts;
1N/A ## Collect arguments
1N/A if (@_ > 0) {
1N/A ## Too many arguments - assume that this is a hash and
1N/A ## the user forgot to pass a reference to it.
1N/A %opts = ($_, @_);
1N/A }
1N/A elsif (ref $_) {
1N/A ## User passed a ref to a hash
1N/A %opts = %{$_} if (ref($_) eq 'HASH');
1N/A }
1N/A elsif (/^[-+]?\d+$/) {
1N/A ## User passed in the exit value to use
1N/A $opts{"-exitval"} = $_;
1N/A }
1N/A else {
1N/A ## User passed in a message to print before issuing usage.
1N/A $_ and $opts{"-message"} = $_;
1N/A }
1N/A
1N/A ## Need this for backward compatibility since we formerly used
1N/A ## options that were all uppercase words rather than ones that
1N/A ## looked like Unix command-line options.
1N/A ## to be uppercase keywords)
1N/A %opts = map {
1N/A my $val = $opts{$_};
1N/A s/^(?=\w)/-/;
1N/A /^-msg/i and $_ = '-message';
1N/A /^-exit/i and $_ = '-exitval';
1N/A lc($_) => $val;
1N/A } (keys %opts);
1N/A
1N/A ## Now determine default -exitval and -verbose values to use
1N/A if ((! defined $opts{"-exitval"}) && (! defined $opts{"-verbose"})) {
1N/A $opts{"-exitval"} = 2;
1N/A $opts{"-verbose"} = 0;
1N/A }
1N/A elsif (! defined $opts{"-exitval"}) {
1N/A $opts{"-exitval"} = ($opts{"-verbose"} > 0) ? 1 : 2;
1N/A }
1N/A elsif (! defined $opts{"-verbose"}) {
1N/A $opts{"-verbose"} = ($opts{"-exitval"} < 2);
1N/A }
1N/A
1N/A ## Default the output file
1N/A $opts{"-output"} = (lc($opts{"-exitval"}) eq "noexit" ||
1N/A $opts{"-exitval"} < 2) ? \*STDOUT : \*STDERR
1N/A unless (defined $opts{"-output"});
1N/A ## Default the input file
1N/A $opts{"-input"} = $0 unless (defined $opts{"-input"});
1N/A
1N/A ## Look up input file in path if it doesnt exist.
1N/A unless ((ref $opts{"-input"}) || (-e $opts{"-input"})) {
1N/A my ($dirname, $basename) = ('', $opts{"-input"});
1N/A my $pathsep = ($^O =~ /^(?:dos|os2|MSWin32)$/) ? ";"
1N/A : (($^O eq 'MacOS' || $^O eq 'VMS') ? ',' : ":");
1N/A my $pathspec = $opts{"-pathlist"} || $ENV{PATH} || $ENV{PERL5LIB};
1N/A
1N/A my @paths = (ref $pathspec) ? @$pathspec : split($pathsep, $pathspec);
1N/A for $dirname (@paths) {
1N/A $_ = File::Spec->catfile($dirname, $basename) if length;
1N/A last if (-e $_) && ($opts{"-input"} = $_);
1N/A }
1N/A }
1N/A
1N/A ## Now create a pod reader and constrain it to the desired sections.
1N/A my $parser = new Pod::Usage(USAGE_OPTIONS => \%opts);
1N/A if ($opts{"-verbose"} == 0) {
1N/A $parser->select("SYNOPSIS");
1N/A }
1N/A elsif ($opts{"-verbose"} == 1) {
1N/A my $opt_re = '(?i)' .
1N/A '(?:OPTIONS|ARGUMENTS)' .
1N/A '(?:\s*(?:AND|\/)\s*(?:OPTIONS|ARGUMENTS))?';
1N/A $parser->select( 'SYNOPSIS', $opt_re, "DESCRIPTION/$opt_re" );
1N/A }
1N/A
1N/A ## Now translate the pod document and then exit with the desired status
1N/A if ( $opts{"-verbose"} >= 2
1N/A and !ref($opts{"-input"})
1N/A and $opts{"-output"} == \*STDOUT )
1N/A {
1N/A ## spit out the entire PODs. Might as well invoke perldoc
1N/A my $progpath = File::Spec->catfile($Config{scriptdir}, "perldoc");
1N/A system($progpath, $opts{"-input"});
1N/A }
1N/A else {
1N/A $parser->parse_from_file($opts{"-input"}, $opts{"-output"});
1N/A }
1N/A
1N/A exit($opts{"-exitval"}) unless (lc($opts{"-exitval"}) eq 'noexit');
1N/A}
1N/A
1N/A##---------------------------------------------------------------------------
1N/A
1N/A##-------------------------------
1N/A## Method definitions begin here
1N/A##-------------------------------
1N/A
1N/Asub new {
1N/A my $this = shift;
1N/A my $class = ref($this) || $this;
1N/A my %params = @_;
1N/A my $self = {%params};
1N/A bless $self, $class;
1N/A $self->initialize();
1N/A return $self;
1N/A}
1N/A
1N/Asub begin_pod {
1N/A my $self = shift;
1N/A $self->SUPER::begin_pod(); ## Have to call superclass
1N/A my $msg = $self->{USAGE_OPTIONS}->{-message} or return 1;
1N/A my $out_fh = $self->output_handle();
1N/A print $out_fh "$msg\n";
1N/A}
1N/A
1N/Asub preprocess_paragraph {
1N/A my $self = shift;
1N/A local $_ = shift;
1N/A my $line = shift;
1N/A ## See if this is a heading and we arent printing the entire manpage.
1N/A if (($self->{USAGE_OPTIONS}->{-verbose} < 2) && /^=head/) {
1N/A ## Change the title of the SYNOPSIS section to USAGE
1N/A s/^=head1\s+SYNOPSIS\s*$/=head1 USAGE/;
1N/A ## Try to do some lowercasing instead of all-caps in headings
1N/A s{([A-Z])([A-Z]+)}{((length($2) > 2) ? $1 : lc($1)) . lc($2)}ge;
1N/A ## Use a colon to end all headings
1N/A s/\s*$/:/ unless (/:\s*$/);
1N/A $_ .= "\n";
1N/A }
1N/A return $self->SUPER::preprocess_paragraph($_);
1N/A}
1N/A
1N/A1; # keep require happy