[p5sagit/p5-mst-13.2.git] / lib / Pod / Usage.pm

#############################################################################
# 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.14;  ## 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 4

=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 4

=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.
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>

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 4

=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 4

=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 Config;
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' || $^O eq 'VMS') ? ',' :  ":");
        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
    if ( $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{bin}, "perldoc");
       system($progpath, $opts{"-input"});
    }
    else {
       $parser->parse_from_file($opts{"-input"}, $opts{"-output"});
    }

    exit($opts{"-exitval"})  unless (lc($opts{"-exitval"}) eq 'noexit');
}

##---------------------------------------------------------------------------

##-------------------------------
## 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($_);
}

1; # keep require happy
Commit	Line	Data
360aca43	1	#############################################################################
	2	# Pod/Usage.pm -- print usage messages for the running script.
	3	#
66aff6dd	4	# Copyright (C) 1996-2000 by Bradford Appleton. All rights reserved.
360aca43	5	# This file is part of "PodParser". PodParser is free software;
	6	# you can redistribute it and/or modify it under the same terms
	7	# as Perl itself.
	8	#############################################################################
	9
	10	package Pod::Usage;
	11
	12	use vars qw($VERSION);
39a52d2c	13	$VERSION = 1.14; ## Current version of this package
828c4421	14	require 5.005; ## requires this Perl version or later
360aca43	15
	16	=head1 NAME
	17
	18	Pod::Usage, pod2usage() - print a usage message from embedded pod documentation
	19
	20	=head1 SYNOPSIS
	21
	22	use Pod::Usage
	23
	24	my $message_text = "This text precedes the usage message.";
	25	my $exit_status = 2; ## The exit status to use
	26	my $verbose_level = 0; ## The verbose level to use
	27	my $filehandle = \*STDERR; ## The filehandle to write to
	28
	29	pod2usage($message_text);
	30
	31	pod2usage($exit_status);
	32
	33	pod2usage( { -message => $message_text ,
	34	-exitval => $exit_status ,
	35	-verbose => $verbose_level,
	36	-output => $filehandle } );
	37
	38	pod2usage( -msg => $message_text ,
	39	-exitval => $exit_status ,
	40	-verbose => $verbose_level,
	41	-output => $filehandle );
	42
	43	=head1 ARGUMENTS
	44
	45	B<pod2usage> should be given either a single argument, or a list of
	46	arguments corresponding to an associative array (a "hash"). When a single
	47	argument is given, it should correspond to exactly one of the following:
	48
92e3d63a	49	=over 4
360aca43	50
	51	=item *
	52
	53	A string containing the text of a message to print I<before> printing
	54	the usage message
	55
	56	=item *
	57
	58	A numeric value corresponding to the desired exit status
	59
	60	=item *
	61
	62	A reference to a hash
	63
	64	=back
	65
	66	If more than one argument is given then the entire argument list is
	67	assumed to be a hash. If a hash is supplied (either as a reference or
	68	as a list) it should contain one or more elements with the following
	69	keys:
	70
92e3d63a	71	=over 4
360aca43	72
	73	=item C<-message>
	74
	75	=item C<-msg>
	76
	77	The text of a message to print immediately prior to printing the
	78	program's usage message.
	79
	80	=item C<-exitval>
	81
	82	The desired exit status to pass to the B<exit()> function.
39a52d2c	83	This should be an integer, or else the string "NOEXIT" to
	84	indicate that control should simply be returned without
	85	terminating the invoking process.
