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.30;  ## 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.

The special verbosity level 99 requires to also specify the -section
parameter; then these sections are extracted and printed.

=item C<-section>

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

Please report bugs using L<http://rt.cpan.org>.

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"} = (lc($opts{"-exitval"}) eq "noexit" ||
                             $opts{"-exitval"} < 2);
    }

    ## Default the output file
    $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"});

    ## 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" );
    }
    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 
             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');
}

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

##-------------------------------
## Method definitions begin here
##-------------------------------

sub new {
    my $this = shift;
    my $class = ref($this) || $this;
    my %params = @_;
    my $self = {%params};
    bless $self, $class;
    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;
    }
}

# 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];
        $$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.
        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
    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
Revision:	1.1
Committed:	Thu Jun 30 14:27:15 2005 UTC (21 years, 4 months ago) by root
Branch:	MAIN
CVS Tags:	PERL-5-8-7, HEAD
Branch point for:	PERL
Log Message:	* empty log message *
#	Content
1	#############################################################################
2	# Pod/Usage.pm -- print usage messages for the running script.
3	#
4	# Copyright (C) 1996-2000 by Bradford Appleton. All rights reserved.
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);
13	$VERSION = 1.30; ## Current version of this package
14	require 5.005; ## requires this Perl version or later
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
49	=over 4
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
71	=over 4
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.
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.
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	The special verbosity level 99 requires to also specify the -section
97	parameter; then these sections are extracted and printed.
98
99	=item C<-section>
100
101	A string representing a selection list for sections to be printed
102	when -verbose is set to 99, e.g. C<"NAME\|SYNOPSIS\|DESCRIPTION\|VERSION">.
103
104	=item C<-output>
105
106	A reference to a filehandle, or the pathname of a file to which the
107	usage message should be written. The default is C<\*STDERR> unless the
108	exit value is less than 2 (in which case the default is C<\*STDOUT>).
109
110	=item C<-input>
111
112	A reference to a filehandle, or the pathname of a file from which the
113	invoking script's pod documentation should be read. It defaults to the
114	file indicated by C<$0> (C<$PROGRAM_NAME> for users of F<English.pm>).
115
116	=item C<-pathlist>
117
118	A list of directory paths. If the input file does not exist, then it
119	will be searched for in the given directory list (in the order the
120	directories appear in the list). It defaults to the list of directories
121	implied by C<$ENV{PATH}>. The list may be specified either by a reference
122	to an array, or by a string of directory paths which use the same path
123	separator as C<$ENV{PATH}> on your system (e.g., C<:> for Unix, C<;> for
124	MSWin32 and DOS).
125
126	=back
127
128	=head1 DESCRIPTION
129
130	B<pod2usage> will print a usage message for the invoking script (using
131	its embedded pod documentation) and then exit the script with the
132	desired exit status. The usage message printed may have any one of three
133	levels of "verboseness": If the verbose level is 0, then only a synopsis
134	is printed. If the verbose level is 1, then the synopsis is printed
135	along with a description (if present) of the command line options and
136	arguments. If the verbose level is 2, then the entire manual page is
137	printed.
138
139	Unless they are explicitly specified, the default values for the exit
140	status, verbose level, and output stream to use are determined as
141	follows:
142
143	=over 4
144
145	=item *
146
147	If neither the exit status nor the verbose level is specified, then the
148	default is to use an exit status of 2 with a verbose level of 0.
149
150	=item *
151
152	If an exit status I<is> specified but the verbose level is I<not>, then the
153	verbose level will default to 1 if the exit status is less than 2 and
154	will default to 0 otherwise.
155
156	=item *
157
158	If an exit status is I<not> specified but verbose level I<is> given, then
159	the exit status will default to 2 if the verbose level is 0 and will
160	default to 1 otherwise.
161
162	=item *
163
164	If the exit status used is less than 2, then output is printed on
165	C<STDOUT>. Otherwise output is printed on C<STDERR>.
166
167	=back
168
169	Although the above may seem a bit confusing at first, it generally does
170	"the right thing" in most situations. This determination of the default
171	values to use is based upon the following typical Unix conventions:
172
173	=over 4
174
175	=item *
176
177	An exit status of 0 implies "success". For example, B<diff(1)> exits
178	with a status of 0 if the two files have the same contents.
179
180	=item *
181
182	An exit status of 1 implies possibly abnormal, but non-defective, program
183	termination. For example, B<grep(1)> exits with a status of 1 if
184	it did I<not> find a matching line for the given regular expression.
185
186	=item *
187
188	An exit status of 2 or more implies a fatal error. For example, B<ls(1)>
189	exits with a status of 2 if you specify an illegal (unknown) option on
190	the command line.
191
192	=item *
193
194	Usage messages issued as a result of bad command-line syntax should go
195	to C<STDERR>. However, usage messages issued due to an explicit request
196	to print usage (like specifying B<-help> on the command line) should go
197	to C<STDOUT>, just in case the user wants to pipe the output to a pager
198	(such as B<more(1)>).
199
200	=item *
201
202	If program usage has been explicitly requested by the user, it is often
203	desireable to exit with a status of 1 (as opposed to 0) after issuing
204	the user-requested usage message. It is also desireable to give a
205	more verbose description of program usage in this case.
206
207	=back
208
209	B<pod2usage> doesn't force the above conventions upon you, but it will
210	use them by default if you don't expressly tell it to do otherwise. The
211	ability of B<pod2usage()> to accept a single number or a string makes it
212	convenient to use as an innocent looking error message handling function:
213
214	use Pod::Usage;
215	use Getopt::Long;
216
217	## Parse options
218	GetOptions("help", "man", "flag1") \|\| pod2usage(2);
219	pod2usage(1) if ($opt_help);
220	pod2usage(-verbose => 2) if ($opt_man);
221
222	## Check for too many filenames
223	pod2usage("$0: Too many files given.\n") if (@ARGV > 1);
224
225	Some user's however may feel that the above "economy of expression" is
226	not particularly readable nor consistent and may instead choose to do
227	something more like the following:
228
229	use Pod::Usage;
230	use Getopt::Long;
231
232	## Parse options
233	GetOptions("help", "man", "flag1") \|\| pod2usage(-verbose => 0);
234	pod2usage(-verbose => 1) if ($opt_help);
235	pod2usage(-verbose => 2) if ($opt_man);
236
237	## Check for too many filenames
238	pod2usage(-verbose => 2, -message => "$0: Too many files given.\n")
239	if (@ARGV > 1);
240
241	As with all things in Perl, I<there's more than one way to do it>, and
242	B<pod2usage()> adheres to this philosophy. If you are interested in
243	seeing a number of different ways to invoke B<pod2usage> (although by no
244	means exhaustive), please refer to L<"EXAMPLES">.
245
246	=head1 EXAMPLES
247
248	Each of the following invocations of C<pod2usage()> will print just the
249	"SYNOPSIS" section to C<STDERR> and will exit with a status of 2:
250
251	pod2usage();
252
253	pod2usage(2);
254
255	pod2usage(-verbose => 0);
256
257	pod2usage(-exitval => 2);
258
259	pod2usage({-exitval => 2, -output => \*STDERR});
260
261	pod2usage({-verbose => 0, -output => \*STDERR});
262
263	pod2usage(-exitval => 2, -verbose => 0);
264
265	pod2usage(-exitval => 2, -verbose => 0, -output => \*STDERR);
266
267	Each of the following invocations of C<pod2usage()> will print a message
268	of "Syntax error." (followed by a newline) to C<STDERR>, immediately
269	followed by just the "SYNOPSIS" section (also printed to C<STDERR>) and
270	will exit with a status of 2:
271
272	pod2usage("Syntax error.");
273
274	pod2usage(-message => "Syntax error.", -verbose => 0);
275
276	pod2usage(-msg => "Syntax error.", -exitval => 2);
277
278	pod2usage({-msg => "Syntax error.", -exitval => 2, -output => \*STDERR});
279
280	pod2usage({-msg => "Syntax error.", -verbose => 0, -output => \*STDERR});
281
282	pod2usage(-msg => "Syntax error.", -exitval => 2, -verbose => 0);
283
284	pod2usage(-message => "Syntax error.",
285	-exitval => 2,
286	-verbose => 0,
287	-output => \*STDERR);
288
289	Each of the following invocations of C<pod2usage()> will print the
290	"SYNOPSIS" section and any "OPTIONS" and/or "ARGUMENTS" sections to
291	C<STDOUT> and will exit with a status of 1:
292
293	pod2usage(1);
294
295	pod2usage(-verbose => 1);
296
297	pod2usage(-exitval => 1);
298
299	pod2usage({-exitval => 1, -output => \*STDOUT});
300
301	pod2usage({-verbose => 1, -output => \*STDOUT});
302
303	pod2usage(-exitval => 1, -verbose => 1);
304
305	pod2usage(-exitval => 1, -verbose => 1, -output => \*STDOUT});
306
307	Each of the following invocations of C<pod2usage()> will print the
308	entire manual page to C<STDOUT> and will exit with a status of 1:
309
310	pod2usage(-verbose => 2);
311
312	pod2usage({-verbose => 2, -output => \*STDOUT});
313
314	pod2usage(-exitval => 1, -verbose => 2);
315
316	pod2usage({-exitval => 1, -verbose => 2, -output => \*STDOUT});
317
318	=head2 Recommended Use
319
320	Most scripts should print some type of usage message to C<STDERR> when a
321	command line syntax error is detected. They should also provide an
322	option (usually C<-H> or C<-help>) to print a (possibly more verbose)
323	usage message to C<STDOUT>. Some scripts may even wish to go so far as to
324	provide a means of printing their complete documentation to C<STDOUT>
325	(perhaps by allowing a C<-man> option). The following complete example
326	uses B<Pod::Usage> in combination with B<Getopt::Long> to do all of these
327	things:
328
329	use Getopt::Long;
330	use Pod::Usage;
331
332	my $man = 0;
333	my $help = 0;
334	## Parse options and print usage if there is a syntax error,
335	## or if usage was explicitly requested.
336	GetOptions('help\|?' => \$help, man => \$man) or pod2usage(2);
337	pod2usage(1) if $help;
338	pod2usage(-verbose => 2) if $man;
339
340	## If no arguments were given, then allow STDIN to be used only
341	## if it's not connected to a terminal (otherwise print usage)
342	pod2usage("$0: No files given.") if ((@ARGV == 0) && (-t STDIN));
343	__END__
344
345	=head1 NAME
346
347	sample - Using GetOpt::Long and Pod::Usage
348
349	=head1 SYNOPSIS
350
351	sample [options] [file ...]
352
353	Options:
354	-help brief help message
355	-man full documentation
356
357	=head1 OPTIONS
358
359	=over 8
360
361	=item B<-help>
362
363	Print a brief help message and exits.
364
365	=item B<-man>
366
367	Prints the manual page and exits.
368
369	=back
370
371	=head1 DESCRIPTION
372
373	B<This program> will read the given input file(s) and do something
374	useful with the contents thereof.
375
376	=cut
377
378	=head1 CAVEATS
379
380	By default, B<pod2usage()> will use C<$0> as the path to the pod input
381	file. Unfortunately, not all systems on which Perl runs will set C<$0>
382	properly (although if C<$0> isn't found, B<pod2usage()> will search
383	C<$ENV{PATH}> or else the list specified by the C<-pathlist> option).
384	If this is the case for your system, you may need to explicitly specify
385	the path to the pod docs for the invoking script using something
386	similar to the following:
387
388	pod2usage(-exitval => 2, -input => "/path/to/your/pod/docs");
389
390	=head1 AUTHOR
391
392	Please report bugs using L<http://rt.cpan.org>.
393
394	Brad Appleton E<lt>bradapp@enteract.comE<gt>
395
396	Based on code for B<Pod::Text::pod2text()> written by
397	Tom Christiansen E<lt>tchrist@mox.perl.comE<gt>
398
399	=head1 ACKNOWLEDGEMENTS
400
401	Steven McDougall E<lt>swmcd@world.std.comE<gt> for his help and patience
402	with re-writing this manpage.
403
404	=cut
405
406	#############################################################################
407
408	use strict;
409	#use diagnostics;
410	use Carp;
411	use Config;
412	use Exporter;
413	use File::Spec;
414
415	use vars qw(@ISA @EXPORT);
416	@EXPORT = qw(&pod2usage);
417	BEGIN {
418	if ( $] >= 5.005_58 ) {
419	require Pod::Text;
420	@ISA = qw( Pod::Text );
421	}
422	else {
423	require Pod::PlainText;
424	@ISA = qw( Pod::PlainText );
425	}
426	}
427
428
429	##---------------------------------------------------------------------------
430
431	##---------------------------------
432	## Function definitions begin here
433	##---------------------------------
434
435	sub pod2usage {
436	local($_) = shift \|\| "";
437	my %opts;
438	## Collect arguments
439	if (@_ > 0) {
440	## Too many arguments - assume that this is a hash and
441	## the user forgot to pass a reference to it.
442	%opts = ($_, @_);
443	}
444	elsif (ref $_) {
445	## User passed a ref to a hash
446	%opts = %{$_} if (ref($_) eq 'HASH');
447	}
448	elsif (/^[-+]?\d+$/) {
449	## User passed in the exit value to use
450	$opts{"-exitval"} = $_;
451	}
452	else {
453	## User passed in a message to print before issuing usage.
454	$_ and $opts{"-message"} = $_;
455	}
456
457	## Need this for backward compatibility since we formerly used
458	## options that were all uppercase words rather than ones that
459	## looked like Unix command-line options.
460	## to be uppercase keywords)
461	%opts = map {
462	my $val = $opts{$_};
463	s/^(?=\w)/-/;
464	/^-msg/i and $_ = '-message';
465	/^-exit/i and $_ = '-exitval';
466	lc($_) => $val;
467	} (keys %opts);
468
469	## Now determine default -exitval and -verbose values to use
470	if ((! defined $opts{"-exitval"}) && (! defined $opts{"-verbose"})) {
471	$opts{"-exitval"} = 2;
472	$opts{"-verbose"} = 0;
473	}
474	elsif (! defined $opts{"-exitval"}) {
475	$opts{"-exitval"} = ($opts{"-verbose"} > 0) ? 1 : 2;
476	}
477	elsif (! defined $opts{"-verbose"}) {
478	$opts{"-verbose"} = (lc($opts{"-exitval"}) eq "noexit" \|\|
479	$opts{"-exitval"} < 2);
480	}
481
482	## Default the output file
483	$opts{"-output"} = (lc($opts{"-exitval"}) eq "noexit" \|\|
484	$opts{"-exitval"} < 2) ? \STDOUT : \STDERR
485	unless (defined $opts{"-output"});
486	## Default the input file
487	$opts{"-input"} = $0 unless (defined $opts{"-input"});
488
489	## Look up input file in path if it doesnt exist.
490	unless ((ref $opts{"-input"}) \|\| (-e $opts{"-input"})) {
491	my ($dirname, $basename) = ('', $opts{"-input"});
492	my $pathsep = ($^O =~ /^(?:dos\|os2\|MSWin32)$/) ? ";"
493	: (($^O eq 'MacOS' \|\| $^O eq 'VMS') ? ',' : ":");
494	my $pathspec = $opts{"-pathlist"} \|\| $ENV{PATH} \|\| $ENV{PERL5LIB};
495
496	my @paths = (ref $pathspec) ? @$pathspec : split($pathsep, $pathspec);
497	for $dirname (@paths) {
498	$_ = File::Spec->catfile($dirname, $basename) if length;
499	last if (-e $_) && ($opts{"-input"} = $_);
500	}
501	}
502
503	## Now create a pod reader and constrain it to the desired sections.
504	my $parser = new Pod::Usage(USAGE_OPTIONS => \%opts);
505	if ($opts{"-verbose"} == 0) {
506	$parser->select("SYNOPSIS");
507	}
508	elsif ($opts{"-verbose"} == 1) {
509	my $opt_re = '(?i)' .
510	'(?:OPTIONS\|ARGUMENTS)' .
511	'(?:\s(?:AND\|\/)\s(?:OPTIONS\|ARGUMENTS))?';
512	$parser->select( 'SYNOPSIS', $opt_re, "DESCRIPTION/$opt_re" );
513	}
514	elsif ($opts{"-verbose"} == 99) {
515	$parser->select( $opts{"-sections"} );
516	$opts{"-verbose"} = 1;
517	}
518
519	## Now translate the pod document and then exit with the desired status
520	if ( $opts{"-verbose"} >= 2
521	and !ref($opts{"-input"})
522	and $opts{"-output"} == \*STDOUT )
523	{
524	## spit out the entire PODs. Might as well invoke perldoc
525	my $progpath = File::Spec->catfile($Config{scriptdir}, "perldoc");
526	system($progpath, $opts{"-input"});
527	}
528	else {
529	$parser->parse_from_file($opts{"-input"}, $opts{"-output"});
530	}
531
532	exit($opts{"-exitval"}) unless (lc($opts{"-exitval"}) eq 'noexit');
533	}
534
535	##---------------------------------------------------------------------------
536
537	##-------------------------------
538	## Method definitions begin here
539	##-------------------------------
540
541	sub new {
542	my $this = shift;
543	my $class = ref($this) \|\| $this;
544	my %params = @_;
545	my $self = {%params};
546	bless $self, $class;
547	if ($self->can('initialize')) {
548	$self->initialize();
549	} else {
550	$self = $self->SUPER::new();
551	%$self = (%$self, %params);
552	}
553	return $self;
554	}
555
556	sub select {
557	my ($self, @res) = @_;
558	if ($ISA[0]->can('select')) {
559	$self->SUPER::select(@_);
560	} else {
561	$self->{USAGE_SELECT} = \@res;
562	}
563	}
564
565	# This overrides the Pod::Text method to do something very akin to what
566	# Pod::Select did as well as the work done below by preprocess_paragraph.
567	# Note that the below is very, very specific to Pod::Text.
568	sub _handle_element_end {
569	my ($self, $element) = @_;
570	if ($element eq 'head1') {
571	$$self{USAGE_HEAD1} = $$self{PENDING}[-1][1];
572	$$self{PENDING}[-1][1] =~ s/^\sSYNOPSIS\s$/USAGE/;
573	} elsif ($element eq 'head2') {
574	$$self{USAGE_HEAD2} = $$self{PENDING}[-1][1];
575	}
576	if ($element eq 'head1' \|\| $element eq 'head2') {
577	$$self{USAGE_SKIPPING} = 1;
578	my $heading = $$self{USAGE_HEAD1};
579	$heading .= '/' . $$self{USAGE_HEAD2} if defined $$self{USAGE_HEAD2};
580	for (@{ $$self{USAGE_SELECT} }) {
581	if ($heading =~ /^$_\s*$/) {
582	$$self{USAGE_SKIPPING} = 0;
583	last;
584	}
585	}
586
587	# Try to do some lowercasing instead of all-caps in headings, and use
588	# a colon to end all headings.
589	local $_ = $$self{PENDING}[-1][1];
590	s{([A-Z])([A-Z]+)}{((length($2) > 2) ? $1 : lc($1)) . lc($2)}ge;
591	s/\s$/:/ unless (/:\s$/);
592	$_ .= "\n";
593	$$self{PENDING}[-1][1] = $_;
594	}
595	if ($$self{USAGE_SKIPPING}) {
596	pop @{ $$self{PENDING} };
597	} else {
598	$self->SUPER::_handle_element_end($element);
599	}
600	}
601
602	sub start_document {
603	my $self = shift;
604	$self->SUPER::start_document();
605	my $msg = $self->{USAGE_OPTIONS}->{-message} or return 1;
606	my $out_fh = $self->output_fh();
607	print $out_fh "$msg\n";
608	}
609
610	sub begin_pod {
611	my $self = shift;
612	$self->SUPER::begin_pod(); ## Have to call superclass
613	my $msg = $self->{USAGE_OPTIONS}->{-message} or return 1;
614	my $out_fh = $self->output_handle();
615	print $out_fh "$msg\n";
616	}
617
618	sub preprocess_paragraph {
619	my $self = shift;
620	local $_ = shift;
621	my $line = shift;
622	## See if this is a heading and we arent printing the entire manpage.
623	if (($self->{USAGE_OPTIONS}->{-verbose} < 2) && /^=head/) {
624	## Change the title of the SYNOPSIS section to USAGE
625	s/^=head1\s+SYNOPSIS\s*$/=head1 USAGE/;
626	## Try to do some lowercasing instead of all-caps in headings
627	s{([A-Z])([A-Z]+)}{((length($2) > 2) ? $1 : lc($1)) . lc($2)}ge;
628	## Use a colon to end all headings
629	s/\s$/:/ unless (/:\s$/);
630	$_ .= "\n";
631	}
632	return $self->SUPER::preprocess_paragraph($_);
633	}
634
635	1; # keep require happy