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 *
#	User	Rev	Content
1	root	1.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