360aca43	86
	87	=item C<-verbose>
	88
	89	The desired level of "verboseness" to use when printing the usage
	90	message. If the corresponding value is 0, then only the "SYNOPSIS"
	91	section of the pod documentation is printed. If the corresponding value
	92	is 1, then the "SYNOPSIS" section, along with any section entitled
	93	"OPTIONS", "ARGUMENTS", or "OPTIONS AND ARGUMENTS" is printed. If the
	94	corresponding value is 2 or more then the entire manpage is printed.
	95
	96	=item C<-output>
	97
	98	A reference to a filehandle, or the pathname of a file to which the
	99	usage message should be written. The default is C<\*STDERR> unless the
	100	exit value is less than 2 (in which case the default is C<\*STDOUT>).
	101
	102	=item C<-input>
	103
	104	A reference to a filehandle, or the pathname of a file from which the
	105	invoking script's pod documentation should be read. It defaults to the
	106	file indicated by C<$0> (C<$PROGRAM_NAME> for users of F<English.pm>).
	107
	108	=item C<-pathlist>
	109
	110	A list of directory paths. If the input file does not exist, then it
	111	will be searched for in the given directory list (in the order the
	112	directories appear in the list). It defaults to the list of directories
	113	implied by C<$ENV{PATH}>. The list may be specified either by a reference
	114	to an array, or by a string of directory paths which use the same path
	115	separator as C<$ENV{PATH}> on your system (e.g., C<:> for Unix, C<;> for
	116	MSWin32 and DOS).
	117
	118	=back
	119
	120	=head1 DESCRIPTION
	121
	122	B<pod2usage> will print a usage message for the invoking script (using
	123	its embedded pod documentation) and then exit the script with the
	124	desired exit status. The usage message printed may have any one of three
	125	levels of "verboseness": If the verbose level is 0, then only a synopsis
	126	is printed. If the verbose level is 1, then the synopsis is printed
	127	along with a description (if present) of the command line options and
	128	arguments. If the verbose level is 2, then the entire manual page is
	129	printed.
	130
	131	Unless they are explicitly specified, the default values for the exit
	132	status, verbose level, and output stream to use are determined as
	133	follows:
	134
92e3d63a	135	=over 4
360aca43	136
	137	=item *
	138
	139	If neither the exit status nor the verbose level is specified, then the
	140	default is to use an exit status of 2 with a verbose level of 0.
	141
	142	=item *
	143
	144	If an exit status I<is> specified but the verbose level is I<not>, then the
	145	verbose level will default to 1 if the exit status is less than 2 and
	146	will default to 0 otherwise.
	147
	148	=item *
	149
	150	If an exit status is I<not> specified but verbose level I<is> given, then
	151	the exit status will default to 2 if the verbose level is 0 and will
	152	default to 1 otherwise.
	153
	154	=item *
	155
	156	If the exit status used is less than 2, then output is printed on
	157	C<STDOUT>. Otherwise output is printed on C<STDERR>.
	158
	159	=back
	160
	161	Although the above may seem a bit confusing at first, it generally does
	162	"the right thing" in most situations. This determination of the default
	163	values to use is based upon the following typical Unix conventions:
	164
92e3d63a	165	=over 4
360aca43	166
	167	=item *
	168
	169	An exit status of 0 implies "success". For example, B<diff(1)> exits
	170	with a status of 0 if the two files have the same contents.
	171
	172	=item *
	173
	174	An exit status of 1 implies possibly abnormal, but non-defective, program
	175	termination. For example, B<grep(1)> exits with a status of 1 if
	176	it did I<not> find a matching line for the given regular expression.
	177
	178	=item *
	179
	180	An exit status of 2 or more implies a fatal error. For example, B<ls(1)>
	181	exits with a status of 2 if you specify an illegal (unknown) option on
	182	the command line.
	183
	184	=item *
	185
	186	Usage messages issued as a result of bad command-line syntax should go
	187	to C<STDERR>. However, usage messages issued due to an explicit request
	188	to print usage (like specifying B<-help> on the command line) should go
	189	to C<STDOUT>, just in case the user wants to pipe the output to a pager
	190	(such as B<more(1)>).
	191
	192	=item *
	193
	194	If program usage has been explicitly requested by the user, it is often
	195	desireable to exit with a status of 1 (as opposed to 0) after issuing
	196	the user-requested usage message. It is also desireable to give a
	197	more verbose description of program usage in this case.
	198
	199	=back
	200
	201	B<pod2usage> doesn't force the above conventions upon you, but it will
	202	use them by default if you don't expressly tell it to do otherwise. The
	203	ability of B<pod2usage()> to accept a single number or a string makes it
	204	convenient to use as an innocent looking error message handling function:
	205
	206	use Pod::Usage;
	207	use Getopt::Long;
	208
	209	## Parse options
	210	GetOptions("help", "man", "flag1") \|\| pod2usage(2);
	211	pod2usage(1) if ($opt_help);
	212	pod2usage(-verbose => 2) if ($opt_man);
	213
	214	## Check for too many filenames
	215	pod2usage("$0: Too many files given.\n") if (@ARGV > 1);
	216
