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