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
11package Pod::Usage;
12use strict;
13
14use vars qw($VERSION @ISA @EXPORT);
15$VERSION = '1.69';  ## Current version of this package
16require  5.006;    ## requires this Perl version or later
17
18#use diagnostics;
19use Carp;
20use Config;
21use Exporter;
22use File::Spec;
23
24@EXPORT = qw(&pod2usage);
25BEGIN {
26    $Pod::Usage::Formatter ||= 'Pod::Text';
27    eval "require $Pod::Usage::Formatter";
28    die $@ if $@;
29    @ISA = ( $Pod::Usage::Formatter );
30}
31
32our $MAX_HEADING_LEVEL = 3;
33
34##---------------------------------------------------------------------------
35
36##---------------------------------
37## Function definitions begin here
38##---------------------------------
39
40sub 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
183sub 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
207sub _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
246sub 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*".
275sub seq_i { return $_[1] }
276# Override Pod::Text->cmd_i to return just "arg", not "*arg*".
277# newer version based on Pod::Simple
278sub 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.
283sub _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
338sub 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
347sub 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
355sub 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
3721; # keep require happy
373
374__END__
375
376=head1 NAME
377
378Pod::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
413B<pod2usage> should be given either a single argument, or a list of
414arguments corresponding to an associative array (a "hash"). When a single
415argument is given, it should correspond to exactly one of the following:
416
417=over 4
418
419=item *
420
421A string containing the text of a message to print I<before> printing
422the usage message
423
424=item *
425
426A numeric value corresponding to the desired exit status
427
428=item *
429
430A reference to a hash
431
432=back
433
434If more than one argument is given then the entire argument list is
435assumed to be a hash.  If a hash is supplied (either as a reference or
436as a list) it should contain one or more elements with the following
437keys:
438
439=over 4
440
441=item C<-message> I<string>
442
443=item C<-msg> I<string>
444
445The text of a message to print immediately prior to printing the
446program's usage message.
447
448=item C<-exitval> I<value>
449
450The desired exit status to pass to the B<exit()> function.
451This should be an integer, or else the string "NOEXIT" to
452indicate that control should simply be returned without
453terminating the invoking process.
454
455=item C<-verbose> I<value>
456
457The desired level of "verboseness" to use when printing the usage message.
458If the value is 0, then only the "SYNOPSIS" section of the pod documentation
459is printed. If the value is 1, then the "SYNOPSIS" section, along with any
460section entitled "OPTIONS", "ARGUMENTS", or "OPTIONS AND ARGUMENTS" is
461printed. If the corresponding value is 2 or more then the entire manpage is
462printed, using L<perldoc> if available; otherwise L<Pod::Text> is used for
463the formatting. For better readability, the all-capital headings are
464downcased, e.g. C<SYNOPSIS> =E<gt> C<Synopsis>.
465
466The special verbosity level 99 requires to also specify the -sections
467parameter; then these sections are extracted and printed.
468
469=item C<-sections> I<spec>
470
471There are two ways to specify the selection. Either a string (scalar)
472representing a selection regexp for sections to be printed when -verbose
473is set to 99, e.g.
474
475  "NAME|SYNOPSIS|DESCRIPTION|VERSION"
476
477With the above regexp all content following (and including) any of the
478given C<=head1> headings will be shown. It is possible to restrict the
479output to particular subsections only, e.g.:
480
481  "DESCRIPTION/Algorithm"
482
483This will output only the C<=head2 Algorithm> heading and content within
484the C<=head1 DESCRIPTION> section. The regexp binding is stronger than the
485section separator, such that e.g.:
486
487  "DESCRIPTION|OPTIONS|ENVIORNMENT/Caveats"
488
489will print any C<=head2 Caveats> section (only) within any of the three
490C<=head1> sections.
491
492Alternatively, an array reference of section specifications can be used:
493
494  pod2usage(-verbose => 99, -sections => [
495    qw(DESCRIPTION DESCRIPTION/Introduction) ] );
496
497This will print only the content of C<=head1 DESCRIPTION> and the
498C<=head2 Introduction> sections, but no other C<=head2>, and no other
499C<=head1> either.
500
501=item C<-output> I<handle>
502
503A reference to a filehandle, or the pathname of a file to which the
504usage message should be written. The default is C<\*STDERR> unless the
505exit value is less than 2 (in which case the default is C<\*STDOUT>).
506
507=item C<-input> I<handle>
508
509A reference to a filehandle, or the pathname of a file from which the
510invoking script's pod documentation should be read.  It defaults to the
511file indicated by C<$0> (C<$PROGRAM_NAME> for users of F<English.pm>).
512
513If you are calling B<pod2usage()> from a module and want to display
514that 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
521A list of directory paths. If the input file does not exist, then it
522will be searched for in the given directory list (in the order the
523directories appear in the list). It defaults to the list of directories
524implied by C<$ENV{PATH}>. The list may be specified either by a reference
525to an array, or by a string of directory paths which use the same path
526separator as C<$ENV{PATH}> on your system (e.g., C<:> for Unix, C<;> for
527MSWin32 and DOS).
528
529=item C<-noperldoc>
530
531By default, Pod::Usage will call L<perldoc> when -verbose >= 2 is
532specified. This does not work well e.g. if the script was packed
533with L<PAR>. The -noperldoc option suppresses the external call to
534L<perldoc> and uses the simple text formatter (L<Pod::Text>) to
535output the POD.
536
537=item C<-perlcmd>
538
539By default, Pod::Usage will call L<perldoc> when -verbose >= 2 is
540specified. In case of special or unusual Perl installations,
541the -perlcmd option may be used to supply the path to a L<perl> executable
542which should run L<perldoc>.
543
544=item C<-perldoc> I<path-to-perldoc>
545
546By default, Pod::Usage will call L<perldoc> when -verbose >= 2 is
547specified. In case L<perldoc> is not installed where the L<perl> interpreter
548thinks it is (see L<Config>), the -perldoc option may be used to supply
549the correct path to L<perldoc>.
550
551=item C<-perldocopt> I<string>
552
553By default, Pod::Usage will call L<perldoc> when -verbose >= 2 is specified.
554The -perldocopt option may be used to supply options to L<perldoc>. The
555string may contain several, space-separated options.
556
557=back
558
559=head2 Formatting base class
560
561The default text formatter is L<Pod::Text>. The base class for Pod::Usage can
562be defined by pre-setting C<$Pod::Usage::Formatter> I<before>
563loading Pod::Usage, e.g.:
564
565    BEGIN { $Pod::Usage::Formatter = 'Pod::Text::Termcap'; }
566    use Pod::Usage qw(pod2usage);
567
568Pod::Usage uses L<Pod::Simple>'s _handle_element_end() method to implement
569the section selection, and in case of verbosity < 2 it down-cases the
570all-caps headings to first capital letter and rest lowercase, and adds
571a colon/newline at the end of the headings, for better readability. Same for
572verbosity = 99.
573
574=head2 Pass-through options
575
576The following options are passed through to the underlying text formatter.
577See 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
583B<pod2usage> will print a usage message for the invoking script (using
584its embedded pod documentation) and then exit the script with the
585desired exit status. The usage message printed may have any one of three
586levels of "verboseness": If the verbose level is 0, then only a synopsis
587is printed. If the verbose level is 1, then the synopsis is printed
588along with a description (if present) of the command line options and
589arguments. If the verbose level is 2, then the entire manual page is
590printed.
591
592Unless they are explicitly specified, the default values for the exit
593status, verbose level, and output stream to use are determined as
594follows:
595
596=over 4
597
598=item *
599
600If neither the exit status nor the verbose level is specified, then the
601default is to use an exit status of 2 with a verbose level of 0.
602
603=item *
604
605If an exit status I<is> specified but the verbose level is I<not>, then the
606verbose level will default to 1 if the exit status is less than 2 and
607will default to 0 otherwise.
608
609=item *
610
611If an exit status is I<not> specified but verbose level I<is> given, then
612the exit status will default to 2 if the verbose level is 0 and will
613default to 1 otherwise.
614
615=item *
616
617If the exit status used is less than 2, then output is printed on
618C<STDOUT>.  Otherwise output is printed on C<STDERR>.
619
620=back
621
622Although the above may seem a bit confusing at first, it generally does
623"the right thing" in most situations.  This determination of the default
624values to use is based upon the following typical Unix conventions:
625
626=over 4
627
628=item *
629
630An exit status of 0 implies "success". For example, B<diff(1)> exits
631with a status of 0 if the two files have the same contents.
632
633=item *
634
635An exit status of 1 implies possibly abnormal, but non-defective, program
636termination.  For example, B<grep(1)> exits with a status of 1 if
637it did I<not> find a matching line for the given regular expression.
638
639=item *
640
641An exit status of 2 or more implies a fatal error. For example, B<ls(1)>
642exits with a status of 2 if you specify an illegal (unknown) option on
643the command line.
644
645=item *
646
647Usage messages issued as a result of bad command-line syntax should go
648to C<STDERR>.  However, usage messages issued due to an explicit request
649to print usage (like specifying B<-help> on the command line) should go
650to 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
655If program usage has been explicitly requested by the user, it is often
656desirable to exit with a status of 1 (as opposed to 0) after issuing
657the user-requested usage message.  It is also desirable to give a
658more verbose description of program usage in this case.
659
660=back
661
662B<pod2usage> doesn't force the above conventions upon you, but it will
663use them by default if you don't expressly tell it to do otherwise.  The
664ability of B<pod2usage()> to accept a single number or a string makes it
665convenient 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
680Some user's however may feel that the above "economy of expression" is
681not particularly readable nor consistent and may instead choose to do
682something 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
701As with all things in Perl, I<there's more than one way to do it>, and
702B<pod2usage()> adheres to this philosophy.  If you are interested in
703seeing a number of different ways to invoke B<pod2usage> (although by no
704means exhaustive), please refer to L<"EXAMPLES">.
705
706=head2 Scripts
707
708The Pod::Usage distribution comes with a script pod2usage which offers
709a command line interface to the functionality of Pod::Usage. See
710L<pod2usage>.
711
712
713=head1 EXAMPLES
714
715Each 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
734Each of the following invocations of C<pod2usage()> will print a message
735of "Syntax error." (followed by a newline) to C<STDERR>, immediately
736followed by just the "SYNOPSIS" section (also printed to C<STDERR>) and
737will 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
756Each of the following invocations of C<pod2usage()> will print the
757"SYNOPSIS" section and any "OPTIONS" and/or "ARGUMENTS" sections to
758C<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
774Each of the following invocations of C<pod2usage()> will print the
775entire 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
787Most scripts should print some type of usage message to C<STDERR> when a
788command line syntax error is detected. They should also provide an
789option (usually C<-H> or C<-help>) to print a (possibly more verbose)
790usage message to C<STDOUT>. Some scripts may even wish to go so far as to
791provide a means of printing their complete documentation to C<STDOUT>
792(perhaps by allowing a C<-man> option). The following complete example
793uses B<Pod::Usage> in combination with B<Getopt::Long> to do all of these
794things:
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
849By default, B<pod2usage()> will use C<$0> as the path to the pod input
850file.  Unfortunately, not all systems on which Perl runs will set C<$0>
851properly (although if C<$0> isn't found, B<pod2usage()> will search
852C<$ENV{PATH}> or else the list specified by the C<-pathlist> option).
853If this is the case for your system, you may need to explicitly specify
854the path to the pod docs for the invoking script using something
855similar to the following:
856
857    pod2usage(-exitval => 2, -input => "/path/to/your/pod/docs");
858
859In the pathological case that a script is called via a relative path
860I<and> the script itself changes the current working directory
861(see L<perlfunc/chdir>) I<before> calling pod2usage, Pod::Usage will
862fail even on robust platforms. Don't do that. Or use L<FindBin> to locate
863the script:
864
865    use FindBin;
866    pod2usage(-input => $FindBin::Bin . "/" . $FindBin::Script);
867
868=head1 AUTHOR
869
870Please report bugs using L<http://rt.cpan.org>.
871
872Marek Rouchal E<lt>marekr@cpan.orgE<gt>
873
874Brad Appleton E<lt>bradapp@enteract.comE<gt>
875
876Based on code for B<Pod::Text::pod2text()> written by
877Tom Christiansen E<lt>tchrist@mox.perl.comE<gt>
878
879=head1 ACKNOWLEDGMENTS
880
881rjbs for refactoring Pod::Usage to not use Pod::Parser any more.
882
883Steven McDougall E<lt>swmcd@world.std.comE<gt> for his help and patience
884with re-writing this manpage.
885
886=head1 SEE ALSO
887
888B<Pod::Usage> is now a standalone distribution, depending on
889L<Pod::Text> which in turn depends on L<Pod::Simple>.
890
891L<Pod::Perldoc>, L<Getopt::Long>, L<Pod::Find>, L<FindBin>,
892L<Pod::Text>, L<Pod::Text::Termcap>, L<Pod::Simple>
893
894=cut
895
896