92e3d63a	217	Some user's however may feel that the above "economy of expression" is
360aca43	218	not particularly readable nor consistent and may instead choose to do
	219	something more like the following:
	220
	221	use Pod::Usage;
	222	use Getopt::Long;
	223
	224	## Parse options
	225	GetOptions("help", "man", "flag1") \|\| pod2usage(-verbose => 0);
	226	pod2usage(-verbose => 1) if ($opt_help);
	227	pod2usage(-verbose => 2) if ($opt_man);
	228
	229	## Check for too many filenames
	230	pod2usage(-verbose => 2, -message => "$0: Too many files given.\n")
	231	if (@ARGV > 1);
	232
	233	As with all things in Perl, I<there's more than one way to do it>, and
	234	B<pod2usage()> adheres to this philosophy. If you are interested in
	235	seeing a number of different ways to invoke B<pod2usage> (although by no
	236	means exhaustive), please refer to L<"EXAMPLES">.
	237
	238	=head1 EXAMPLES
	239
	240	Each of the following invocations of C<pod2usage()> will print just the
	241	"SYNOPSIS" section to C<STDERR> and will exit with a status of 2:
	242
	243	pod2usage();
	244
	245	pod2usage(2);
	246
	247	pod2usage(-verbose => 0);
	248
	249	pod2usage(-exitval => 2);
	250
	251	pod2usage({-exitval => 2, -output => \*STDERR});
	252
	253	pod2usage({-verbose => 0, -output => \*STDERR});
	254
	255	pod2usage(-exitval => 2, -verbose => 0);
	256
	257	pod2usage(-exitval => 2, -verbose => 0, -output => \*STDERR);
	258
	259	Each of the following invocations of C<pod2usage()> will print a message
	260	of "Syntax error." (followed by a newline) to C<STDERR>, immediately
	261	followed by just the "SYNOPSIS" section (also printed to C<STDERR>) and
	262	will exit with a status of 2:
	263
	264	pod2usage("Syntax error.");
	265
	266	pod2usage(-message => "Syntax error.", -verbose => 0);
	267
	268	pod2usage(-msg => "Syntax error.", -exitval => 2);
	269
	270	pod2usage({-msg => "Syntax error.", -exitval => 2, -output => \*STDERR});
	271
	272	pod2usage({-msg => "Syntax error.", -verbose => 0, -output => \*STDERR});
	273
	274	pod2usage(-msg => "Syntax error.", -exitval => 2, -verbose => 0);
	275
	276	pod2usage(-message => "Syntax error.",
	277	-exitval => 2,
	278	-verbose => 0,
	279	-output => \*STDERR);
	280
	281	Each of the following invocations of C<pod2usage()> will print the
282	"SYNOPSIS" section and any "OPTIONS" and/or "ARGUMENTS" sections to
283	C<STDOUT> and will exit with a status of 1:
284
285	pod2usage(1);
286
287	pod2usage(-verbose => 1);
288
289	pod2usage(-exitval => 1);
290
291	pod2usage({-exitval => 1, -output => \*STDOUT});
292
293	pod2usage({-verbose => 1, -output => \*STDOUT});
294
295	pod2usage(-exitval => 1, -verbose => 1);
296
297	pod2usage(-exitval => 1, -verbose => 1, -output => \*STDOUT});
298
299	Each of the following invocations of C<pod2usage()> will print the
300	entire manual page to C<STDOUT> and will exit with a status of 1:
301
302	pod2usage(-verbose => 2);
303
304	pod2usage({-verbose => 2, -output => \*STDOUT});
305
306	pod2usage(-exitval => 1, -verbose => 2);
307
308	pod2usage({-exitval => 1, -verbose => 2, -output => \*STDOUT});
309
310	=head2 Recommended Use
311
312	Most scripts should print some type of usage message to C<STDERR> when a
313	command line syntax error is detected. They should also provide an
314	option (usually C<-H> or C<-help>) to print a (possibly more verbose)
315	usage message to C<STDOUT>. Some scripts may even wish to go so far as to
316	provide a means of printing their complete documentation to C<STDOUT>
f48e6a7e	317	(perhaps by allowing a C<-man> option). The following complete example
f48e6a7e	318	uses B<Pod::Usage> in combination with B<Getopt::Long> to do all of these
360aca43	319	things:
	320
	321	use Getopt::Long;
	322	use Pod::Usage;
	323
f48e6a7e	324	my $man = 0;
f48e6a7e	325	my $help = 0;
360aca43	326	## Parse options and print usage if there is a syntax error,
360aca43	327	## or if usage was explicitly requested.
f48e6a7e	328	GetOptions('help\|?' => \$help, man => \$man) or pod2usage(2);
	329	pod2usage(1) if $help;
	330	pod2usage(-verbose => 2) if $man;
