545 lines
16 KiB
Perl
545 lines
16 KiB
Perl
#############################################################################
|
|
# Pod/Usage.pm -- print usage messages for the running script.
|
|
#
|
|
# 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.
|
|
#############################################################################
|
|
|
|
package Pod::Usage;
|
|
|
|
use vars qw($VERSION);
|
|
$VERSION = 1.12; ## 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
|
|
|
|
=head1 SYNOPSIS
|
|
|
|
use Pod::Usage
|
|
|
|
my $message_text = "This text precedes the usage message.";
|
|
my $exit_status = 2; ## The exit status to use
|
|
my $verbose_level = 0; ## The verbose level to use
|
|
my $filehandle = \*STDERR; ## The filehandle to write to
|
|
|
|
pod2usage($message_text);
|
|
|
|
pod2usage($exit_status);
|
|
|
|
pod2usage( { -message => $message_text ,
|
|
-exitval => $exit_status ,
|
|
-verbose => $verbose_level,
|
|
-output => $filehandle } );
|
|
|
|
pod2usage( -msg => $message_text ,
|
|
-exitval => $exit_status ,
|
|
-verbose => $verbose_level,
|
|
-output => $filehandle );
|
|
|
|
=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
|
|
|
|
=item *
|
|
|
|
A string containing the text of a message to print I<before> printing
|
|
the usage message
|
|
|
|
=item *
|
|
|
|
A numeric value corresponding to the desired exit status
|
|
|
|
=item *
|
|
|
|
A reference to a hash
|
|
|
|
=back
|
|
|
|
If more than one argument is given then the entire argument list is
|
|
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
|
|
|
|
=item C<-message>
|
|
|
|
=item C<-msg>
|
|
|
|
The text of a message to print immediately prior to printing the
|
|
program's usage message.
|
|
|
|
=item C<-exitval>
|
|
|
|
The desired exit status to pass to the B<exit()> function.
|
|
|
|
=item C<-verbose>
|
|
|
|
The desired level of "verboseness" to use when printing the usage
|
|
message. If the corresponding value is 0, then only the "SYNOPSIS"
|
|
section of the pod documentation is printed. If the corresponding value
|
|
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.
|
|
|
|
=item C<-output>
|
|
|
|
A reference to a filehandle, or the pathname of a file to which the
|
|
usage message should be written. The default is C<\*STDERR> unless the
|
|
exit value is less than 2 (in which case the default is C<\*STDOUT>).
|
|
|
|
=item C<-input>
|
|
|
|
A reference to a filehandle, or the pathname of a file from which the
|
|
invoking script's pod documentation should be read. It defaults to the
|
|
file indicated by C<$0> (C<$PROGRAM_NAME> for users of F<English.pm>).
|
|
|
|
=item C<-pathlist>
|
|
|
|
A list of directory paths. If the input file does not exist, then it
|
|
will be searched for in the given directory list (in the order the
|
|
directories appear in the list). It defaults to the list of directories
|
|
implied by C<$ENV{PATH}>. The list may be specified either by a reference
|
|
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).
|
|
|
|
=back
|
|
|
|
=head1 DESCRIPTION
|
|
|
|
B<pod2usage> will print a usage message for the invoking script (using
|
|
its embedded pod documentation) and then exit the script with the
|
|
desired exit status. The usage message printed may have any one of three
|
|
levels of "verboseness": If the verbose level is 0, then only a synopsis
|
|
is printed. If the verbose level is 1, then the synopsis is printed
|
|
along with a description (if present) of the command line options and
|
|
arguments. If the verbose level is 2, then the entire manual page is
|
|
printed.
|
|
|
|
Unless they are explicitly specified, the default values for the exit
|
|
status, verbose level, and output stream to use are determined as
|
|
follows:
|
|
|
|
=over
|
|
|
|
=item *
|
|
|
|
If neither the exit status nor the verbose level is specified, then the
|
|
default is to use an exit status of 2 with a verbose level of 0.
|
|
|
|
=item *
|
|
|
|
If an exit status I<is> specified but the verbose level is I<not>, then the
|
|
verbose level will default to 1 if the exit status is less than 2 and
|
|
will default to 0 otherwise.
|
|
|
|
=item *
|
|
|
|
If an exit status is I<not> specified but verbose level I<is> given, then
|
|
the exit status will default to 2 if the verbose level is 0 and will
|
|
default to 1 otherwise.
|
|
|
|
=item *
|
|
|
|
If the exit status used is less than 2, then output is printed on
|
|
C<STDOUT>. Otherwise output is printed on C<STDERR>.
|
|
|
|
=back
|
|
|
|
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
|
|
|
|
=item *
|
|
|
|
An exit status of 0 implies "success". For example, B<diff(1)> exits
|
|
with a status of 0 if the two files have the same contents.
|
|
|
|
=item *
|
|
|
|
An exit status of 1 implies possibly abnormal, but non-defective, program
|
|
termination. For example, B<grep(1)> exits with a status of 1 if
|
|
it did I<not> find a matching line for the given regular expression.
|
|
|
|
=item *
|
|
|
|
An exit status of 2 or more implies a fatal error. For example, B<ls(1)>
|
|
exits with a status of 2 if you specify an illegal (unknown) option on
|
|
the command line.
|
|
|
|
=item *
|
|
|
|
Usage messages issued as a result of bad command-line syntax should go
|
|
to C<STDERR>. However, usage messages issued due to an explicit request
|
|
to print usage (like specifying B<-help> on the command line) should go
|
|
to C<STDOUT>, just in case the user wants to pipe the output to a pager
|
|
(such as B<more(1)>).
|
|
|
|
=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
|
|
more verbose description of program usage in this case.
|
|
|
|
=back
|
|
|
|
B<pod2usage> doesn't force the above conventions upon you, but it will
|
|
use them by default if you don't expressly tell it to do otherwise. The
|
|
ability of B<pod2usage()> to accept a single number or a string makes it
|
|
convenient to use as an innocent looking error message handling function:
|
|
|
|
use Pod::Usage;
|
|
use Getopt::Long;
|
|
|
|
## Parse options
|
|
GetOptions("help", "man", "flag1") || pod2usage(2);
|
|
pod2usage(1) if ($opt_help);
|
|
pod2usage(-verbose => 2) if ($opt_man);
|
|
|
|
## Check for too many filenames
|
|
pod2usage("$0: Too many files given.\n") if (@ARGV > 1);
|
|
|
|
Some user's however may feel that the above "economy of expression" is
|
|
not particularly readable nor consistent and may instead choose to do
|
|
something more like the following:
|
|
|
|
use Pod::Usage;
|
|
use Getopt::Long;
|
|
|
|
## Parse options
|
|
GetOptions("help", "man", "flag1") || pod2usage(-verbose => 0);
|
|
pod2usage(-verbose => 1) if ($opt_help);
|
|
pod2usage(-verbose => 2) if ($opt_man);
|
|
|
|
## Check for too many filenames
|
|
pod2usage(-verbose => 2, -message => "$0: Too many files given.\n")
|
|
if (@ARGV > 1);
|
|
|
|
As with all things in Perl, I<there's more than one way to do it>, and
|
|
B<pod2usage()> adheres to this philosophy. If you are interested in
|
|
seeing a number of different ways to invoke B<pod2usage> (although by no
|
|
means exhaustive), please refer to L<"EXAMPLES">.
|
|
|
|
=head1 EXAMPLES
|
|
|
|
Each of the following invocations of C<pod2usage()> will print just the
|
|
"SYNOPSIS" section to C<STDERR> and will exit with a status of 2:
|
|
|
|
pod2usage();
|
|
|
|
pod2usage(2);
|
|
|
|
pod2usage(-verbose => 0);
|
|
|
|
pod2usage(-exitval => 2);
|
|
|
|
pod2usage({-exitval => 2, -output => \*STDERR});
|
|
|
|
pod2usage({-verbose => 0, -output => \*STDERR});
|
|
|
|
pod2usage(-exitval => 2, -verbose => 0);
|
|
|
|
pod2usage(-exitval => 2, -verbose => 0, -output => \*STDERR);
|
|
|
|
Each of the following invocations of C<pod2usage()> will print a message
|
|
of "Syntax error." (followed by a newline) to C<STDERR>, immediately
|
|
followed by just the "SYNOPSIS" section (also printed to C<STDERR>) and
|
|
will exit with a status of 2:
|
|
|
|
pod2usage("Syntax error.");
|
|
|
|
pod2usage(-message => "Syntax error.", -verbose => 0);
|
|
|
|
pod2usage(-msg => "Syntax error.", -exitval => 2);
|
|
|
|
pod2usage({-msg => "Syntax error.", -exitval => 2, -output => \*STDERR});
|
|
|
|
pod2usage({-msg => "Syntax error.", -verbose => 0, -output => \*STDERR});
|
|
|
|
pod2usage(-msg => "Syntax error.", -exitval => 2, -verbose => 0);
|
|
|
|
pod2usage(-message => "Syntax error.",
|
|
-exitval => 2,
|
|
-verbose => 0,
|
|
-output => \*STDERR);
|
|
|
|
Each of the following invocations of C<pod2usage()> will print the
|
|
"SYNOPSIS" section and any "OPTIONS" and/or "ARGUMENTS" sections to
|
|
C<STDOUT> and will exit with a status of 1:
|
|
|
|
pod2usage(1);
|
|
|
|
pod2usage(-verbose => 1);
|
|
|
|
pod2usage(-exitval => 1);
|
|
|
|
pod2usage({-exitval => 1, -output => \*STDOUT});
|
|
|
|
pod2usage({-verbose => 1, -output => \*STDOUT});
|
|
|
|
pod2usage(-exitval => 1, -verbose => 1);
|
|
|
|
pod2usage(-exitval => 1, -verbose => 1, -output => \*STDOUT});
|
|
|
|
Each of the following invocations of C<pod2usage()> will print the
|
|
entire manual page to C<STDOUT> and will exit with a status of 1:
|
|
|
|
pod2usage(-verbose => 2);
|
|
|
|
pod2usage({-verbose => 2, -output => \*STDOUT});
|
|
|
|
pod2usage(-exitval => 1, -verbose => 2);
|
|
|
|
pod2usage({-exitval => 1, -verbose => 2, -output => \*STDOUT});
|
|
|
|
=head2 Recommended Use
|
|
|
|
Most scripts should print some type of usage message to C<STDERR> when a
|
|
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<STDOUT>. Some scripts may even wish to go so far as to
|
|
provide a means of printing their complete documentation to C<STDOUT>
|
|
(perhaps by allowing a C<-man> option). The following complete example
|
|
uses B<Pod::Usage> in combination with B<Getopt::Long> 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|?' => \$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<This program> will read the given input file(s) and do something
|
|
useful with the contents thereof.
|
|
|
|
=cut
|
|
|
|
=head1 CAVEATS
|
|
|
|
By default, B<pod2usage()> will use C<$0> as the path to the pod input
|
|
file. Unfortunately, not all systems on which Perl runs will set C<$0>
|
|
properly (although if C<$0> isn't found, B<pod2usage()> will search
|
|
C<$ENV{PATH}> or else the list specified by the C<-pathlist> option).
|
|
If this is the case for your system, you may need to explicitly specify
|
|
the path to the pod docs for the invoking script using something
|
|
similar to the following:
|
|
|
|
pod2usage(-exitval => 2, -input => "/path/to/your/pod/docs");
|
|
|
|
=head1 AUTHOR
|
|
|
|
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
|
|
|
|
Steven McDougall E<lt>swmcd@world.std.comE<gt> for his help and patience
|
|
with re-writing this manpage.
|
|
|
|
=cut
|
|
|
|
#############################################################################
|
|
|
|
use strict;
|
|
#use diagnostics;
|
|
use Carp;
|
|
use Exporter;
|
|
use File::Spec;
|
|
|
|
use vars qw(@ISA @EXPORT);
|
|
@EXPORT = qw(&pod2usage);
|
|
BEGIN {
|
|
if ( $] >= 5.005_58 ) {
|
|
require Pod::Text;
|
|
@ISA = qw( Pod::Text );
|
|
}
|
|
else {
|
|
require Pod::PlainText;
|
|
@ISA = qw( Pod::PlainText );
|
|
}
|
|
}
|
|
|
|
|
|
##---------------------------------------------------------------------------
|
|
|
|
##---------------------------------
|
|
## Function definitions begin here
|
|
##---------------------------------
|
|
|
|
sub pod2usage {
|
|
local($_) = shift || "";
|
|
my %opts;
|
|
## Collect arguments
|
|
if (@_ > 0) {
|
|
## Too many arguments - assume that this is a hash and
|
|
## the user forgot to pass a reference to it.
|
|
%opts = ($_, @_);
|
|
}
|
|
elsif (ref $_) {
|
|
## User passed a ref to a hash
|
|
%opts = %{$_} if (ref($_) eq 'HASH');
|
|
}
|
|
elsif (/^[-+]?\d+$/) {
|
|
## User passed in the exit value to use
|
|
$opts{"-exitval"} = $_;
|
|
}
|
|
else {
|
|
## User passed in a message to print before issuing usage.
|
|
$_ and $opts{"-message"} = $_;
|
|
}
|
|
|
|
## Need this for backward compatibility since we formerly used
|
|
## options that were all uppercase words rather than ones that
|
|
## looked like Unix command-line options.
|
|
## to be uppercase keywords)
|
|
%opts = map {
|
|
my $val = $opts{$_};
|
|
s/^(?=\w)/-/;
|
|
/^-msg/i and $_ = '-message';
|
|
/^-exit/i and $_ = '-exitval';
|
|
lc($_) => $val;
|
|
} (keys %opts);
|
|
|
|
## Now determine default -exitval and -verbose values to use
|
|
if ((! defined $opts{"-exitval"}) && (! defined $opts{"-verbose"})) {
|
|
$opts{"-exitval"} = 2;
|
|
$opts{"-verbose"} = 0;
|
|
}
|
|
elsif (! defined $opts{"-exitval"}) {
|
|
$opts{"-exitval"} = ($opts{"-verbose"} > 0) ? 1 : 2;
|
|
}
|
|
elsif (! defined $opts{"-verbose"}) {
|
|
$opts{"-verbose"} = ($opts{"-exitval"} < 2);
|
|
}
|
|
|
|
## Default the output file
|
|
$opts{"-output"} = ($opts{"-exitval"} < 2) ? \*STDOUT : \*STDERR
|
|
unless (defined $opts{"-output"});
|
|
## Default the input file
|
|
$opts{"-input"} = $0 unless (defined $opts{"-input"});
|
|
|
|
## Look up input file in path if it doesnt exist.
|
|
unless ((ref $opts{"-input"}) || (-e $opts{"-input"})) {
|
|
my ($dirname, $basename) = ('', $opts{"-input"});
|
|
my $pathsep = ($^O =~ /^(?:dos|os2|MSWin32)$/) ? ";"
|
|
: (($^O eq 'MacOS') ? ',' : ":");
|
|
my $pathspec = $opts{"-pathlist"} || $ENV{PATH} || $ENV{PERL5LIB};
|
|
|
|
my @paths = (ref $pathspec) ? @$pathspec : split($pathsep, $pathspec);
|
|
for $dirname (@paths) {
|
|
$_ = File::Spec->catfile($dirname, $basename) if length;
|
|
last if (-e $_) && ($opts{"-input"} = $_);
|
|
}
|
|
}
|
|
|
|
## 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");
|
|
}
|
|
elsif ($opts{"-verbose"} == 1) {
|
|
my $opt_re = '(?i)' .
|
|
'(?:OPTIONS|ARGUMENTS)' .
|
|
'(?:\s*(?:AND|\/)\s*(?:OPTIONS|ARGUMENTS))?';
|
|
$parser->select( 'SYNOPSIS', $opt_re, "DESCRIPTION/$opt_re" );
|
|
}
|
|
|
|
## Now translate the pod document and then exit with the desired status
|
|
$parser->parse_from_file($opts{"-input"}, $opts{"-output"});
|
|
exit($opts{"-exitval"});
|
|
}
|
|
|
|
##---------------------------------------------------------------------------
|
|
|
|
##-------------------------------
|
|
## Method definitions begin here
|
|
##-------------------------------
|
|
|
|
sub new {
|
|
my $this = shift;
|
|
my $class = ref($this) || $this;
|
|
my %params = @_;
|
|
my $self = {%params};
|
|
bless $self, $class;
|
|
$self->initialize();
|
|
return $self;
|
|
}
|
|
|
|
sub begin_pod {
|
|
my $self = shift;
|
|
$self->SUPER::begin_pod(); ## Have to call superclass
|
|
my $msg = $self->{USAGE_OPTIONS}->{-message} or return 1;
|
|
my $out_fh = $self->output_handle();
|
|
print $out_fh "$msg\n";
|
|
}
|
|
|
|
sub preprocess_paragraph {
|
|
my $self = shift;
|
|
local $_ = shift;
|
|
my $line = shift;
|
|
## See if this is a heading and we arent printing the entire manpage.
|
|
if (($self->{USAGE_OPTIONS}->{-verbose} < 2) && /^=head/) {
|
|
## Change the title of the SYNOPSIS section to USAGE
|
|
s/^=head1\s+SYNOPSIS\s*$/=head1 USAGE/;
|
|
## Try to do some lowercasing instead of all-caps in headings
|
|
s{([A-Z])([A-Z]+)}{((length($2) > 2) ? $1 : lc($1)) . lc($2)}ge;
|
|
## Use a colon to end all headings
|
|
s/\s*$/:/ unless (/:\s*$/);
|
|
$_ .= "\n";
|
|
}
|
|
return $self->SUPER::preprocess_paragraph($_);
|
|
}
|
|
|