"Fossies" - the Fresh Open Source Software Archive

Member "install-tl-20200916/tlpkg/tlperl/lib/Pod/Usage.pm" (8 Mar 2018, 29743 Bytes) of package /windows/misc/install-tl.zip:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Perl source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file.

    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 # Copyright (c) 2001-2016 by Marek Rouchal.
    6 # This file is part of "Pod-Usage". Pod-Usage is free software;
    7 # you can redistribute it and/or modify it under the same terms
    8 # as Perl itself.
    9 #############################################################################
   10 
   11 package Pod::Usage;
   12 use strict;
   13 
   14 use vars qw($VERSION @ISA @EXPORT);
   15 $VERSION = '1.69';  ## Current version of this package
   16 require  5.006;    ## requires this Perl version or later
   17 
   18 #use diagnostics;
   19 use Carp;
   20 use Config;
   21 use Exporter;
   22 use File::Spec;
   23 
   24 @EXPORT = qw(&pod2usage);
   25 BEGIN {
   26     $Pod::Usage::Formatter ||= 'Pod::Text';
   27     eval "require $Pod::Usage::Formatter";
   28     die $@ if $@;
   29     @ISA = ( $Pod::Usage::Formatter );
   30 }
   31 
   32 our $MAX_HEADING_LEVEL = 3;
   33 
   34 ##---------------------------------------------------------------------------
   35 
   36 ##---------------------------------
   37 ## Function definitions begin here
   38 ##---------------------------------
   39 
   40 sub pod2usage {
   41     local($_) = shift;
   42     my %opts;
   43     ## Collect arguments
   44     if (@_ > 0) {
   45         ## Too many arguments - assume that this is a hash and
   46         ## the user forgot to pass a reference to it.
   47         %opts = ($_, @_);
   48     }
   49     elsif (!defined $_) {
   50       $_ = '';
   51     }
   52     elsif (ref $_) {
   53         ## User passed a ref to a hash
   54         %opts = %{$_}  if (ref($_) eq 'HASH');
   55     }
   56     elsif (/^[-+]?\d+$/) {
   57         ## User passed in the exit value to use
   58         $opts{'-exitval'} =  $_;
   59     }
   60     else {
   61         ## User passed in a message to print before issuing usage.
   62         $_  and  $opts{'-message'} = $_;
   63     }
   64 
   65     ## Need this for backward compatibility since we formerly used
   66     ## options that were all uppercase words rather than ones that
   67     ## looked like Unix command-line options.
   68     ## to be uppercase keywords)
   69     %opts = map {
   70         my ($key, $val) = ($_, $opts{$_});
   71         $key =~ s/^(?=\w)/-/;
   72         $key =~ /^-msg/i   and  $key = '-message';
   73         $key =~ /^-exit/i  and  $key = '-exitval';
   74         lc($key) => $val;
   75     } (keys %opts);
   76 
   77     ## Now determine default -exitval and -verbose values to use
   78     if ((! defined $opts{'-exitval'}) && (! defined $opts{'-verbose'})) {
   79         $opts{'-exitval'} = 2;
   80         $opts{'-verbose'} = 0;
   81     }
   82     elsif (! defined $opts{'-exitval'}) {
   83         $opts{'-exitval'} = ($opts{'-verbose'} > 0) ? 1 : 2;
   84     }
   85     elsif (! defined $opts{'-verbose'}) {
   86         $opts{'-verbose'} = (lc($opts{'-exitval'}) eq 'noexit' ||
   87                              $opts{'-exitval'} < 2);
   88     }
   89 
   90     ## Default the output file
   91     $opts{'-output'} = (lc($opts{'-exitval'}) eq 'noexit' ||
   92                         $opts{'-exitval'} < 2) ? \*STDOUT : \*STDERR
   93             unless (defined $opts{'-output'});
   94     ## Default the input file
   95     $opts{'-input'} = $0  unless (defined $opts{'-input'});
   96 
   97     ## Look up input file in path if it doesn't exist.
   98     unless ((ref $opts{'-input'}) || (-e $opts{'-input'})) {
   99         my $basename = $opts{'-input'};
  100         my $pathsep = ($^O =~ /^(?:dos|os2|MSWin32)$/i) ? ';'
  101                             : (($^O eq 'MacOS' || $^O eq 'VMS') ? ',' :  ':');
  102         my $pathspec = $opts{'-pathlist'} || $ENV{PATH} || $ENV{PERL5LIB};
  103 
  104         my @paths = (ref $pathspec) ? @$pathspec : split($pathsep, $pathspec);
  105         for my $dirname (@paths) {
  106             $_ = File::Spec->catfile($dirname, $basename)  if length;
  107             last if (-e $_) && ($opts{'-input'} = $_);
  108         }
  109     }
  110 
  111     ## Now create a pod reader and constrain it to the desired sections.
  112     my $parser = new Pod::Usage(USAGE_OPTIONS => \%opts);
  113     if ($opts{'-verbose'} == 0) {
  114         $parser->select('(?:SYNOPSIS|USAGE)\s*');
  115     }
  116     elsif ($opts{'-verbose'} == 1) {
  117         my $opt_re = '(?i)' .
  118                      '(?:OPTIONS|ARGUMENTS)' .
  119                      '(?:\s*(?:AND|\/)\s*(?:OPTIONS|ARGUMENTS))?';
  120         $parser->select( '(?:SYNOPSIS|USAGE)\s*', $opt_re, "DESCRIPTION/$opt_re" );
  121     }
  122     elsif ($opts{'-verbose'} >= 2 && $opts{'-verbose'} != 99) {
  123         $parser->select('.*');
  124     }
  125     elsif ($opts{'-verbose'} == 99) {
  126         my $sections = $opts{'-sections'};
  127         $parser->select( (ref $sections) ? @$sections : $sections );
  128         $opts{'-verbose'} = 1;
  129     }
  130 
  131     ## Check for perldoc
  132     my $progpath = $opts{'-perldoc'} ? $opts{'-perldoc'} :
  133         File::Spec->catfile($Config{scriptdirexp} 
  134     || $Config{scriptdir}, 'perldoc');
  135 
  136     my $version = sprintf("%vd",$^V);
  137     if ($Config{versiononly} and $Config{startperl} =~ /\Q$version\E$/ ) {
  138       $progpath .= $version;
  139     }
  140     $opts{'-noperldoc'} = 1 unless -e $progpath;
  141 
  142     ## Now translate the pod document and then exit with the desired status
  143     if (      !$opts{'-noperldoc'}
  144          and  $opts{'-verbose'} >= 2
  145          and  !ref($opts{'-input'})
  146          and  $opts{'-output'} == \*STDOUT )
  147     {
  148        ## spit out the entire PODs. Might as well invoke perldoc
  149        print { $opts{'-output'} } ($opts{'-message'}, "\n") if($opts{'-message'});
  150        if(defined $opts{-input} && $opts{-input} =~ /^\s*(\S.*?)\s*$/) {
  151          # the perldocs back to 5.005 should all have -F
  152      # without -F there are warnings in -T scripts
  153      my $f = $1;
  154          my @perldoc_cmd = ($progpath);
  155      if ($opts{'-perldocopt'}) {
  156            $opts{'-perldocopt'} =~ s/^\s+|\s+$//g;
  157        push @perldoc_cmd, split(/\s+/, $opts{'-perldocopt'});
  158      }
  159      push @perldoc_cmd, ('-F', $f);
  160          unshift @perldoc_cmd, $opts{'-perlcmd'} if $opts{'-perlcmd'};
  161          system(@perldoc_cmd);
  162          if($?) {
  163            # RT16091: fall back to more if perldoc failed
  164            system(($Config{pager} || $ENV{PAGER} || '/bin/more'), $1);
  165          }
  166        } else {
  167          croak "Unspecified input file or insecure argument.\n";
  168        }
  169     }
  170     else {
  171        $parser->parse_from_file($opts{'-input'}, $opts{'-output'});
  172     }
  173 
  174     exit($opts{'-exitval'})  unless (lc($opts{'-exitval'}) eq 'noexit');
  175 }
  176 
  177 ##---------------------------------------------------------------------------
  178 
  179 ##-------------------------------
  180 ## Method definitions begin here
  181 ##-------------------------------
  182 
  183 sub new {
  184     my $this = shift;
  185     my $class = ref($this) || $this;
  186     my %params = @_;
  187     my $self = {%params};
  188     bless $self, $class;
  189     if ($self->can('initialize')) {
  190         $self->initialize();
  191     } else {
  192         # pass through options to Pod::Text
  193         my %opts;
  194         for (qw(alt code indent loose margin quotes sentence stderr utf8 width)) {
  195             my $val = $params{USAGE_OPTIONS}{"-$_"};
  196             $opts{$_} = $val if defined $val;
  197         }
  198         $self = $self->SUPER::new(%opts);
  199         %$self = (%$self, %params);
  200     }
  201     return $self;
  202 }
  203 
  204 # This subroutine was copied in whole-cloth from Pod::Select 1.60 in order to
  205 # allow the ejection of Pod::Select from the core without breaking Pod::Usage.
  206 # -- rjbs, 2013-03-18
  207 sub _compile_section_spec {
  208     my ($section_spec) = @_;
  209     my (@regexs, $negated);
  210 
  211     ## Compile the spec into a list of regexs
  212     local $_ = $section_spec;
  213     s{\\\\}{\001}g;  ## handle escaped backward slashes
  214     s{\\/}{\002}g;   ## handle escaped forward slashes
  215 
  216     ## Parse the regexs for the heading titles
  217     @regexs = split(/\//, $_, $MAX_HEADING_LEVEL);
  218 
  219     ## Set default regex for ommitted levels
  220     for (my $i = 0; $i < $MAX_HEADING_LEVEL; ++$i) {
  221         $regexs[$i]  = '.*'  unless ((defined $regexs[$i])
  222                                      && (length $regexs[$i]));
  223     }
  224     ## Modify the regexs as needed and validate their syntax
  225     my $bad_regexs = 0;
  226     for (@regexs) {
  227         $_ .= '.+'  if ($_ eq '!');
  228         s{\001}{\\\\}g;       ## restore escaped backward slashes
  229         s{\002}{\\/}g;        ## restore escaped forward slashes
  230         $negated = s/^\!//;   ## check for negation
  231         eval "m{$_}";         ## check regex syntax
  232         if ($@) {
  233             ++$bad_regexs;
  234             carp qq{Bad regular expression /$_/ in "$section_spec": $@\n};
  235         }
  236         else {
  237             ## Add the forward and rear anchors (and put the negator back)
  238             $_ = '^' . $_  unless (/^\^/);
  239             $_ = $_ . '$'  unless (/\$$/);
  240             $_ = '!' . $_  if ($negated);
  241         }
  242     }
  243     return  (! $bad_regexs) ? [ @regexs ] : undef;
  244 }
  245 
  246 sub select {
  247     my ($self, @sections) = @_;
  248     if ($ISA[0]->can('select')) {
  249         $self->SUPER::select(@sections);
  250     } else {
  251         # we're using Pod::Simple - need to mimic the behavior of Pod::Select
  252         my $add = ($sections[0] eq '+') ? shift(@sections) : '';
  253         ## Reset the set of sections to use
  254         unless (@sections) {
  255           delete $self->{USAGE_SELECT} unless ($add);
  256           return;
  257         }
  258         $self->{USAGE_SELECT} = []
  259           unless ($add && $self->{USAGE_SELECT});
  260         my $sref = $self->{USAGE_SELECT};
  261         ## Compile each spec
  262         for my $spec (@sections) {
  263           my $cs = _compile_section_spec($spec);
  264           if ( defined $cs ) {
  265             ## Store them in our sections array
  266             push(@$sref, $cs);
  267           } else {
  268             carp qq{Ignoring section spec "$spec"!\n};
  269           }
  270         }
  271     }
  272 }
  273 
  274 # Override Pod::Text->seq_i to return just "arg", not "*arg*".
  275 sub seq_i { return $_[1] }
  276 # Override Pod::Text->cmd_i to return just "arg", not "*arg*".
  277 # newer version based on Pod::Simple
  278 sub cmd_i { return $_[2] }
  279 
  280 # This overrides the Pod::Text method to do something very akin to what
  281 # Pod::Select did as well as the work done below by preprocess_paragraph.
  282 # Note that the below is very, very specific to Pod::Text and Pod::Simple.
  283 sub _handle_element_end {
  284     my ($self, $element) = @_;
  285     if ($element eq 'head1') {
  286         $self->{USAGE_HEADINGS} = [ $$self{PENDING}[-1][1] ];
  287         if ($self->{USAGE_OPTIONS}->{-verbose} < 2) {
  288             $$self{PENDING}[-1][1] =~ s/^\s*SYNOPSIS\s*$/USAGE/;
  289         }
  290     } elsif ($element =~ /^head(\d+)$/ && $1) { # avoid 0
  291         my $idx = $1 - 1;
  292         $self->{USAGE_HEADINGS} = [] unless($self->{USAGE_HEADINGS});
  293         $self->{USAGE_HEADINGS}->[$idx] = $$self{PENDING}[-1][1];
  294         # we have to get rid of the lower headings
  295         splice(@{$self->{USAGE_HEADINGS}},$idx+1);
  296     }
  297     if ($element =~ /^head\d+$/) {
  298         $$self{USAGE_SKIPPING} = 1;
  299         if (!$$self{USAGE_SELECT} || !@{ $$self{USAGE_SELECT} }) {
  300             $$self{USAGE_SKIPPING} = 0;
  301         } else {
  302             my @headings = @{$$self{USAGE_HEADINGS}};
  303             for my $section_spec ( @{$$self{USAGE_SELECT}} ) {
  304                 my $match = 1;
  305                 for (my $i = 0; $i < $MAX_HEADING_LEVEL; ++$i) {
  306                     $headings[$i] = '' unless defined $headings[$i];
  307                     my $regex   = $section_spec->[$i];
  308                     my $negated = ($regex =~ s/^\!//);
  309                     $match  &= ($negated ? ($headings[$i] !~ /${regex}/)
  310                                          : ($headings[$i] =~ /${regex}/));
  311                     last unless ($match);
  312                 } # end heading levels
  313                 if ($match) {
  314                   $$self{USAGE_SKIPPING} = 0;
  315                   last;
  316                 }
  317             } # end sections
  318         }
  319 
  320         # Try to do some lowercasing instead of all-caps in headings, and use
  321         # a colon to end all headings.
  322         if($self->{USAGE_OPTIONS}->{-verbose} < 2) {
  323             local $_ = $$self{PENDING}[-1][1];
  324             s{([A-Z])([A-Z]+)}{((length($2) > 2) ? $1 : lc($1)) . lc($2)}ge;
  325             s/\s*$/:/  unless (/:\s*$/);
  326             $_ .= "\n";
  327             $$self{PENDING}[-1][1] = $_;
  328         }
  329     }
  330     if ($$self{USAGE_SKIPPING} && $element !~ m/^over-|^[BCFILSZ]$/) {
  331         pop @{ $$self{PENDING} };
  332     } else {
  333         $self->SUPER::_handle_element_end($element);
  334     }
  335 }
  336 
  337 # required for Pod::Simple API
  338 sub start_document {
  339     my $self = shift;
  340     $self->SUPER::start_document();
  341     my $msg = $self->{USAGE_OPTIONS}->{-message}  or  return 1;
  342     my $out_fh = $self->output_fh();
  343     print $out_fh "$msg\n";
  344 }
  345 
  346 # required for old Pod::Parser API
  347 sub begin_pod {
  348     my $self = shift;
  349     $self->SUPER::begin_pod();  ## Have to call superclass
  350     my $msg = $self->{USAGE_OPTIONS}->{-message}  or  return 1;
  351     my $out_fh = $self->output_handle();
  352     print $out_fh "$msg\n";
  353 }
  354 
  355 sub preprocess_paragraph {
  356     my $self = shift;
  357     local $_ = shift;
  358     my $line = shift;
  359     ## See if this is a heading and we aren't printing the entire manpage.
  360     if (($self->{USAGE_OPTIONS}->{-verbose} < 2) && /^=head/) {
  361         ## Change the title of the SYNOPSIS section to USAGE
  362         s/^=head1\s+SYNOPSIS\s*$/=head1 USAGE/;
  363         ## Try to do some lowercasing instead of all-caps in headings
  364         s{([A-Z])([A-Z]+)}{((length($2) > 2) ? $1 : lc($1)) . lc($2)}ge;
  365         ## Use a colon to end all headings
  366         s/\s*$/:/  unless (/:\s*$/);
  367         $_ .= "\n";
  368     }
  369     return  $self->SUPER::preprocess_paragraph($_);
  370 }
  371 
  372 1; # keep require happy
  373 
  374 __END__
  375 
  376 =head1 NAME
  377 
  378 Pod::Usage - print a usage message from embedded pod documentation
  379 
  380 =head1 SYNOPSIS
  381 
  382   use Pod::Usage
  383 
  384   my $message_text  = "This text precedes the usage message.";
  385   my $exit_status   = 2;          ## The exit status to use
  386   my $verbose_level = 0;          ## The verbose level to use
  387   my $filehandle    = \*STDERR;   ## The filehandle to write to
  388 
  389   pod2usage($message_text);
  390 
  391   pod2usage($exit_status);
  392 
  393   pod2usage( { -message => $message_text ,
  394                -exitval => $exit_status  ,  
  395                -verbose => $verbose_level,  
  396                -output  => $filehandle } );
  397 
  398   pod2usage(   -msg     => $message_text ,
  399                -exitval => $exit_status  ,  
  400                -verbose => $verbose_level,  
  401                -output  => $filehandle );
  402 
  403   pod2usage(   -verbose => 2,
  404                -noperldoc => 1  );
  405 
  406   pod2usage(   -verbose => 2,
  407                -perlcmd => $path_to_perl,
  408                -perldoc => $path_to_perldoc,
  409                -perldocopt => $perldoc_options );
  410 
  411 =head1 ARGUMENTS
  412 
  413 B<pod2usage> should be given either a single argument, or a list of
  414 arguments corresponding to an associative array (a "hash"). When a single
  415 argument is given, it should correspond to exactly one of the following:
  416 
  417 =over 4
  418 
  419 =item *
  420 
  421 A string containing the text of a message to print I<before> printing
  422 the usage message
  423 
  424 =item *
  425 
  426 A numeric value corresponding to the desired exit status
  427 
  428 =item *
  429 
  430 A reference to a hash
  431 
  432 =back
  433 
  434 If more than one argument is given then the entire argument list is
  435 assumed to be a hash.  If a hash is supplied (either as a reference or
  436 as a list) it should contain one or more elements with the following
  437 keys:
  438 
  439 =over 4
  440 
  441 =item C<-message> I<string>
  442 
  443 =item C<-msg> I<string>
  444 
  445 The text of a message to print immediately prior to printing the
  446 program's usage message. 
  447 
  448 =item C<-exitval> I<value>
  449 
  450 The desired exit status to pass to the B<exit()> function.
  451 This should be an integer, or else the string "NOEXIT" to
  452 indicate that control should simply be returned without
  453 terminating the invoking process.
  454 
  455 =item C<-verbose> I<value>
  456 
  457 The desired level of "verboseness" to use when printing the usage message.
  458 If the value is 0, then only the "SYNOPSIS" section of the pod documentation
  459 is printed. If the value is 1, then the "SYNOPSIS" section, along with any
  460 section entitled "OPTIONS", "ARGUMENTS", or "OPTIONS AND ARGUMENTS" is
  461 printed. If the corresponding value is 2 or more then the entire manpage is
  462 printed, using L<perldoc> if available; otherwise L<Pod::Text> is used for
  463 the formatting. For better readability, the all-capital headings are
  464 downcased, e.g. C<SYNOPSIS> =E<gt> C<Synopsis>.
  465 
  466 The special verbosity level 99 requires to also specify the -sections
  467 parameter; then these sections are extracted and printed.
  468 
  469 =item C<-sections> I<spec>
  470 
  471 There are two ways to specify the selection. Either a string (scalar) 
  472 representing a selection regexp for sections to be printed when -verbose
  473 is set to 99, e.g.
  474 
  475   "NAME|SYNOPSIS|DESCRIPTION|VERSION"
  476 
  477 With the above regexp all content following (and including) any of the
  478 given C<=head1> headings will be shown. It is possible to restrict the 
  479 output to particular subsections only, e.g.:
  480 
  481   "DESCRIPTION/Algorithm"
  482 
  483 This will output only the C<=head2 Algorithm> heading and content within
  484 the C<=head1 DESCRIPTION> section. The regexp binding is stronger than the
  485 section separator, such that e.g.:
  486 
  487   "DESCRIPTION|OPTIONS|ENVIORNMENT/Caveats"
  488 
  489 will print any C<=head2 Caveats> section (only) within any of the three
  490 C<=head1> sections.
  491 
  492 Alternatively, an array reference of section specifications can be used:
  493 
  494   pod2usage(-verbose => 99, -sections => [
  495     qw(DESCRIPTION DESCRIPTION/Introduction) ] );
  496 
  497 This will print only the content of C<=head1 DESCRIPTION> and the 
  498 C<=head2 Introduction> sections, but no other C<=head2>, and no other
  499 C<=head1> either.
  500 
  501 =item C<-output> I<handle>
  502 
  503 A reference to a filehandle, or the pathname of a file to which the
  504 usage message should be written. The default is C<\*STDERR> unless the
  505 exit value is less than 2 (in which case the default is C<\*STDOUT>).
  506 
  507 =item C<-input> I<handle>
  508 
  509 A reference to a filehandle, or the pathname of a file from which the
  510 invoking script's pod documentation should be read.  It defaults to the
  511 file indicated by C<$0> (C<$PROGRAM_NAME> for users of F<English.pm>).
  512 
  513 If you are calling B<pod2usage()> from a module and want to display
  514 that module's POD, you can use this:
  515 
  516   use Pod::Find qw(pod_where);
  517   pod2usage( -input => pod_where({-inc => 1}, __PACKAGE__) );
  518 
  519 =item C<-pathlist> I<string>
  520 
  521 A list of directory paths. If the input file does not exist, then it
  522 will be searched for in the given directory list (in the order the
  523 directories appear in the list). It defaults to the list of directories
  524 implied by C<$ENV{PATH}>. The list may be specified either by a reference
  525 to an array, or by a string of directory paths which use the same path
  526 separator as C<$ENV{PATH}> on your system (e.g., C<:> for Unix, C<;> for
  527 MSWin32 and DOS).
  528 
  529 =item C<-noperldoc>
  530 
  531 By default, Pod::Usage will call L<perldoc> when -verbose >= 2 is
  532 specified. This does not work well e.g. if the script was packed
  533 with L<PAR>. The -noperldoc option suppresses the external call to
  534 L<perldoc> and uses the simple text formatter (L<Pod::Text>) to 
  535 output the POD.
  536 
  537 =item C<-perlcmd>
  538 
  539 By default, Pod::Usage will call L<perldoc> when -verbose >= 2 is
  540 specified. In case of special or unusual Perl installations,
  541 the -perlcmd option may be used to supply the path to a L<perl> executable
  542 which should run L<perldoc>.
  543 
  544 =item C<-perldoc> I<path-to-perldoc>
  545 
  546 By default, Pod::Usage will call L<perldoc> when -verbose >= 2 is
  547 specified. In case L<perldoc> is not installed where the L<perl> interpreter
  548 thinks it is (see L<Config>), the -perldoc option may be used to supply
  549 the correct path to L<perldoc>.
  550 
  551 =item C<-perldocopt> I<string>
  552 
  553 By default, Pod::Usage will call L<perldoc> when -verbose >= 2 is specified.
  554 The -perldocopt option may be used to supply options to L<perldoc>. The
  555 string may contain several, space-separated options.
  556 
  557 =back
  558 
  559 =head2 Formatting base class
  560 
  561 The default text formatter is L<Pod::Text>. The base class for Pod::Usage can
  562 be defined by pre-setting C<$Pod::Usage::Formatter> I<before>
  563 loading Pod::Usage, e.g.:
  564 
  565     BEGIN { $Pod::Usage::Formatter = 'Pod::Text::Termcap'; }
  566     use Pod::Usage qw(pod2usage);
  567 
  568 Pod::Usage uses L<Pod::Simple>'s _handle_element_end() method to implement
  569 the section selection, and in case of verbosity < 2 it down-cases the
  570 all-caps headings to first capital letter and rest lowercase, and adds
  571 a colon/newline at the end of the headings, for better readability. Same for
  572 verbosity = 99.
  573 
  574 =head2 Pass-through options
  575 
  576 The following options are passed through to the underlying text formatter.
  577 See the manual pages of these modules for more information.
  578 
  579   alt code indent loose margin quotes sentence stderr utf8 width
  580 
  581 =head1 DESCRIPTION
  582 
  583 B<pod2usage> will print a usage message for the invoking script (using
  584 its embedded pod documentation) and then exit the script with the
  585 desired exit status. The usage message printed may have any one of three
  586 levels of "verboseness": If the verbose level is 0, then only a synopsis
  587 is printed. If the verbose level is 1, then the synopsis is printed
  588 along with a description (if present) of the command line options and
  589 arguments. If the verbose level is 2, then the entire manual page is
  590 printed.
  591 
  592 Unless they are explicitly specified, the default values for the exit
  593 status, verbose level, and output stream to use are determined as
  594 follows:
  595 
  596 =over 4
  597 
  598 =item *
  599 
  600 If neither the exit status nor the verbose level is specified, then the
  601 default is to use an exit status of 2 with a verbose level of 0.
  602 
  603 =item *
  604 
  605 If an exit status I<is> specified but the verbose level is I<not>, then the
  606 verbose level will default to 1 if the exit status is less than 2 and
  607 will default to 0 otherwise.
  608 
  609 =item *
  610 
  611 If an exit status is I<not> specified but verbose level I<is> given, then
  612 the exit status will default to 2 if the verbose level is 0 and will
  613 default to 1 otherwise.
  614 
  615 =item *
  616 
  617 If the exit status used is less than 2, then output is printed on
  618 C<STDOUT>.  Otherwise output is printed on C<STDERR>.
  619 
  620 =back
  621 
  622 Although the above may seem a bit confusing at first, it generally does
  623 "the right thing" in most situations.  This determination of the default
  624 values to use is based upon the following typical Unix conventions:
  625 
  626 =over 4
  627 
  628 =item *
  629 
  630 An exit status of 0 implies "success". For example, B<diff(1)> exits
  631 with a status of 0 if the two files have the same contents.
  632 
  633 =item *
  634 
  635 An exit status of 1 implies possibly abnormal, but non-defective, program
  636 termination.  For example, B<grep(1)> exits with a status of 1 if
  637 it did I<not> find a matching line for the given regular expression.
  638 
  639 =item *
  640 
  641 An exit status of 2 or more implies a fatal error. For example, B<ls(1)>
  642 exits with a status of 2 if you specify an illegal (unknown) option on
  643 the command line.
  644 
  645 =item *
  646 
  647 Usage messages issued as a result of bad command-line syntax should go
  648 to C<STDERR>.  However, usage messages issued due to an explicit request
  649 to print usage (like specifying B<-help> on the command line) should go
  650 to C<STDOUT>, just in case the user wants to pipe the output to a pager
  651 (such as B<more(1)>).
  652 
  653 =item *
  654 
  655 If program usage has been explicitly requested by the user, it is often
  656 desirable to exit with a status of 1 (as opposed to 0) after issuing
  657 the user-requested usage message.  It is also desirable to give a
  658 more verbose description of program usage in this case.
  659 
  660 =back
  661 
  662 B<pod2usage> doesn't force the above conventions upon you, but it will
  663 use them by default if you don't expressly tell it to do otherwise.  The
  664 ability of B<pod2usage()> to accept a single number or a string makes it
  665 convenient to use as an innocent looking error message handling function:
  666 
  667     use strict;
  668     use Pod::Usage;
  669     use Getopt::Long;
  670 
  671     ## Parse options
  672     my %opt;
  673     GetOptions(\%opt, "help|?", "man", "flag1")  ||  pod2usage(2);
  674     pod2usage(1)  if ($opt{help});
  675     pod2usage(-exitval => 0, -verbose => 2)  if ($opt{man});
  676 
  677     ## Check for too many filenames
  678     pod2usage("$0: Too many files given.\n")  if (@ARGV > 1);
  679 
  680 Some user's however may feel that the above "economy of expression" is
  681 not particularly readable nor consistent and may instead choose to do
  682 something more like the following:
  683 
  684     use strict;
  685     use Pod::Usage qw(pod2usage);
  686     use Getopt::Long qw(GetOptions);
  687 
  688     ## Parse options
  689     my %opt;
  690     GetOptions(\%opt, "help|?", "man", "flag1")  ||
  691       pod2usage(-verbose => 0);
  692 
  693     pod2usage(-verbose => 1)  if ($opt{help});
  694     pod2usage(-verbose => 2)  if ($opt{man});
  695 
  696     ## Check for too many filenames
  697     pod2usage(-verbose => 2, -message => "$0: Too many files given.\n")
  698       if (@ARGV > 1);
  699 
  700 
  701 As with all things in Perl, I<there's more than one way to do it>, and
  702 B<pod2usage()> adheres to this philosophy.  If you are interested in
  703 seeing a number of different ways to invoke B<pod2usage> (although by no
  704 means exhaustive), please refer to L<"EXAMPLES">.
  705 
  706 =head2 Scripts
  707 
  708 The Pod::Usage distribution comes with a script pod2usage which offers
  709 a command line interface to the functionality of Pod::Usage. See
  710 L<pod2usage>.
  711 
  712 
  713 =head1 EXAMPLES
  714 
  715 Each of the following invocations of C<pod2usage()> will print just the
  716 "SYNOPSIS" section to C<STDERR> and will exit with a status of 2:
  717 
  718     pod2usage();
  719 
  720     pod2usage(2);
  721 
  722     pod2usage(-verbose => 0);
  723 
  724     pod2usage(-exitval => 2);
  725 
  726     pod2usage({-exitval => 2, -output => \*STDERR});
  727 
  728     pod2usage({-verbose => 0, -output  => \*STDERR});
  729 
  730     pod2usage(-exitval => 2, -verbose => 0);
  731 
  732     pod2usage(-exitval => 2, -verbose => 0, -output => \*STDERR);
  733 
  734 Each of the following invocations of C<pod2usage()> will print a message
  735 of "Syntax error." (followed by a newline) to C<STDERR>, immediately
  736 followed by just the "SYNOPSIS" section (also printed to C<STDERR>) and
  737 will exit with a status of 2:
  738 
  739     pod2usage("Syntax error.");
  740 
  741     pod2usage(-message => "Syntax error.", -verbose => 0);
  742 
  743     pod2usage(-msg  => "Syntax error.", -exitval => 2);
  744 
  745     pod2usage({-msg => "Syntax error.", -exitval => 2, -output => \*STDERR});
  746 
  747     pod2usage({-msg => "Syntax error.", -verbose => 0, -output => \*STDERR});
  748 
  749     pod2usage(-msg  => "Syntax error.", -exitval => 2, -verbose => 0);
  750 
  751     pod2usage(-message => "Syntax error.",
  752               -exitval => 2,
  753               -verbose => 0,
  754               -output  => \*STDERR);
  755 
  756 Each of the following invocations of C<pod2usage()> will print the
  757 "SYNOPSIS" section and any "OPTIONS" and/or "ARGUMENTS" sections to
  758 C<STDOUT> and will exit with a status of 1:
  759 
  760     pod2usage(1);
  761 
  762     pod2usage(-verbose => 1);
  763 
  764     pod2usage(-exitval => 1);
  765 
  766     pod2usage({-exitval => 1, -output => \*STDOUT});
  767 
  768     pod2usage({-verbose => 1, -output => \*STDOUT});
  769 
  770     pod2usage(-exitval => 1, -verbose => 1);
  771 
  772     pod2usage(-exitval => 1, -verbose => 1, -output => \*STDOUT});
  773 
  774 Each of the following invocations of C<pod2usage()> will print the
  775 entire manual page to C<STDOUT> and will exit with a status of 1:
  776 
  777     pod2usage(-verbose  => 2);
  778 
  779     pod2usage({-verbose => 2, -output => \*STDOUT});
  780 
  781     pod2usage(-exitval  => 1, -verbose => 2);
  782 
  783     pod2usage({-exitval => 1, -verbose => 2, -output => \*STDOUT});
  784 
  785 =head2 Recommended Use
  786 
  787 Most scripts should print some type of usage message to C<STDERR> when a
  788 command line syntax error is detected. They should also provide an
  789 option (usually C<-H> or C<-help>) to print a (possibly more verbose)
  790 usage message to C<STDOUT>. Some scripts may even wish to go so far as to
  791 provide a means of printing their complete documentation to C<STDOUT>
  792 (perhaps by allowing a C<-man> option). The following complete example
  793 uses B<Pod::Usage> in combination with B<Getopt::Long> to do all of these
  794 things:
  795 
  796     use strict;
  797     use Getopt::Long qw(GetOptions);
  798     use Pod::Usage qw(pod2usage);
  799 
  800     my $man = 0;
  801     my $help = 0;
  802     ## Parse options and print usage if there is a syntax error,
  803     ## or if usage was explicitly requested.
  804     GetOptions('help|?' => \$help, man => \$man) or pod2usage(2);
  805     pod2usage(1) if $help;
  806     pod2usage(-verbose => 2) if $man;
  807 
  808     ## If no arguments were given, then allow STDIN to be used only
  809     ## if it's not connected to a terminal (otherwise print usage)
  810     pod2usage("$0: No files given.")  if ((@ARGV == 0) && (-t STDIN));
  811 
  812     __END__
  813 
  814     =head1 NAME
  815 
  816     sample - Using GetOpt::Long and Pod::Usage
  817 
  818     =head1 SYNOPSIS
  819 
  820     sample [options] [file ...]
  821 
  822      Options:
  823        -help            brief help message
  824        -man             full documentation
  825 
  826     =head1 OPTIONS
  827 
  828     =over 4
  829 
  830     =item B<-help>
  831 
  832     Print a brief help message and exits.
  833 
  834     =item B<-man>
  835 
  836     Prints the manual page and exits.
  837 
  838     =back
  839 
  840     =head1 DESCRIPTION
  841 
  842     B<This program> will read the given input file(s) and do something
  843     useful with the contents thereof.
  844 
  845     =cut
  846 
  847 =head1 CAVEATS
  848 
  849 By default, B<pod2usage()> will use C<$0> as the path to the pod input
  850 file.  Unfortunately, not all systems on which Perl runs will set C<$0>
  851 properly (although if C<$0> isn't found, B<pod2usage()> will search
  852 C<$ENV{PATH}> or else the list specified by the C<-pathlist> option).
  853 If this is the case for your system, you may need to explicitly specify
  854 the path to the pod docs for the invoking script using something
  855 similar to the following:
  856 
  857     pod2usage(-exitval => 2, -input => "/path/to/your/pod/docs");
  858 
  859 In the pathological case that a script is called via a relative path
  860 I<and> the script itself changes the current working directory
  861 (see L<perlfunc/chdir>) I<before> calling pod2usage, Pod::Usage will
  862 fail even on robust platforms. Don't do that. Or use L<FindBin> to locate
  863 the script:
  864 
  865     use FindBin;
  866     pod2usage(-input => $FindBin::Bin . "/" . $FindBin::Script);
  867 
  868 =head1 AUTHOR
  869 
  870 Please report bugs using L<http://rt.cpan.org>.
  871 
  872 Marek Rouchal E<lt>marekr@cpan.orgE<gt>
  873 
  874 Brad Appleton E<lt>bradapp@enteract.comE<gt>
  875 
  876 Based on code for B<Pod::Text::pod2text()> written by
  877 Tom Christiansen E<lt>tchrist@mox.perl.comE<gt>
  878 
  879 =head1 ACKNOWLEDGMENTS
  880 
  881 rjbs for refactoring Pod::Usage to not use Pod::Parser any more.
  882 
  883 Steven McDougall E<lt>swmcd@world.std.comE<gt> for his help and patience
  884 with re-writing this manpage.
  885 
  886 =head1 SEE ALSO
  887 
  888 B<Pod::Usage> is now a standalone distribution, depending on
  889 L<Pod::Text> which in turn depends on L<Pod::Simple>.
  890 
  891 L<Pod::Perldoc>, L<Getopt::Long>, L<Pod::Find>, L<FindBin>,
  892 L<Pod::Text>, L<Pod::Text::Termcap>, L<Pod::Simple>
  893 
  894 =cut
  895