360aca43	331
	332	## If no arguments were given, then allow STDIN to be used only
	333	## if it's not connected to a terminal (otherwise print usage)
	334	pod2usage("$0: No files given.") if ((@ARGV == 0) && (-t STDIN));
f48e6a7e	335	__END__
	336
	337	=head1 NAME
	338
	339	sample - Using GetOpt::Long and Pod::Usage
	340
	341	=head1 SYNOPSIS
	342
	343	sample [options] [file ...]
	344
	345	Options:
	346	-help brief help message
	347	-man full documentation
	348
	349	=head1 OPTIONS
	350
	351	=over 8
	352
	353	=item B<-help>
	354
	355	Print a brief help message and exits.
	356
	357	=item B<-man>
	358
	359	Prints the manual page and exits.
	360
	361	=back
	362
	363	=head1 DESCRIPTION
	364
	365	B<This program> will read the given input file(s) and do something
	366	useful with the contents thereof.
	367
	368	=cut
360aca43	369
	370	=head1 CAVEATS
	371
	372	By default, B<pod2usage()> will use C<$0> as the path to the pod input
	373	file. Unfortunately, not all systems on which Perl runs will set C<$0>
	374	properly (although if C<$0> isn't found, B<pod2usage()> will search
	375	C<$ENV{PATH}> or else the list specified by the C<-pathlist> option).
	376	If this is the case for your system, you may need to explicitly specify
	377	the path to the pod docs for the invoking script using something
	378	similar to the following:
	379
	380	pod2usage(-exitval => 2, -input => "/path/to/your/pod/docs");
	381
	382	=head1 AUTHOR
	383
	384	Brad Appleton E<lt>bradapp@enteract.comE<gt>
	385
	386	Based on code for B<Pod::Text::pod2text()> written by
	387	Tom Christiansen E<lt>tchrist@mox.perl.comE<gt>
	388
	389	=head1 ACKNOWLEDGEMENTS
	390
	391	Steven McDougall E<lt>swmcd@world.std.comE<gt> for his help and patience
	392	with re-writing this manpage.
	393
	394	=cut
	395
	396	#############################################################################
	397
	398	use strict;
	399	#use diagnostics;
	400	use Carp;
39a52d2c	401	use Config;
360aca43	402	use Exporter;
360aca43	403	use File::Spec;
	404
	405	use vars qw(@ISA @EXPORT);
360aca43	406	@EXPORT = qw(&pod2usage);
664bb207	407	BEGIN {
	408	if ( $] >= 5.005_58 ) {
	409	require Pod::Text;
	410	@ISA = qw( Pod::Text );
	411	}
	412	else {
	413	require Pod::PlainText;
	414	@ISA = qw( Pod::PlainText );
	415	}
	416	}
	417
