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