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