360aca43	418
	419	##---------------------------------------------------------------------------
	420
	421	##---------------------------------
	422	## Function definitions begin here
	423	##---------------------------------
	424
	425	sub pod2usage {
	426	local($_) = shift \|\| "";
	427	my %opts;
	428	## Collect arguments
	429	if (@_ > 0) {
	430	## Too many arguments - assume that this is a hash and
	431	## the user forgot to pass a reference to it.
	432	%opts = ($_, @_);
	433	}
	434	elsif (ref $_) {
	435	## User passed a ref to a hash
	436	%opts = %{$_} if (ref($_) eq 'HASH');
	437	}
e9fdc7d2	438	elsif (/^[-+]?\d+$/) {
360aca43	439	## User passed in the exit value to use
	440	$opts{"-exitval"} = $_;
	441	}
	442	else {
	443	## User passed in a message to print before issuing usage.
	444	$_ and $opts{"-message"} = $_;
	445	}
	446
	447	## Need this for backward compatibility since we formerly used
	448	## options that were all uppercase words rather than ones that
	449	## looked like Unix command-line options.
	450	## to be uppercase keywords)
	451	%opts = map {
	452	my $val = $opts{$_};
	453	s/^(?=\w)/-/;
	454	/^-msg/i and $_ = '-message';
	455	/^-exit/i and $_ = '-exitval';
	456	lc($_) => $val;
	457	} (keys %opts);
	458
	459	## Now determine default -exitval and -verbose values to use
	460	if ((! defined $opts{"-exitval"}) && (! defined $opts{"-verbose"})) {
	461	$opts{"-exitval"} = 2;
	462	$opts{"-verbose"} = 0;
	463	}
	464	elsif (! defined $opts{"-exitval"}) {
	465	$opts{"-exitval"} = ($opts{"-verbose"} > 0) ? 1 : 2;
	466	}
	467	elsif (! defined $opts{"-verbose"}) {
	468	$opts{"-verbose"} = ($opts{"-exitval"} < 2);
	469	}
	470
	471	## Default the output file
	472	$opts{"-output"} = ($opts{"-exitval"} < 2) ? \STDOUT : \STDERR
	473	unless (defined $opts{"-output"});
	474	## Default the input file
	475	$opts{"-input"} = $0 unless (defined $opts{"-input"});
	476
	477	## Look up input file in path if it doesnt exist.
	478	unless ((ref $opts{"-input"}) \|\| (-e $opts{"-input"})) {
	479	my ($dirname, $basename) = ('', $opts{"-input"});
	480	my $pathsep = ($^O =~ /^(?:dos\|os2\|MSWin32)$/) ? ";"
0cb07b6b	481	: (($^O eq 'MacOS' \|\| $^O eq 'VMS') ? ',' : ":");
360aca43	482	my $pathspec = $opts{"-pathlist"} \|\| $ENV{PATH} \|\| $ENV{PERL5LIB};
	483
	484	my @paths = (ref $pathspec) ? @$pathspec : split($pathsep, $pathspec);
	485	for $dirname (@paths) {
	486	$_ = File::Spec->catfile($dirname, $basename) if length;
	487	last if (-e $_) && ($opts{"-input"} = $_);
	488	}
	489	}
	490
	491	## Now create a pod reader and constrain it to the desired sections.
	492	my $parser = new Pod::Usage(USAGE_OPTIONS => \%opts);
	493	if ($opts{"-verbose"} == 0) {
	494	$parser->select("SYNOPSIS");
	495	}
	496	elsif ($opts{"-verbose"} == 1) {
	497	my $opt_re = '(?i)' .
	498	'(?:OPTIONS\|ARGUMENTS)' .
	499	'(?:\s(?:AND\|\/)\s(?:OPTIONS\|ARGUMENTS))?';
	500	$parser->select( 'SYNOPSIS', $opt_re, "DESCRIPTION/$opt_re" );
	501	}
	502
	503	## Now translate the pod document and then exit with the desired status
39a52d2c	504	if ( $opts{"-verbose"} >= 2
	505	and !ref($opts{"-input"})
	506	and $opts{"-output"} == \*STDOUT )
	507	{
	508	## spit out the entire PODs. Might as well invoke perldoc
	509	my $progpath = File::Spec->catfile($Config{bin}, "perldoc");
	510	system($progpath, $opts{"-input"});
	511	}
	512	else {
	513	$parser->parse_from_file($opts{"-input"}, $opts{"-output"});
	514	}
	515
	516	exit($opts{"-exitval"}) unless (lc($opts{"-exitval"}) eq 'noexit');
360aca43	517	}
	518
	519	##---------------------------------------------------------------------------
	520
	521	##-------------------------------
	522	## Method definitions begin here
	523	##-------------------------------
	524
	525	sub new {
	526	my $this = shift;
	527	my $class = ref($this) \|\| $this;
	528	my %params = @_;
	529	my $self = {%params};
	530	bless $self, $class;
	531	$self->initialize();
	532	return $self;
	533	}
	534
	535	sub begin_pod {
	536	my $self = shift;
	537	$self->SUPER::begin_pod(); ## Have to call superclass
	538	my $msg = $self->{USAGE_OPTIONS}->{-message} or return 1;
	539	my $out_fh = $self->output_handle();
	540	print $out_fh "$msg\n";
	541	}
	542
	543	sub preprocess_paragraph {
	544	my $self = shift;
	545	local $_ = shift;
	546	my $line = shift;
	547	## See if this is a heading and we arent printing the entire manpage.
e9fdc7d2	548	if (($self->{USAGE_OPTIONS}->{-verbose} < 2) && /^=head/) {
360aca43	549	## Change the title of the SYNOPSIS section to USAGE
e9fdc7d2	550	s/^=head1\s+SYNOPSIS\s*$/=head1 USAGE/;
360aca43	551	## Try to do some lowercasing instead of all-caps in headings
	552	s{([A-Z])([A-Z]+)}{((length($2) > 2) ? $1 : lc($1)) . lc($2)}ge;
	553	## Use a colon to end all headings
e9fdc7d2	554	s/\s$/:/ unless (/:\s$/);
360aca43	555	$_ .= "\n";
	556	}
	557	return $self->SUPER::preprocess_paragraph($_);
	558	}
	559
8abb48c2	560	1; # keep require happy