xref: /openbsd-src/gnu/usr.bin/perl/cpan/Pod-Usage/lib/Pod/Usage.pm (revision e068048151d29f2562a32185e21a8ba885482260)
191f110e0Safresh1#############################################################################
291f110e0Safresh1# Pod/Usage.pm -- print usage messages for the running script.
391f110e0Safresh1#
4b8851fccSafresh1# Copyright (c) 1996-2000 by Bradford Appleton. All rights reserved.
5b8851fccSafresh1# Copyright (c) 2001-2016 by Marek Rouchal.
6b8851fccSafresh1# This file is part of "Pod-Usage". Pod-Usage is free software;
791f110e0Safresh1# you can redistribute it and/or modify it under the same terms
891f110e0Safresh1# as Perl itself.
991f110e0Safresh1#############################################################################
1091f110e0Safresh1
1191f110e0Safresh1package Pod::Usage;
1291f110e0Safresh1
13eac174f2Safresh1use strict;
146fb12b70Safresh1require  5.006;    ## requires this Perl version or later
1591f110e0Safresh1
1691f110e0Safresh1use Carp;
1791f110e0Safresh1use Config;
1891f110e0Safresh1use Exporter;
1991f110e0Safresh1use File::Spec;
2091f110e0Safresh1
21*e0680481Safresh1our $VERSION = '2.03';
22eac174f2Safresh1
23eac174f2Safresh1our @EXPORT = qw(&pod2usage);
24eac174f2Safresh1our @ISA;
2591f110e0Safresh1BEGIN {
266fb12b70Safresh1    $Pod::Usage::Formatter ||= 'Pod::Text';
2791f110e0Safresh1    eval "require $Pod::Usage::Formatter";
2891f110e0Safresh1    die $@ if $@;
2991f110e0Safresh1    @ISA = ( $Pod::Usage::Formatter );
3091f110e0Safresh1}
3191f110e0Safresh1
326fb12b70Safresh1our $MAX_HEADING_LEVEL = 3;
3391f110e0Safresh1
3491f110e0Safresh1##---------------------------------------------------------------------------
3591f110e0Safresh1
3691f110e0Safresh1##---------------------------------
3791f110e0Safresh1## Function definitions begin here
3891f110e0Safresh1##---------------------------------
3991f110e0Safresh1
4091f110e0Safresh1sub pod2usage {
4191f110e0Safresh1    local($_) = shift;
4291f110e0Safresh1    my %opts;
4391f110e0Safresh1    ## Collect arguments
4491f110e0Safresh1    if (@_ > 0) {
4591f110e0Safresh1        ## Too many arguments - assume that this is a hash and
4691f110e0Safresh1        ## the user forgot to pass a reference to it.
4791f110e0Safresh1        %opts = ($_, @_);
4891f110e0Safresh1    }
4991f110e0Safresh1    elsif (!defined $_) {
5091f110e0Safresh1      $_ = '';
5191f110e0Safresh1    }
5291f110e0Safresh1    elsif (ref $_) {
5391f110e0Safresh1        ## User passed a ref to a hash
5491f110e0Safresh1        %opts = %{$_}  if (ref($_) eq 'HASH');
5591f110e0Safresh1    }
5691f110e0Safresh1    elsif (/^[-+]?\d+$/) {
5791f110e0Safresh1        ## User passed in the exit value to use
5891f110e0Safresh1        $opts{'-exitval'} =  $_;
5991f110e0Safresh1    }
6091f110e0Safresh1    else {
6191f110e0Safresh1        ## User passed in a message to print before issuing usage.
6291f110e0Safresh1        $_  and  $opts{'-message'} = $_;
6391f110e0Safresh1    }
6491f110e0Safresh1
6591f110e0Safresh1    ## Need this for backward compatibility since we formerly used
6691f110e0Safresh1    ## options that were all uppercase words rather than ones that
6791f110e0Safresh1    ## looked like Unix command-line options.
6891f110e0Safresh1    ## to be uppercase keywords)
6991f110e0Safresh1    %opts = map {
7091f110e0Safresh1        my ($key, $val) = ($_, $opts{$_});
7191f110e0Safresh1        $key =~ s/^(?=\w)/-/;
7291f110e0Safresh1        $key =~ /^-msg/i   and  $key = '-message';
7391f110e0Safresh1        $key =~ /^-exit/i  and  $key = '-exitval';
7491f110e0Safresh1        lc($key) => $val;
7591f110e0Safresh1    } (keys %opts);
7691f110e0Safresh1
7791f110e0Safresh1    ## Now determine default -exitval and -verbose values to use
7891f110e0Safresh1    if ((! defined $opts{'-exitval'}) && (! defined $opts{'-verbose'})) {
7991f110e0Safresh1        $opts{'-exitval'} = 2;
8091f110e0Safresh1        $opts{'-verbose'} = 0;
8191f110e0Safresh1    }
8291f110e0Safresh1    elsif (! defined $opts{'-exitval'}) {
8391f110e0Safresh1        $opts{'-exitval'} = ($opts{'-verbose'} > 0) ? 1 : 2;
8491f110e0Safresh1    }
8591f110e0Safresh1    elsif (! defined $opts{'-verbose'}) {
8691f110e0Safresh1        $opts{'-verbose'} = (lc($opts{'-exitval'}) eq 'noexit' ||
8791f110e0Safresh1                             $opts{'-exitval'} < 2);
8891f110e0Safresh1    }
8991f110e0Safresh1
9091f110e0Safresh1    ## Default the output file
9191f110e0Safresh1    $opts{'-output'} = (lc($opts{'-exitval'}) eq 'noexit' ||
9291f110e0Safresh1                        $opts{'-exitval'} < 2) ? \*STDOUT : \*STDERR
9391f110e0Safresh1            unless (defined $opts{'-output'});
9491f110e0Safresh1    ## Default the input file
9591f110e0Safresh1    $opts{'-input'} = $0  unless (defined $opts{'-input'});
9691f110e0Safresh1
976fb12b70Safresh1    ## Look up input file in path if it doesn't exist.
9891f110e0Safresh1    unless ((ref $opts{'-input'}) || (-e $opts{'-input'})) {
9991f110e0Safresh1        my $basename = $opts{'-input'};
10091f110e0Safresh1        my $pathsep = ($^O =~ /^(?:dos|os2|MSWin32)$/i) ? ';'
10191f110e0Safresh1                            : (($^O eq 'MacOS' || $^O eq 'VMS') ? ',' :  ':');
10291f110e0Safresh1        my $pathspec = $opts{'-pathlist'} || $ENV{PATH} || $ENV{PERL5LIB};
10391f110e0Safresh1
10491f110e0Safresh1        my @paths = (ref $pathspec) ? @$pathspec : split($pathsep, $pathspec);
10591f110e0Safresh1        for my $dirname (@paths) {
106eac174f2Safresh1            $_ = length($dirname) ? File::Spec->catfile($dirname, $basename) : $basename;
10791f110e0Safresh1            last if (-e $_) && ($opts{'-input'} = $_);
10891f110e0Safresh1        }
10991f110e0Safresh1    }
11091f110e0Safresh1
11191f110e0Safresh1    ## Now create a pod reader and constrain it to the desired sections.
112eac174f2Safresh1    my $parser = Pod::Usage->new(USAGE_OPTIONS => \%opts);
11391f110e0Safresh1    if ($opts{'-verbose'} == 0) {
11491f110e0Safresh1        $parser->select('(?:SYNOPSIS|USAGE)\s*');
11591f110e0Safresh1    }
11691f110e0Safresh1    elsif ($opts{'-verbose'} == 1) {
11791f110e0Safresh1        my $opt_re = '(?i)' .
11891f110e0Safresh1                     '(?:OPTIONS|ARGUMENTS)' .
11991f110e0Safresh1                     '(?:\s*(?:AND|\/)\s*(?:OPTIONS|ARGUMENTS))?';
12091f110e0Safresh1        $parser->select( '(?:SYNOPSIS|USAGE)\s*', $opt_re, "DESCRIPTION/$opt_re" );
12191f110e0Safresh1    }
12291f110e0Safresh1    elsif ($opts{'-verbose'} >= 2 && $opts{'-verbose'} != 99) {
12391f110e0Safresh1        $parser->select('.*');
12491f110e0Safresh1    }
12591f110e0Safresh1    elsif ($opts{'-verbose'} == 99) {
12691f110e0Safresh1        my $sections = $opts{'-sections'};
12791f110e0Safresh1        $parser->select( (ref $sections) ? @$sections : $sections );
12891f110e0Safresh1        $opts{'-verbose'} = 1;
12991f110e0Safresh1    }
13091f110e0Safresh1
13191f110e0Safresh1    ## Check for perldoc
132b8851fccSafresh1    my $progpath = $opts{'-perldoc'} ? $opts{'-perldoc'} :
133eac174f2Safresh1        File::Spec->catfile($Config{scriptdirexp} || $Config{scriptdir},
134eac174f2Safresh1            'perldoc');
13591f110e0Safresh1
13691f110e0Safresh1    my $version = sprintf("%vd",$^V);
13791f110e0Safresh1    if ($Config{versiononly} and $Config{startperl} =~ /\Q$version\E$/ ) {
13891f110e0Safresh1      $progpath .= $version;
13991f110e0Safresh1    }
14091f110e0Safresh1    $opts{'-noperldoc'} = 1 unless -e $progpath;
14191f110e0Safresh1
14291f110e0Safresh1    ## Now translate the pod document and then exit with the desired status
14391f110e0Safresh1    if (      !$opts{'-noperldoc'}
14491f110e0Safresh1         and  $opts{'-verbose'} >= 2
14591f110e0Safresh1         and  !ref($opts{'-input'})
14691f110e0Safresh1         and  $opts{'-output'} == \*STDOUT )
14791f110e0Safresh1    {
14891f110e0Safresh1       ## spit out the entire PODs. Might as well invoke perldoc
14991f110e0Safresh1       print { $opts{'-output'} } ($opts{'-message'}, "\n") if($opts{'-message'});
15091f110e0Safresh1       if(defined $opts{-input} && $opts{-input} =~ /^\s*(\S.*?)\s*$/) {
15191f110e0Safresh1         # the perldocs back to 5.005 should all have -F
15291f110e0Safresh1	 # without -F there are warnings in -T scripts
153b8851fccSafresh1	 my $f = $1;
154b8851fccSafresh1         my @perldoc_cmd = ($progpath);
155b8851fccSafresh1	 if ($opts{'-perldocopt'}) {
156b8851fccSafresh1           $opts{'-perldocopt'} =~ s/^\s+|\s+$//g;
157b8851fccSafresh1	   push @perldoc_cmd, split(/\s+/, $opts{'-perldocopt'});
158b8851fccSafresh1	 }
159b8851fccSafresh1	 push @perldoc_cmd, ('-F', $f);
160b8851fccSafresh1         unshift @perldoc_cmd, $opts{'-perlcmd'} if $opts{'-perlcmd'};
161b8851fccSafresh1         system(@perldoc_cmd);
16291f110e0Safresh1         # RT16091: fall back to more if perldoc failed
163eac174f2Safresh1         if($?) {
164eac174f2Safresh1           # RT131844: prefer PAGER env
165eac174f2Safresh1           my $pager = $ENV{PAGER} || $Config{pager};
166eac174f2Safresh1           if(defined($pager) && length($pager)) {
167eac174f2Safresh1             my $cmd = $pager . ' ' . ($^O =~ /win/i ? qq("$f") : quotemeta($f));
168eac174f2Safresh1             system($cmd);
169eac174f2Safresh1           } else {
170eac174f2Safresh1             # the most humble fallback; should work (at least) on *nix and Win
171eac174f2Safresh1             system('more', $f);
172eac174f2Safresh1           }
17391f110e0Safresh1         }
17491f110e0Safresh1       } else {
17591f110e0Safresh1         croak "Unspecified input file or insecure argument.\n";
17691f110e0Safresh1       }
17791f110e0Safresh1    }
17891f110e0Safresh1    else {
17991f110e0Safresh1       $parser->parse_from_file($opts{'-input'}, $opts{'-output'});
18091f110e0Safresh1    }
18191f110e0Safresh1
18291f110e0Safresh1    exit($opts{'-exitval'})  unless (lc($opts{'-exitval'}) eq 'noexit');
18391f110e0Safresh1}
18491f110e0Safresh1
18591f110e0Safresh1##---------------------------------------------------------------------------
18691f110e0Safresh1
18791f110e0Safresh1##-------------------------------
18891f110e0Safresh1## Method definitions begin here
18991f110e0Safresh1##-------------------------------
19091f110e0Safresh1
19191f110e0Safresh1sub new {
19291f110e0Safresh1    my $this = shift;
19391f110e0Safresh1    my $class = ref($this) || $this;
19491f110e0Safresh1    my %params = @_;
19591f110e0Safresh1    my $self = {%params};
19691f110e0Safresh1    bless $self, $class;
19791f110e0Safresh1    if ($self->can('initialize')) {
19891f110e0Safresh1        $self->initialize();
19991f110e0Safresh1    } else {
20091f110e0Safresh1        # pass through options to Pod::Text
20191f110e0Safresh1        my %opts;
20291f110e0Safresh1       	for (qw(alt code indent loose margin quotes sentence stderr utf8 width)) {
20391f110e0Safresh1            my $val = $params{USAGE_OPTIONS}{"-$_"};
20491f110e0Safresh1            $opts{$_} = $val if defined $val;
20591f110e0Safresh1        }
20691f110e0Safresh1        $self = $self->SUPER::new(%opts);
20791f110e0Safresh1        %$self = (%$self, %params);
20891f110e0Safresh1    }
20991f110e0Safresh1    return $self;
21091f110e0Safresh1}
21191f110e0Safresh1
2126fb12b70Safresh1# This subroutine was copied in whole-cloth from Pod::Select 1.60 in order to
2136fb12b70Safresh1# allow the ejection of Pod::Select from the core without breaking Pod::Usage.
2146fb12b70Safresh1# -- rjbs, 2013-03-18
2156fb12b70Safresh1sub _compile_section_spec {
2166fb12b70Safresh1    my ($section_spec) = @_;
2176fb12b70Safresh1    my (@regexs, $negated);
2186fb12b70Safresh1
2196fb12b70Safresh1    ## Compile the spec into a list of regexs
2206fb12b70Safresh1    local $_ = $section_spec;
2216fb12b70Safresh1    s{\\\\}{\001}g;  ## handle escaped backward slashes
2226fb12b70Safresh1    s{\\/}{\002}g;   ## handle escaped forward slashes
2236fb12b70Safresh1
2246fb12b70Safresh1    ## Parse the regexs for the heading titles
2256fb12b70Safresh1    @regexs = split(/\//, $_, $MAX_HEADING_LEVEL);
2266fb12b70Safresh1
2276fb12b70Safresh1    ## Set default regex for ommitted levels
2286fb12b70Safresh1    for (my $i = 0; $i < $MAX_HEADING_LEVEL; ++$i) {
2296fb12b70Safresh1        $regexs[$i]  = '.*'  unless ((defined $regexs[$i])
2306fb12b70Safresh1                                     && (length $regexs[$i]));
2316fb12b70Safresh1    }
2326fb12b70Safresh1    ## Modify the regexs as needed and validate their syntax
2336fb12b70Safresh1    my $bad_regexs = 0;
2346fb12b70Safresh1    for (@regexs) {
2356fb12b70Safresh1        $_ .= '.+'  if ($_ eq '!');
2366fb12b70Safresh1        s{\001}{\\\\}g;       ## restore escaped backward slashes
2376fb12b70Safresh1        s{\002}{\\/}g;        ## restore escaped forward slashes
2386fb12b70Safresh1        $negated = s/^\!//;   ## check for negation
2396fb12b70Safresh1        eval "m{$_}";         ## check regex syntax
2406fb12b70Safresh1        if ($@) {
2416fb12b70Safresh1            ++$bad_regexs;
2426fb12b70Safresh1            carp qq{Bad regular expression /$_/ in "$section_spec": $@\n};
2436fb12b70Safresh1        }
2446fb12b70Safresh1        else {
2456fb12b70Safresh1            ## Add the forward and rear anchors (and put the negator back)
2466fb12b70Safresh1            $_ = '^' . $_  unless (/^\^/);
2476fb12b70Safresh1            $_ = $_ . '$'  unless (/\$$/);
2486fb12b70Safresh1            $_ = '!' . $_  if ($negated);
2496fb12b70Safresh1        }
2506fb12b70Safresh1    }
2516fb12b70Safresh1    return  (! $bad_regexs) ? [ @regexs ] : undef;
2526fb12b70Safresh1}
2536fb12b70Safresh1
25491f110e0Safresh1sub select {
25591f110e0Safresh1    my ($self, @sections) = @_;
25691f110e0Safresh1    if ($ISA[0]->can('select')) {
25791f110e0Safresh1        $self->SUPER::select(@sections);
25891f110e0Safresh1    } else {
25991f110e0Safresh1        # we're using Pod::Simple - need to mimic the behavior of Pod::Select
26091f110e0Safresh1        my $add = ($sections[0] eq '+') ? shift(@sections) : '';
26191f110e0Safresh1        ## Reset the set of sections to use
26291f110e0Safresh1        unless (@sections) {
26391f110e0Safresh1          delete $self->{USAGE_SELECT} unless ($add);
26491f110e0Safresh1          return;
26591f110e0Safresh1        }
26691f110e0Safresh1        $self->{USAGE_SELECT} = []
26791f110e0Safresh1          unless ($add && $self->{USAGE_SELECT});
26891f110e0Safresh1        my $sref = $self->{USAGE_SELECT};
26991f110e0Safresh1        ## Compile each spec
27091f110e0Safresh1        for my $spec (@sections) {
2716fb12b70Safresh1          my $cs = _compile_section_spec($spec);
27291f110e0Safresh1          if ( defined $cs ) {
27391f110e0Safresh1            ## Store them in our sections array
27491f110e0Safresh1            push(@$sref, $cs);
27591f110e0Safresh1          } else {
27691f110e0Safresh1            carp qq{Ignoring section spec "$spec"!\n};
27791f110e0Safresh1          }
27891f110e0Safresh1        }
27991f110e0Safresh1    }
28091f110e0Safresh1}
28191f110e0Safresh1
28291f110e0Safresh1# Override Pod::Text->seq_i to return just "arg", not "*arg*".
28391f110e0Safresh1sub seq_i { return $_[1] }
284b8851fccSafresh1# Override Pod::Text->cmd_i to return just "arg", not "*arg*".
285b8851fccSafresh1# newer version based on Pod::Simple
286eac174f2Safresh1sub cmd_i {
287eac174f2Safresh1 my $self = shift;
288eac174f2Safresh1 # RT121489: highlighting should be there with Termcap
289eac174f2Safresh1 return $self->SUPER::cmd_i(@_) if $self->isa('Pod::Text::Termcap');
290eac174f2Safresh1 return $_[1];
291eac174f2Safresh1}
29291f110e0Safresh1
29391f110e0Safresh1# This overrides the Pod::Text method to do something very akin to what
29491f110e0Safresh1# Pod::Select did as well as the work done below by preprocess_paragraph.
295b8851fccSafresh1# Note that the below is very, very specific to Pod::Text and Pod::Simple.
29691f110e0Safresh1sub _handle_element_end {
29791f110e0Safresh1    my ($self, $element) = @_;
29891f110e0Safresh1    if ($element eq 'head1') {
29991f110e0Safresh1        $self->{USAGE_HEADINGS} = [ $$self{PENDING}[-1][1] ];
30091f110e0Safresh1        if ($self->{USAGE_OPTIONS}->{-verbose} < 2) {
30191f110e0Safresh1            $$self{PENDING}[-1][1] =~ s/^\s*SYNOPSIS\s*$/USAGE/;
30291f110e0Safresh1        }
30391f110e0Safresh1    } elsif ($element =~ /^head(\d+)$/ && $1) { # avoid 0
30491f110e0Safresh1        my $idx = $1 - 1;
30591f110e0Safresh1        $self->{USAGE_HEADINGS} = [] unless($self->{USAGE_HEADINGS});
30691f110e0Safresh1        $self->{USAGE_HEADINGS}->[$idx] = $$self{PENDING}[-1][1];
307b8851fccSafresh1        # we have to get rid of the lower headings
308b8851fccSafresh1        splice(@{$self->{USAGE_HEADINGS}},$idx+1);
30991f110e0Safresh1    }
31091f110e0Safresh1    if ($element =~ /^head\d+$/) {
31191f110e0Safresh1        $$self{USAGE_SKIPPING} = 1;
31291f110e0Safresh1        if (!$$self{USAGE_SELECT} || !@{ $$self{USAGE_SELECT} }) {
31391f110e0Safresh1            $$self{USAGE_SKIPPING} = 0;
31491f110e0Safresh1        } else {
31591f110e0Safresh1            my @headings = @{$$self{USAGE_HEADINGS}};
31691f110e0Safresh1            for my $section_spec ( @{$$self{USAGE_SELECT}} ) {
31791f110e0Safresh1                my $match = 1;
3186fb12b70Safresh1                for (my $i = 0; $i < $MAX_HEADING_LEVEL; ++$i) {
31991f110e0Safresh1                    $headings[$i] = '' unless defined $headings[$i];
32091f110e0Safresh1                    my $regex   = $section_spec->[$i];
32191f110e0Safresh1                    my $negated = ($regex =~ s/^\!//);
32291f110e0Safresh1                    $match  &= ($negated ? ($headings[$i] !~ /${regex}/)
32391f110e0Safresh1                                         : ($headings[$i] =~ /${regex}/));
32491f110e0Safresh1                    last unless ($match);
32591f110e0Safresh1                } # end heading levels
32691f110e0Safresh1                if ($match) {
32791f110e0Safresh1                  $$self{USAGE_SKIPPING} = 0;
32891f110e0Safresh1                  last;
32991f110e0Safresh1                }
33091f110e0Safresh1            } # end sections
33191f110e0Safresh1        }
33291f110e0Safresh1
33391f110e0Safresh1        # Try to do some lowercasing instead of all-caps in headings, and use
33491f110e0Safresh1        # a colon to end all headings.
33591f110e0Safresh1        if($self->{USAGE_OPTIONS}->{-verbose} < 2) {
33691f110e0Safresh1            local $_ = $$self{PENDING}[-1][1];
33791f110e0Safresh1            s{([A-Z])([A-Z]+)}{((length($2) > 2) ? $1 : lc($1)) . lc($2)}ge;
33891f110e0Safresh1            s/\s*$/:/  unless (/:\s*$/);
33991f110e0Safresh1            $_ .= "\n";
34091f110e0Safresh1            $$self{PENDING}[-1][1] = $_;
34191f110e0Safresh1        }
34291f110e0Safresh1    }
343b8851fccSafresh1    if ($$self{USAGE_SKIPPING} && $element !~ m/^over-|^[BCFILSZ]$/) {
34491f110e0Safresh1        pop @{ $$self{PENDING} };
34591f110e0Safresh1    } else {
34691f110e0Safresh1        $self->SUPER::_handle_element_end($element);
34791f110e0Safresh1    }
34891f110e0Safresh1}
34991f110e0Safresh1
35091f110e0Safresh1# required for Pod::Simple API
35191f110e0Safresh1sub start_document {
35291f110e0Safresh1    my $self = shift;
35391f110e0Safresh1    $self->SUPER::start_document();
35491f110e0Safresh1    my $msg = $self->{USAGE_OPTIONS}->{-message}  or  return 1;
35591f110e0Safresh1    my $out_fh = $self->output_fh();
35691f110e0Safresh1    print $out_fh "$msg\n";
35791f110e0Safresh1}
35891f110e0Safresh1
35991f110e0Safresh1# required for old Pod::Parser API
36091f110e0Safresh1sub begin_pod {
36191f110e0Safresh1    my $self = shift;
36291f110e0Safresh1    $self->SUPER::begin_pod();  ## Have to call superclass
36391f110e0Safresh1    my $msg = $self->{USAGE_OPTIONS}->{-message}  or  return 1;
36491f110e0Safresh1    my $out_fh = $self->output_handle();
36591f110e0Safresh1    print $out_fh "$msg\n";
36691f110e0Safresh1}
36791f110e0Safresh1
36891f110e0Safresh1sub preprocess_paragraph {
36991f110e0Safresh1    my $self = shift;
37091f110e0Safresh1    local $_ = shift;
37191f110e0Safresh1    my $line = shift;
3726fb12b70Safresh1    ## See if this is a heading and we aren't printing the entire manpage.
37391f110e0Safresh1    if (($self->{USAGE_OPTIONS}->{-verbose} < 2) && /^=head/) {
37491f110e0Safresh1        ## Change the title of the SYNOPSIS section to USAGE
37591f110e0Safresh1        s/^=head1\s+SYNOPSIS\s*$/=head1 USAGE/;
37691f110e0Safresh1        ## Try to do some lowercasing instead of all-caps in headings
37791f110e0Safresh1        s{([A-Z])([A-Z]+)}{((length($2) > 2) ? $1 : lc($1)) . lc($2)}ge;
37891f110e0Safresh1        ## Use a colon to end all headings
37991f110e0Safresh1        s/\s*$/:/  unless (/:\s*$/);
38091f110e0Safresh1        $_ .= "\n";
38191f110e0Safresh1    }
38291f110e0Safresh1    return  $self->SUPER::preprocess_paragraph($_);
38391f110e0Safresh1}
38491f110e0Safresh1
38591f110e0Safresh11; # keep require happy
38691f110e0Safresh1
38791f110e0Safresh1__END__
38891f110e0Safresh1
389eac174f2Safresh1=for stopwords pod2usage verboseness downcased MSWin32 Marek Rouchal Christiansen ATOOMIC rjbs McDougall
390eac174f2Safresh1
39191f110e0Safresh1=head1 NAME
39291f110e0Safresh1
393eac174f2Safresh1Pod::Usage - extracts POD documentation and shows usage information
39491f110e0Safresh1
39591f110e0Safresh1=head1 SYNOPSIS
39691f110e0Safresh1
397eac174f2Safresh1  use Pod::Usage;
39891f110e0Safresh1
39991f110e0Safresh1  my $message_text  = "This text precedes the usage message.";
40091f110e0Safresh1  my $exit_status   = 2;          ## The exit status to use
40191f110e0Safresh1  my $verbose_level = 0;          ## The verbose level to use
40291f110e0Safresh1  my $filehandle    = \*STDERR;   ## The filehandle to write to
40391f110e0Safresh1
40491f110e0Safresh1  pod2usage($message_text);
40591f110e0Safresh1
40691f110e0Safresh1  pod2usage($exit_status);
40791f110e0Safresh1
40891f110e0Safresh1  pod2usage( { -message => $message_text ,
40991f110e0Safresh1               -exitval => $exit_status  ,
41091f110e0Safresh1               -verbose => $verbose_level,
41191f110e0Safresh1               -output  => $filehandle } );
41291f110e0Safresh1
41391f110e0Safresh1  pod2usage(   -msg     => $message_text ,
41491f110e0Safresh1               -exitval => $exit_status  ,
41591f110e0Safresh1               -verbose => $verbose_level,
41691f110e0Safresh1               -output  => $filehandle );
41791f110e0Safresh1
41891f110e0Safresh1  pod2usage(   -verbose => 2,
419b8851fccSafresh1               -noperldoc => 1  );
420b8851fccSafresh1
421b8851fccSafresh1  pod2usage(   -verbose => 2,
422b8851fccSafresh1               -perlcmd => $path_to_perl,
423b8851fccSafresh1               -perldoc => $path_to_perldoc,
424b8851fccSafresh1               -perldocopt => $perldoc_options );
42591f110e0Safresh1
42691f110e0Safresh1=head1 ARGUMENTS
42791f110e0Safresh1
42891f110e0Safresh1B<pod2usage> should be given either a single argument, or a list of
42991f110e0Safresh1arguments corresponding to an associative array (a "hash"). When a single
43091f110e0Safresh1argument is given, it should correspond to exactly one of the following:
43191f110e0Safresh1
43291f110e0Safresh1=over 4
43391f110e0Safresh1
43491f110e0Safresh1=item *
43591f110e0Safresh1
43691f110e0Safresh1A string containing the text of a message to print I<before> printing
43791f110e0Safresh1the usage message
43891f110e0Safresh1
43991f110e0Safresh1=item *
44091f110e0Safresh1
44191f110e0Safresh1A numeric value corresponding to the desired exit status
44291f110e0Safresh1
44391f110e0Safresh1=item *
44491f110e0Safresh1
44591f110e0Safresh1A reference to a hash
44691f110e0Safresh1
44791f110e0Safresh1=back
44891f110e0Safresh1
44991f110e0Safresh1If more than one argument is given then the entire argument list is
45091f110e0Safresh1assumed to be a hash.  If a hash is supplied (either as a reference or
45191f110e0Safresh1as a list) it should contain one or more elements with the following
45291f110e0Safresh1keys:
45391f110e0Safresh1
45491f110e0Safresh1=over 4
45591f110e0Safresh1
456b8851fccSafresh1=item C<-message> I<string>
45791f110e0Safresh1
458b8851fccSafresh1=item C<-msg> I<string>
45991f110e0Safresh1
46091f110e0Safresh1The text of a message to print immediately prior to printing the
46191f110e0Safresh1program's usage message.
46291f110e0Safresh1
463b8851fccSafresh1=item C<-exitval> I<value>
46491f110e0Safresh1
46591f110e0Safresh1The desired exit status to pass to the B<exit()> function.
466eac174f2Safresh1This should be an integer, or else the string C<NOEXIT> to
46791f110e0Safresh1indicate that control should simply be returned without
46891f110e0Safresh1terminating the invoking process.
46991f110e0Safresh1
470b8851fccSafresh1=item C<-verbose> I<value>
47191f110e0Safresh1
472b8851fccSafresh1The desired level of "verboseness" to use when printing the usage message.
473eac174f2Safresh1If the value is 0, then only the "SYNOPSIS" and/or "USAGE" sections of the
474eac174f2Safresh1pod documentation are printed. If the value is 1, then the "SYNOPSIS" and/or
475eac174f2Safresh1"USAGE" sections, along with any section entitled "OPTIONS", "ARGUMENTS", or
476eac174f2Safresh1"OPTIONS AND ARGUMENTS" is printed. If the corresponding value is 2 or more
477eac174f2Safresh1then the entire manpage is printed, using L<perldoc> if available; otherwise
478eac174f2Safresh1L<Pod::Text> is used for the formatting. For better readability, the
479eac174f2Safresh1all-capital headings are downcased, e.g. C<SYNOPSIS> =E<gt> C<Synopsis>.
48091f110e0Safresh1
48191f110e0Safresh1The special verbosity level 99 requires to also specify the -sections
4826fb12b70Safresh1parameter; then these sections are extracted and printed.
48391f110e0Safresh1
484b8851fccSafresh1=item C<-sections> I<spec>
48591f110e0Safresh1
486b8851fccSafresh1There are two ways to specify the selection. Either a string (scalar)
487b8851fccSafresh1representing a selection regexp for sections to be printed when -verbose
488b8851fccSafresh1is set to 99, e.g.
489b8851fccSafresh1
490b8851fccSafresh1  "NAME|SYNOPSIS|DESCRIPTION|VERSION"
491b8851fccSafresh1
492b8851fccSafresh1With the above regexp all content following (and including) any of the
493b8851fccSafresh1given C<=head1> headings will be shown. It is possible to restrict the
494b8851fccSafresh1output to particular subsections only, e.g.:
495b8851fccSafresh1
496b8851fccSafresh1  "DESCRIPTION/Algorithm"
497b8851fccSafresh1
498b8851fccSafresh1This will output only the C<=head2 Algorithm> heading and content within
499b8851fccSafresh1the C<=head1 DESCRIPTION> section. The regexp binding is stronger than the
500b8851fccSafresh1section separator, such that e.g.:
501b8851fccSafresh1
502eac174f2Safresh1  "DESCRIPTION|OPTIONS|ENVIRONMENT/Caveats"
503b8851fccSafresh1
504b8851fccSafresh1will print any C<=head2 Caveats> section (only) within any of the three
505b8851fccSafresh1C<=head1> sections.
50691f110e0Safresh1
50791f110e0Safresh1Alternatively, an array reference of section specifications can be used:
50891f110e0Safresh1
509b8851fccSafresh1  pod2usage(-verbose => 99, -sections => [
510b8851fccSafresh1    qw(DESCRIPTION DESCRIPTION/Introduction) ] );
51191f110e0Safresh1
512b8851fccSafresh1This will print only the content of C<=head1 DESCRIPTION> and the
513b8851fccSafresh1C<=head2 Introduction> sections, but no other C<=head2>, and no other
514b8851fccSafresh1C<=head1> either.
515b8851fccSafresh1
516b8851fccSafresh1=item C<-output> I<handle>
51791f110e0Safresh1
51891f110e0Safresh1A reference to a filehandle, or the pathname of a file to which the
51991f110e0Safresh1usage message should be written. The default is C<\*STDERR> unless the
52091f110e0Safresh1exit value is less than 2 (in which case the default is C<\*STDOUT>).
52191f110e0Safresh1
522b8851fccSafresh1=item C<-input> I<handle>
52391f110e0Safresh1
52491f110e0Safresh1A reference to a filehandle, or the pathname of a file from which the
52591f110e0Safresh1invoking script's pod documentation should be read.  It defaults to the
52691f110e0Safresh1file indicated by C<$0> (C<$PROGRAM_NAME> for users of F<English.pm>).
52791f110e0Safresh1
52891f110e0Safresh1If you are calling B<pod2usage()> from a module and want to display
52991f110e0Safresh1that module's POD, you can use this:
53091f110e0Safresh1
53191f110e0Safresh1  use Pod::Find qw(pod_where);
53291f110e0Safresh1  pod2usage( -input => pod_where({-inc => 1}, __PACKAGE__) );
53391f110e0Safresh1
534b8851fccSafresh1=item C<-pathlist> I<string>
53591f110e0Safresh1
53691f110e0Safresh1A list of directory paths. If the input file does not exist, then it
53791f110e0Safresh1will be searched for in the given directory list (in the order the
53891f110e0Safresh1directories appear in the list). It defaults to the list of directories
53991f110e0Safresh1implied by C<$ENV{PATH}>. The list may be specified either by a reference
54091f110e0Safresh1to an array, or by a string of directory paths which use the same path
54191f110e0Safresh1separator as C<$ENV{PATH}> on your system (e.g., C<:> for Unix, C<;> for
54291f110e0Safresh1MSWin32 and DOS).
54391f110e0Safresh1
54491f110e0Safresh1=item C<-noperldoc>
54591f110e0Safresh1
546eac174f2Safresh1By default, Pod::Usage will call L<perldoc> when -verbose >= 2 is specified.
547eac174f2Safresh1This does not work well e.g. if the script was packed with L<PAR>. This option
548eac174f2Safresh1suppresses the external call to L<perldoc> and uses the simple text formatter
549eac174f2Safresh1(L<Pod::Text>) to output the POD.
55091f110e0Safresh1
551b8851fccSafresh1=item C<-perlcmd>
552b8851fccSafresh1
553b8851fccSafresh1By default, Pod::Usage will call L<perldoc> when -verbose >= 2 is
554b8851fccSafresh1specified. In case of special or unusual Perl installations,
555eac174f2Safresh1this option may be used to supply the path to a L<perl> executable
556b8851fccSafresh1which should run L<perldoc>.
557b8851fccSafresh1
558b8851fccSafresh1=item C<-perldoc> I<path-to-perldoc>
559b8851fccSafresh1
560b8851fccSafresh1By default, Pod::Usage will call L<perldoc> when -verbose >= 2 is
561b8851fccSafresh1specified. In case L<perldoc> is not installed where the L<perl> interpreter
562b8851fccSafresh1thinks it is (see L<Config>), the -perldoc option may be used to supply
563b8851fccSafresh1the correct path to L<perldoc>.
564b8851fccSafresh1
565b8851fccSafresh1=item C<-perldocopt> I<string>
566b8851fccSafresh1
567b8851fccSafresh1By default, Pod::Usage will call L<perldoc> when -verbose >= 2 is specified.
568eac174f2Safresh1This option may be used to supply options to L<perldoc>. The
569b8851fccSafresh1string may contain several, space-separated options.
570b8851fccSafresh1
57191f110e0Safresh1=back
57291f110e0Safresh1
57391f110e0Safresh1=head2 Formatting base class
57491f110e0Safresh1
5756fb12b70Safresh1The default text formatter is L<Pod::Text>. The base class for Pod::Usage can
5766fb12b70Safresh1be defined by pre-setting C<$Pod::Usage::Formatter> I<before>
57791f110e0Safresh1loading Pod::Usage, e.g.:
57891f110e0Safresh1
57991f110e0Safresh1    BEGIN { $Pod::Usage::Formatter = 'Pod::Text::Termcap'; }
58091f110e0Safresh1    use Pod::Usage qw(pod2usage);
58191f110e0Safresh1
582b8851fccSafresh1Pod::Usage uses L<Pod::Simple>'s _handle_element_end() method to implement
583b8851fccSafresh1the section selection, and in case of verbosity < 2 it down-cases the
584b8851fccSafresh1all-caps headings to first capital letter and rest lowercase, and adds
585b8851fccSafresh1a colon/newline at the end of the headings, for better readability. Same for
586b8851fccSafresh1verbosity = 99.
587b8851fccSafresh1
58891f110e0Safresh1=head2 Pass-through options
58991f110e0Safresh1
59091f110e0Safresh1The following options are passed through to the underlying text formatter.
59191f110e0Safresh1See the manual pages of these modules for more information.
59291f110e0Safresh1
59391f110e0Safresh1  alt code indent loose margin quotes sentence stderr utf8 width
59491f110e0Safresh1
59591f110e0Safresh1=head1 DESCRIPTION
59691f110e0Safresh1
59791f110e0Safresh1B<pod2usage> will print a usage message for the invoking script (using
59891f110e0Safresh1its embedded pod documentation) and then exit the script with the
59991f110e0Safresh1desired exit status. The usage message printed may have any one of three
60091f110e0Safresh1levels of "verboseness": If the verbose level is 0, then only a synopsis
60191f110e0Safresh1is printed. If the verbose level is 1, then the synopsis is printed
60291f110e0Safresh1along with a description (if present) of the command line options and
60391f110e0Safresh1arguments. If the verbose level is 2, then the entire manual page is
60491f110e0Safresh1printed.
60591f110e0Safresh1
60691f110e0Safresh1Unless they are explicitly specified, the default values for the exit
60791f110e0Safresh1status, verbose level, and output stream to use are determined as
60891f110e0Safresh1follows:
60991f110e0Safresh1
61091f110e0Safresh1=over 4
61191f110e0Safresh1
61291f110e0Safresh1=item *
61391f110e0Safresh1
61491f110e0Safresh1If neither the exit status nor the verbose level is specified, then the
61591f110e0Safresh1default is to use an exit status of 2 with a verbose level of 0.
61691f110e0Safresh1
61791f110e0Safresh1=item *
61891f110e0Safresh1
61991f110e0Safresh1If an exit status I<is> specified but the verbose level is I<not>, then the
62091f110e0Safresh1verbose level will default to 1 if the exit status is less than 2 and
62191f110e0Safresh1will default to 0 otherwise.
62291f110e0Safresh1
62391f110e0Safresh1=item *
62491f110e0Safresh1
62591f110e0Safresh1If an exit status is I<not> specified but verbose level I<is> given, then
62691f110e0Safresh1the exit status will default to 2 if the verbose level is 0 and will
62791f110e0Safresh1default to 1 otherwise.
62891f110e0Safresh1
62991f110e0Safresh1=item *
63091f110e0Safresh1
63191f110e0Safresh1If the exit status used is less than 2, then output is printed on
63291f110e0Safresh1C<STDOUT>.  Otherwise output is printed on C<STDERR>.
63391f110e0Safresh1
63491f110e0Safresh1=back
63591f110e0Safresh1
63691f110e0Safresh1Although the above may seem a bit confusing at first, it generally does
63791f110e0Safresh1"the right thing" in most situations.  This determination of the default
63891f110e0Safresh1values to use is based upon the following typical Unix conventions:
63991f110e0Safresh1
64091f110e0Safresh1=over 4
64191f110e0Safresh1
64291f110e0Safresh1=item *
64391f110e0Safresh1
64491f110e0Safresh1An exit status of 0 implies "success". For example, B<diff(1)> exits
64591f110e0Safresh1with a status of 0 if the two files have the same contents.
64691f110e0Safresh1
64791f110e0Safresh1=item *
64891f110e0Safresh1
64991f110e0Safresh1An exit status of 1 implies possibly abnormal, but non-defective, program
65091f110e0Safresh1termination.  For example, B<grep(1)> exits with a status of 1 if
65191f110e0Safresh1it did I<not> find a matching line for the given regular expression.
65291f110e0Safresh1
65391f110e0Safresh1=item *
65491f110e0Safresh1
65591f110e0Safresh1An exit status of 2 or more implies a fatal error. For example, B<ls(1)>
65691f110e0Safresh1exits with a status of 2 if you specify an illegal (unknown) option on
65791f110e0Safresh1the command line.
65891f110e0Safresh1
65991f110e0Safresh1=item *
66091f110e0Safresh1
66191f110e0Safresh1Usage messages issued as a result of bad command-line syntax should go
66291f110e0Safresh1to C<STDERR>.  However, usage messages issued due to an explicit request
66391f110e0Safresh1to print usage (like specifying B<-help> on the command line) should go
66491f110e0Safresh1to C<STDOUT>, just in case the user wants to pipe the output to a pager
66591f110e0Safresh1(such as B<more(1)>).
66691f110e0Safresh1
66791f110e0Safresh1=item *
66891f110e0Safresh1
66991f110e0Safresh1If program usage has been explicitly requested by the user, it is often
67091f110e0Safresh1desirable to exit with a status of 1 (as opposed to 0) after issuing
67191f110e0Safresh1the user-requested usage message.  It is also desirable to give a
67291f110e0Safresh1more verbose description of program usage in this case.
67391f110e0Safresh1
67491f110e0Safresh1=back
67591f110e0Safresh1
676eac174f2Safresh1B<pod2usage> does not force the above conventions upon you, but it will
67791f110e0Safresh1use them by default if you don't expressly tell it to do otherwise.  The
67891f110e0Safresh1ability of B<pod2usage()> to accept a single number or a string makes it
67991f110e0Safresh1convenient to use as an innocent looking error message handling function:
68091f110e0Safresh1
681b8851fccSafresh1    use strict;
68291f110e0Safresh1    use Pod::Usage;
68391f110e0Safresh1    use Getopt::Long;
68491f110e0Safresh1
68591f110e0Safresh1    ## Parse options
686b8851fccSafresh1    my %opt;
687b8851fccSafresh1    GetOptions(\%opt, "help|?", "man", "flag1")  ||  pod2usage(2);
688b8851fccSafresh1    pod2usage(1)  if ($opt{help});
689b8851fccSafresh1    pod2usage(-exitval => 0, -verbose => 2)  if ($opt{man});
69091f110e0Safresh1
69191f110e0Safresh1    ## Check for too many filenames
69291f110e0Safresh1    pod2usage("$0: Too many files given.\n")  if (@ARGV > 1);
69391f110e0Safresh1
69491f110e0Safresh1Some user's however may feel that the above "economy of expression" is
69591f110e0Safresh1not particularly readable nor consistent and may instead choose to do
69691f110e0Safresh1something more like the following:
69791f110e0Safresh1
698b8851fccSafresh1    use strict;
699b8851fccSafresh1    use Pod::Usage qw(pod2usage);
700b8851fccSafresh1    use Getopt::Long qw(GetOptions);
70191f110e0Safresh1
70291f110e0Safresh1    ## Parse options
703b8851fccSafresh1    my %opt;
704b8851fccSafresh1    GetOptions(\%opt, "help|?", "man", "flag1")  ||
705b8851fccSafresh1      pod2usage(-verbose => 0);
706b8851fccSafresh1
707b8851fccSafresh1    pod2usage(-verbose => 1)  if ($opt{help});
708b8851fccSafresh1    pod2usage(-verbose => 2)  if ($opt{man});
70991f110e0Safresh1
71091f110e0Safresh1    ## Check for too many filenames
71191f110e0Safresh1    pod2usage(-verbose => 2, -message => "$0: Too many files given.\n")
71291f110e0Safresh1      if (@ARGV > 1);
71391f110e0Safresh1
714b8851fccSafresh1
71591f110e0Safresh1As with all things in Perl, I<there's more than one way to do it>, and
71691f110e0Safresh1B<pod2usage()> adheres to this philosophy.  If you are interested in
71791f110e0Safresh1seeing a number of different ways to invoke B<pod2usage> (although by no
71891f110e0Safresh1means exhaustive), please refer to L<"EXAMPLES">.
71991f110e0Safresh1
720b8851fccSafresh1=head2 Scripts
721b8851fccSafresh1
722b8851fccSafresh1The Pod::Usage distribution comes with a script pod2usage which offers
723b8851fccSafresh1a command line interface to the functionality of Pod::Usage. See
724b8851fccSafresh1L<pod2usage>.
725b8851fccSafresh1
726b8851fccSafresh1
72791f110e0Safresh1=head1 EXAMPLES
72891f110e0Safresh1
72991f110e0Safresh1Each of the following invocations of C<pod2usage()> will print just the
73091f110e0Safresh1"SYNOPSIS" section to C<STDERR> and will exit with a status of 2:
73191f110e0Safresh1
73291f110e0Safresh1    pod2usage();
73391f110e0Safresh1
73491f110e0Safresh1    pod2usage(2);
73591f110e0Safresh1
73691f110e0Safresh1    pod2usage(-verbose => 0);
73791f110e0Safresh1
73891f110e0Safresh1    pod2usage(-exitval => 2);
73991f110e0Safresh1
74091f110e0Safresh1    pod2usage({-exitval => 2, -output => \*STDERR});
74191f110e0Safresh1
74291f110e0Safresh1    pod2usage({-verbose => 0, -output  => \*STDERR});
74391f110e0Safresh1
74491f110e0Safresh1    pod2usage(-exitval => 2, -verbose => 0);
74591f110e0Safresh1
74691f110e0Safresh1    pod2usage(-exitval => 2, -verbose => 0, -output => \*STDERR);
74791f110e0Safresh1
74891f110e0Safresh1Each of the following invocations of C<pod2usage()> will print a message
74991f110e0Safresh1of "Syntax error." (followed by a newline) to C<STDERR>, immediately
75091f110e0Safresh1followed by just the "SYNOPSIS" section (also printed to C<STDERR>) and
75191f110e0Safresh1will exit with a status of 2:
75291f110e0Safresh1
75391f110e0Safresh1    pod2usage("Syntax error.");
75491f110e0Safresh1
75591f110e0Safresh1    pod2usage(-message => "Syntax error.", -verbose => 0);
75691f110e0Safresh1
75791f110e0Safresh1    pod2usage(-msg  => "Syntax error.", -exitval => 2);
75891f110e0Safresh1
75991f110e0Safresh1    pod2usage({-msg => "Syntax error.", -exitval => 2, -output => \*STDERR});
76091f110e0Safresh1
76191f110e0Safresh1    pod2usage({-msg => "Syntax error.", -verbose => 0, -output => \*STDERR});
76291f110e0Safresh1
76391f110e0Safresh1    pod2usage(-msg  => "Syntax error.", -exitval => 2, -verbose => 0);
76491f110e0Safresh1
76591f110e0Safresh1    pod2usage(-message => "Syntax error.",
76691f110e0Safresh1              -exitval => 2,
76791f110e0Safresh1              -verbose => 0,
76891f110e0Safresh1              -output  => \*STDERR);
76991f110e0Safresh1
77091f110e0Safresh1Each of the following invocations of C<pod2usage()> will print the
77191f110e0Safresh1"SYNOPSIS" section and any "OPTIONS" and/or "ARGUMENTS" sections to
77291f110e0Safresh1C<STDOUT> and will exit with a status of 1:
77391f110e0Safresh1
77491f110e0Safresh1    pod2usage(1);
77591f110e0Safresh1
77691f110e0Safresh1    pod2usage(-verbose => 1);
77791f110e0Safresh1
77891f110e0Safresh1    pod2usage(-exitval => 1);
77991f110e0Safresh1
78091f110e0Safresh1    pod2usage({-exitval => 1, -output => \*STDOUT});
78191f110e0Safresh1
78291f110e0Safresh1    pod2usage({-verbose => 1, -output => \*STDOUT});
78391f110e0Safresh1
78491f110e0Safresh1    pod2usage(-exitval => 1, -verbose => 1);
78591f110e0Safresh1
78691f110e0Safresh1    pod2usage(-exitval => 1, -verbose => 1, -output => \*STDOUT});
78791f110e0Safresh1
78891f110e0Safresh1Each of the following invocations of C<pod2usage()> will print the
78991f110e0Safresh1entire manual page to C<STDOUT> and will exit with a status of 1:
79091f110e0Safresh1
79191f110e0Safresh1    pod2usage(-verbose  => 2);
79291f110e0Safresh1
79391f110e0Safresh1    pod2usage({-verbose => 2, -output => \*STDOUT});
79491f110e0Safresh1
79591f110e0Safresh1    pod2usage(-exitval  => 1, -verbose => 2);
79691f110e0Safresh1
79791f110e0Safresh1    pod2usage({-exitval => 1, -verbose => 2, -output => \*STDOUT});
79891f110e0Safresh1
79991f110e0Safresh1=head2 Recommended Use
80091f110e0Safresh1
80191f110e0Safresh1Most scripts should print some type of usage message to C<STDERR> when a
80291f110e0Safresh1command line syntax error is detected. They should also provide an
80391f110e0Safresh1option (usually C<-H> or C<-help>) to print a (possibly more verbose)
80491f110e0Safresh1usage message to C<STDOUT>. Some scripts may even wish to go so far as to
80591f110e0Safresh1provide a means of printing their complete documentation to C<STDOUT>
80691f110e0Safresh1(perhaps by allowing a C<-man> option). The following complete example
80791f110e0Safresh1uses B<Pod::Usage> in combination with B<Getopt::Long> to do all of these
80891f110e0Safresh1things:
80991f110e0Safresh1
810b8851fccSafresh1    use strict;
811b8851fccSafresh1    use Getopt::Long qw(GetOptions);
812b8851fccSafresh1    use Pod::Usage qw(pod2usage);
81391f110e0Safresh1
81491f110e0Safresh1    my $man = 0;
81591f110e0Safresh1    my $help = 0;
81691f110e0Safresh1    ## Parse options and print usage if there is a syntax error,
81791f110e0Safresh1    ## or if usage was explicitly requested.
81891f110e0Safresh1    GetOptions('help|?' => \$help, man => \$man) or pod2usage(2);
81991f110e0Safresh1    pod2usage(1) if $help;
82091f110e0Safresh1    pod2usage(-verbose => 2) if $man;
82191f110e0Safresh1
82291f110e0Safresh1    ## If no arguments were given, then allow STDIN to be used only
82391f110e0Safresh1    ## if it's not connected to a terminal (otherwise print usage)
82491f110e0Safresh1    pod2usage("$0: No files given.")  if ((@ARGV == 0) && (-t STDIN));
825b8851fccSafresh1
82691f110e0Safresh1    __END__
82791f110e0Safresh1
82891f110e0Safresh1    =head1 NAME
82991f110e0Safresh1
83091f110e0Safresh1    sample - Using GetOpt::Long and Pod::Usage
83191f110e0Safresh1
83291f110e0Safresh1    =head1 SYNOPSIS
83391f110e0Safresh1
83491f110e0Safresh1    sample [options] [file ...]
83591f110e0Safresh1
83691f110e0Safresh1     Options:
83791f110e0Safresh1       -help            brief help message
83891f110e0Safresh1       -man             full documentation
83991f110e0Safresh1
84091f110e0Safresh1    =head1 OPTIONS
84191f110e0Safresh1
842b8851fccSafresh1    =over 4
84391f110e0Safresh1
84491f110e0Safresh1    =item B<-help>
84591f110e0Safresh1
84691f110e0Safresh1    Print a brief help message and exits.
84791f110e0Safresh1
84891f110e0Safresh1    =item B<-man>
84991f110e0Safresh1
85091f110e0Safresh1    Prints the manual page and exits.
85191f110e0Safresh1
85291f110e0Safresh1    =back
85391f110e0Safresh1
85491f110e0Safresh1    =head1 DESCRIPTION
85591f110e0Safresh1
85691f110e0Safresh1    B<This program> will read the given input file(s) and do something
85791f110e0Safresh1    useful with the contents thereof.
85891f110e0Safresh1
85991f110e0Safresh1    =cut
86091f110e0Safresh1
86191f110e0Safresh1=head1 CAVEATS
86291f110e0Safresh1
86391f110e0Safresh1By default, B<pod2usage()> will use C<$0> as the path to the pod input
86491f110e0Safresh1file.  Unfortunately, not all systems on which Perl runs will set C<$0>
865eac174f2Safresh1properly (although if C<$0> is not found, B<pod2usage()> will search
86691f110e0Safresh1C<$ENV{PATH}> or else the list specified by the C<-pathlist> option).
86791f110e0Safresh1If this is the case for your system, you may need to explicitly specify
86891f110e0Safresh1the path to the pod docs for the invoking script using something
86991f110e0Safresh1similar to the following:
87091f110e0Safresh1
87191f110e0Safresh1    pod2usage(-exitval => 2, -input => "/path/to/your/pod/docs");
87291f110e0Safresh1
87391f110e0Safresh1In the pathological case that a script is called via a relative path
87491f110e0Safresh1I<and> the script itself changes the current working directory
87591f110e0Safresh1(see L<perlfunc/chdir>) I<before> calling pod2usage, Pod::Usage will
87691f110e0Safresh1fail even on robust platforms. Don't do that. Or use L<FindBin> to locate
87791f110e0Safresh1the script:
87891f110e0Safresh1
87991f110e0Safresh1    use FindBin;
88091f110e0Safresh1    pod2usage(-input => $FindBin::Bin . "/" . $FindBin::Script);
88191f110e0Safresh1
882eac174f2Safresh1=head1 SUPPORT
883eac174f2Safresh1
884eac174f2Safresh1This module is managed in a GitHub repository,
885eac174f2Safresh1L<https://github.com/Dual-Life/Pod-Usage> Feel free to fork and contribute, or
886eac174f2Safresh1to clone and send patches!
887eac174f2Safresh1
888eac174f2Safresh1Please use L<https://github.com/Dual-Life/Pod-Usage/issues/new> to file a bug
889eac174f2Safresh1report.  The previous ticketing system,
890eac174f2Safresh1L<https://rt.cpan.org/Dist/Display.html?Queue=Pod-Usage>, is deprecated for
891eac174f2Safresh1this package.
892eac174f2Safresh1
893eac174f2Safresh1More general questions or discussion about POD should be sent to the
894eac174f2Safresh1C<pod-people@perl.org> mail list. Send an empty email to
895eac174f2Safresh1C<pod-people-subscribe@perl.org> to subscribe.
896eac174f2Safresh1
89791f110e0Safresh1=head1 AUTHOR
89891f110e0Safresh1
89991f110e0Safresh1Marek Rouchal E<lt>marekr@cpan.orgE<gt>
90091f110e0Safresh1
901eac174f2Safresh1Nicolas R E<lt>nicolas@atoomic.orgE<gt>
902eac174f2Safresh1
90391f110e0Safresh1Brad Appleton E<lt>bradapp@enteract.comE<gt>
90491f110e0Safresh1
90591f110e0Safresh1Based on code for B<Pod::Text::pod2text()> written by
90691f110e0Safresh1Tom Christiansen E<lt>tchrist@mox.perl.comE<gt>
90791f110e0Safresh1
908eac174f2Safresh1=head1 LICENSE
909eac174f2Safresh1
910eac174f2Safresh1Pod::Usage (the distribution) is licensed under the same terms as Perl.
911eac174f2Safresh1
91291f110e0Safresh1=head1 ACKNOWLEDGMENTS
91391f110e0Safresh1
914eac174f2Safresh1Nicolas R (ATOOMIC) for setting up the Github repo and modernizing this
915eac174f2Safresh1package.
916eac174f2Safresh1
9176fb12b70Safresh1rjbs for refactoring Pod::Usage to not use Pod::Parser any more.
9186fb12b70Safresh1
919eac174f2Safresh1Steven McDougall E<lt>swmcd@world.std.comE<gt> for his help and patience with
920eac174f2Safresh1re-writing this manpage.
92191f110e0Safresh1
92291f110e0Safresh1=head1 SEE ALSO
92391f110e0Safresh1
9246fb12b70Safresh1B<Pod::Usage> is now a standalone distribution, depending on
9256fb12b70Safresh1L<Pod::Text> which in turn depends on L<Pod::Simple>.
92691f110e0Safresh1
9276fb12b70Safresh1L<Pod::Perldoc>, L<Getopt::Long>, L<Pod::Find>, L<FindBin>,
9286fb12b70Safresh1L<Pod::Text>, L<Pod::Text::Termcap>, L<Pod::Simple>
92991f110e0Safresh1
93091f110e0Safresh1=cut
93191f110e0Safresh1
932