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