1 #############################################################################
2 # Pod/Usage.pm -- print usage messages for the running script.
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
8 #############################################################################
13 use vars qw($VERSION @ISA @EXPORT);
14 $VERSION = '1.36'; ## Current version of this package
15 require 5.005; ## requires this Perl version or later
19 Pod::Usage, pod2usage() - print a usage message from embedded pod documentation
25 my $message_text = "This text precedes the usage message.";
26 my $exit_status = 2; ## The exit status to use
27 my $verbose_level = 0; ## The verbose level to use
28 my $filehandle = \*STDERR; ## The filehandle to write to
30 pod2usage($message_text);
32 pod2usage($exit_status);
34 pod2usage( { -message => $message_text ,
35 -exitval => $exit_status ,
36 -verbose => $verbose_level,
37 -output => $filehandle } );
39 pod2usage( -msg => $message_text ,
40 -exitval => $exit_status ,
41 -verbose => $verbose_level,
42 -output => $filehandle );
44 pod2usage( -verbose => 2,
49 B<pod2usage> should be given either a single argument, or a list of
50 arguments corresponding to an associative array (a "hash"). When a single
51 argument is given, it should correspond to exactly one of the following:
57 A string containing the text of a message to print I<before> printing
62 A numeric value corresponding to the desired exit status
70 If more than one argument is given then the entire argument list is
71 assumed to be a hash. If a hash is supplied (either as a reference or
72 as a list) it should contain one or more elements with the following
81 The text of a message to print immediately prior to printing the
82 program's usage message.
86 The desired exit status to pass to the B<exit()> function.
87 This should be an integer, or else the string "NOEXIT" to
88 indicate that control should simply be returned without
89 terminating the invoking process.
93 The desired level of "verboseness" to use when printing the usage
94 message. If the corresponding value is 0, then only the "SYNOPSIS"
95 section of the pod documentation is printed. If the corresponding value
96 is 1, then the "SYNOPSIS" section, along with any section entitled
97 "OPTIONS", "ARGUMENTS", or "OPTIONS AND ARGUMENTS" is printed. If the
98 corresponding value is 2 or more then the entire manpage is printed.
100 The special verbosity level 99 requires to also specify the -sections
101 parameter; then these sections are extracted (see L<Pod::Select>)
106 A string representing a selection list for sections to be printed
107 when -verbose is set to 99, e.g. C<"NAME|SYNOPSIS|DESCRIPTION|VERSION">.
109 Alternatively, an array reference of section specifications can be used:
111 pod2usage(-verbose => 99,
112 -sections => [ qw(fred fred/subsection) ] );
116 A reference to a filehandle, or the pathname of a file to which the
117 usage message should be written. The default is C<\*STDERR> unless the
118 exit value is less than 2 (in which case the default is C<\*STDOUT>).
122 A reference to a filehandle, or the pathname of a file from which the
123 invoking script's pod documentation should be read. It defaults to the
124 file indicated by C<$0> (C<$PROGRAM_NAME> for users of F<English.pm>).
126 If you are calling B<pod2usage()> from a module and want to display
127 that module's POD, you can use this:
129 use Pod::Find qw(pod_where);
130 pod2usage( -input => pod_where({-inc => 1}, __PACKAGE__) );
134 A list of directory paths. If the input file does not exist, then it
135 will be searched for in the given directory list (in the order the
136 directories appear in the list). It defaults to the list of directories
137 implied by C<$ENV{PATH}>. The list may be specified either by a reference
138 to an array, or by a string of directory paths which use the same path
139 separator as C<$ENV{PATH}> on your system (e.g., C<:> for Unix, C<;> for
144 By default, Pod::Usage will call L<perldoc> when -verbose >= 2 is
145 specified. This does not work well e.g. if the script was packed
146 with L<PAR>. The -noperldoc option suppresses the external call to
147 L<perldoc> and uses the simple text formatter (L<Pod::Text>) to
154 B<pod2usage> will print a usage message for the invoking script (using
155 its embedded pod documentation) and then exit the script with the
156 desired exit status. The usage message printed may have any one of three
157 levels of "verboseness": If the verbose level is 0, then only a synopsis
158 is printed. If the verbose level is 1, then the synopsis is printed
159 along with a description (if present) of the command line options and
160 arguments. If the verbose level is 2, then the entire manual page is
163 Unless they are explicitly specified, the default values for the exit
164 status, verbose level, and output stream to use are determined as
171 If neither the exit status nor the verbose level is specified, then the
172 default is to use an exit status of 2 with a verbose level of 0.
176 If an exit status I<is> specified but the verbose level is I<not>, then the
177 verbose level will default to 1 if the exit status is less than 2 and
178 will default to 0 otherwise.
182 If an exit status is I<not> specified but verbose level I<is> given, then
183 the exit status will default to 2 if the verbose level is 0 and will
184 default to 1 otherwise.
188 If the exit status used is less than 2, then output is printed on
189 C<STDOUT>. Otherwise output is printed on C<STDERR>.
193 Although the above may seem a bit confusing at first, it generally does
194 "the right thing" in most situations. This determination of the default
195 values to use is based upon the following typical Unix conventions:
201 An exit status of 0 implies "success". For example, B<diff(1)> exits
202 with a status of 0 if the two files have the same contents.
206 An exit status of 1 implies possibly abnormal, but non-defective, program
207 termination. For example, B<grep(1)> exits with a status of 1 if
208 it did I<not> find a matching line for the given regular expression.
212 An exit status of 2 or more implies a fatal error. For example, B<ls(1)>
213 exits with a status of 2 if you specify an illegal (unknown) option on
218 Usage messages issued as a result of bad command-line syntax should go
219 to C<STDERR>. However, usage messages issued due to an explicit request
220 to print usage (like specifying B<-help> on the command line) should go
221 to C<STDOUT>, just in case the user wants to pipe the output to a pager
222 (such as B<more(1)>).
226 If program usage has been explicitly requested by the user, it is often
227 desirable to exit with a status of 1 (as opposed to 0) after issuing
228 the user-requested usage message. It is also desirable to give a
229 more verbose description of program usage in this case.
233 B<pod2usage> doesn't force the above conventions upon you, but it will
234 use them by default if you don't expressly tell it to do otherwise. The
235 ability of B<pod2usage()> to accept a single number or a string makes it
236 convenient to use as an innocent looking error message handling function:
242 GetOptions("help", "man", "flag1") || pod2usage(2);
243 pod2usage(1) if ($opt_help);
244 pod2usage(-verbose => 2) if ($opt_man);
246 ## Check for too many filenames
247 pod2usage("$0: Too many files given.\n") if (@ARGV > 1);
249 Some user's however may feel that the above "economy of expression" is
250 not particularly readable nor consistent and may instead choose to do
251 something more like the following:
257 GetOptions("help", "man", "flag1") || pod2usage(-verbose => 0);
258 pod2usage(-verbose => 1) if ($opt_help);
259 pod2usage(-verbose => 2) if ($opt_man);
261 ## Check for too many filenames
262 pod2usage(-verbose => 2, -message => "$0: Too many files given.\n")
265 As with all things in Perl, I<there's more than one way to do it>, and
266 B<pod2usage()> adheres to this philosophy. If you are interested in
267 seeing a number of different ways to invoke B<pod2usage> (although by no
268 means exhaustive), please refer to L<"EXAMPLES">.
272 Each of the following invocations of C<pod2usage()> will print just the
273 "SYNOPSIS" section to C<STDERR> and will exit with a status of 2:
279 pod2usage(-verbose => 0);
281 pod2usage(-exitval => 2);
283 pod2usage({-exitval => 2, -output => \*STDERR});
285 pod2usage({-verbose => 0, -output => \*STDERR});
287 pod2usage(-exitval => 2, -verbose => 0);
289 pod2usage(-exitval => 2, -verbose => 0, -output => \*STDERR);
291 Each of the following invocations of C<pod2usage()> will print a message
292 of "Syntax error." (followed by a newline) to C<STDERR>, immediately
293 followed by just the "SYNOPSIS" section (also printed to C<STDERR>) and
294 will exit with a status of 2:
296 pod2usage("Syntax error.");
298 pod2usage(-message => "Syntax error.", -verbose => 0);
300 pod2usage(-msg => "Syntax error.", -exitval => 2);
302 pod2usage({-msg => "Syntax error.", -exitval => 2, -output => \*STDERR});
304 pod2usage({-msg => "Syntax error.", -verbose => 0, -output => \*STDERR});
306 pod2usage(-msg => "Syntax error.", -exitval => 2, -verbose => 0);
308 pod2usage(-message => "Syntax error.",
311 -output => \*STDERR);
313 Each of the following invocations of C<pod2usage()> will print the
314 "SYNOPSIS" section and any "OPTIONS" and/or "ARGUMENTS" sections to
315 C<STDOUT> and will exit with a status of 1:
319 pod2usage(-verbose => 1);
321 pod2usage(-exitval => 1);
323 pod2usage({-exitval => 1, -output => \*STDOUT});
325 pod2usage({-verbose => 1, -output => \*STDOUT});
327 pod2usage(-exitval => 1, -verbose => 1);
329 pod2usage(-exitval => 1, -verbose => 1, -output => \*STDOUT});
331 Each of the following invocations of C<pod2usage()> will print the
332 entire manual page to C<STDOUT> and will exit with a status of 1:
334 pod2usage(-verbose => 2);
336 pod2usage({-verbose => 2, -output => \*STDOUT});
338 pod2usage(-exitval => 1, -verbose => 2);
340 pod2usage({-exitval => 1, -verbose => 2, -output => \*STDOUT});
342 =head2 Recommended Use
344 Most scripts should print some type of usage message to C<STDERR> when a
345 command line syntax error is detected. They should also provide an
346 option (usually C<-H> or C<-help>) to print a (possibly more verbose)
347 usage message to C<STDOUT>. Some scripts may even wish to go so far as to
348 provide a means of printing their complete documentation to C<STDOUT>
349 (perhaps by allowing a C<-man> option). The following complete example
350 uses B<Pod::Usage> in combination with B<Getopt::Long> to do all of these
358 ## Parse options and print usage if there is a syntax error,
359 ## or if usage was explicitly requested.
360 GetOptions('help|?' => \$help, man => \$man) or pod2usage(2);
361 pod2usage(1) if $help;
362 pod2usage(-verbose => 2) if $man;
364 ## If no arguments were given, then allow STDIN to be used only
365 ## if it's not connected to a terminal (otherwise print usage)
366 pod2usage("$0: No files given.") if ((@ARGV == 0) && (-t STDIN));
371 sample - Using GetOpt::Long and Pod::Usage
375 sample [options] [file ...]
378 -help brief help message
379 -man full documentation
387 Print a brief help message and exits.
391 Prints the manual page and exits.
397 B<This program> will read the given input file(s) and do something
398 useful with the contents thereof.
404 By default, B<pod2usage()> will use C<$0> as the path to the pod input
405 file. Unfortunately, not all systems on which Perl runs will set C<$0>
406 properly (although if C<$0> isn't found, B<pod2usage()> will search
407 C<$ENV{PATH}> or else the list specified by the C<-pathlist> option).
408 If this is the case for your system, you may need to explicitly specify
409 the path to the pod docs for the invoking script using something
410 similar to the following:
412 pod2usage(-exitval => 2, -input => "/path/to/your/pod/docs");
414 In the pathological case that a script is called via a relative path
415 I<and> the script itself changes the current working directory
416 (see L<perlfunc/chdir>) I<before> calling pod2usage, Pod::Usage will
417 fail even on robust platforms. Don't do that.
421 Please report bugs using L<http://rt.cpan.org>.
423 Marek Rouchal E<lt>marekr@cpan.orgE<gt>
425 Brad Appleton E<lt>bradapp@enteract.comE<gt>
427 Based on code for B<Pod::Text::pod2text()> written by
428 Tom Christiansen E<lt>tchrist@mox.perl.comE<gt>
430 =head1 ACKNOWLEDGMENTS
432 Steven McDougall E<lt>swmcd@world.std.comE<gt> for his help and patience
433 with re-writing this manpage.
437 L<Pod::Parser>, L<Getopt::Long>, L<Pod::Find>
441 #############################################################################
449 @EXPORT = qw(&pod2usage);
451 if ( $] >= 5.005_58 ) {
453 @ISA = qw( Pod::Text );
456 require Pod::PlainText;
457 @ISA = qw( Pod::PlainText );
463 ##---------------------------------------------------------------------------
465 ##---------------------------------
466 ## Function definitions begin here
467 ##---------------------------------
474 ## Too many arguments - assume that this is a hash and
475 ## the user forgot to pass a reference to it.
478 elsif (!defined $_) {
482 ## User passed a ref to a hash
483 %opts = %{$_} if (ref($_) eq 'HASH');
485 elsif (/^[-+]?\d+$/) {
486 ## User passed in the exit value to use
487 $opts{'-exitval'} = $_;
490 ## User passed in a message to print before issuing usage.
491 $_ and $opts{'-message'} = $_;
494 ## Need this for backward compatibility since we formerly used
495 ## options that were all uppercase words rather than ones that
496 ## looked like Unix command-line options.
497 ## to be uppercase keywords)
499 my ($key, $val) = ($_, $opts{$_});
500 $key =~ s/^(?=\w)/-/;
501 $key =~ /^-msg/i and $key = '-message';
502 $key =~ /^-exit/i and $key = '-exitval';
506 ## Now determine default -exitval and -verbose values to use
507 if ((! defined $opts{'-exitval'}) && (! defined $opts{'-verbose'})) {
508 $opts{'-exitval'} = 2;
509 $opts{'-verbose'} = 0;
511 elsif (! defined $opts{'-exitval'}) {
512 $opts{'-exitval'} = ($opts{'-verbose'} > 0) ? 1 : 2;
514 elsif (! defined $opts{'-verbose'}) {
515 $opts{'-verbose'} = (lc($opts{'-exitval'}) eq 'noexit' ||
516 $opts{'-exitval'} < 2);
519 ## Default the output file
520 $opts{'-output'} = (lc($opts{'-exitval'}) eq 'noexit' ||
521 $opts{'-exitval'} < 2) ? \*STDOUT : \*STDERR
522 unless (defined $opts{'-output'});
523 ## Default the input file
524 $opts{'-input'} = $0 unless (defined $opts{'-input'});
526 ## Look up input file in path if it doesnt exist.
527 unless ((ref $opts{'-input'}) || (-e $opts{'-input'})) {
528 my $basename = $opts{'-input'};
529 my $pathsep = ($^O =~ /^(?:dos|os2|MSWin32)$/i) ? ';'
530 : (($^O eq 'MacOS' || $^O eq 'VMS') ? ',' : ':');
531 my $pathspec = $opts{'-pathlist'} || $ENV{PATH} || $ENV{PERL5LIB};
533 my @paths = (ref $pathspec) ? @$pathspec : split($pathsep, $pathspec);
534 for my $dirname (@paths) {
535 $_ = File::Spec->catfile($dirname, $basename) if length;
536 last if (-e $_) && ($opts{'-input'} = $_);
540 ## Now create a pod reader and constrain it to the desired sections.
541 my $parser = new Pod::Usage(USAGE_OPTIONS => \%opts);
542 if ($opts{'-verbose'} == 0) {
543 $parser->select('(?:SYNOPSIS|USAGE)\s*');
545 elsif ($opts{'-verbose'} == 1) {
546 my $opt_re = '(?i)' .
547 '(?:OPTIONS|ARGUMENTS)' .
548 '(?:\s*(?:AND|\/)\s*(?:OPTIONS|ARGUMENTS))?';
549 $parser->select( '(?:SYNOPSIS|USAGE)\s*', $opt_re, "DESCRIPTION/$opt_re" );
551 elsif ($opts{'-verbose'} >= 2 && $opts{'-verbose'} != 99) {
552 $parser->select('.*');
554 elsif ($opts{'-verbose'} == 99) {
555 my $sections = $opts{'-sections'};
556 $parser->select( (ref $sections) ? @$sections : $sections );
557 $opts{'-verbose'} = 1;
560 ## Now translate the pod document and then exit with the desired status
561 if ( !$opts{'-noperldoc'}
562 and $opts{'-verbose'} >= 2
563 and !ref($opts{'-input'})
564 and $opts{'-output'} == \*STDOUT )
566 ## spit out the entire PODs. Might as well invoke perldoc
567 my $progpath = File::Spec->catfile($Config{scriptdir}, 'perldoc');
568 print { $opts{'-output'} } ($opts{'-message'}, "\n") if($opts{'-message'});
569 if(defined $opts{-input} && $opts{-input} =~ /^\s*(\S.*?)\s*$/) {
570 # the perldocs back to 5.005 should all have -F
571 # without -F there are warnings in -T scripts
572 system($progpath, '-F', $1);
574 # RT16091: fall back to more if perldoc failed
575 system(($Config{pager} || $ENV{PAGER} || '/bin/more'), $1);
578 croak "Unspecified input file or insecure argument.\n";
582 $parser->parse_from_file($opts{'-input'}, $opts{'-output'});
585 exit($opts{'-exitval'}) unless (lc($opts{'-exitval'}) eq 'noexit');
588 ##---------------------------------------------------------------------------
590 ##-------------------------------
591 ## Method definitions begin here
592 ##-------------------------------
596 my $class = ref($this) || $this;
598 my $self = {%params};
600 if ($self->can('initialize')) {
603 $self = $self->SUPER::new();
604 %$self = (%$self, %params);
610 my ($self, @sections) = @_;
611 if ($ISA[0]->can('select')) {
612 $self->SUPER::select(@sections);
614 # we're using Pod::Simple - need to mimic the behavior of Pod::Select
615 my $add = ($sections[0] eq '+') ? shift(@sections) : '';
616 ## Reset the set of sections to use
618 delete $self->{USAGE_SELECT} unless ($add);
621 $self->{USAGE_SELECT} = []
622 unless ($add && $self->{USAGE_SELECT});
623 my $sref = $self->{USAGE_SELECT};
625 for my $spec (@sections) {
626 my $cs = Pod::Select::_compile_section_spec($spec);
628 ## Store them in our sections array
631 carp qq{Ignoring section spec "$spec"!\n};
637 # Override Pod::Text->seq_i to return just "arg", not "*arg*".
638 sub seq_i { return $_[1] }
640 # This overrides the Pod::Text method to do something very akin to what
641 # Pod::Select did as well as the work done below by preprocess_paragraph.
642 # Note that the below is very, very specific to Pod::Text.
643 sub _handle_element_end {
644 my ($self, $element) = @_;
645 if ($element eq 'head1') {
646 $self->{USAGE_HEADINGS} = [ $$self{PENDING}[-1][1] ];
647 if ($self->{USAGE_OPTIONS}->{-verbose} < 2) {
648 $$self{PENDING}[-1][1] =~ s/^\s*SYNOPSIS\s*$/USAGE/;
650 } elsif ($element =~ /^head(\d+)$/ && $1) { # avoid 0
652 $self->{USAGE_HEADINGS} = [] unless($self->{USAGE_HEADINGS});
653 $self->{USAGE_HEADINGS}->[$idx] = $$self{PENDING}[-1][1];
655 if ($element =~ /^head\d+$/) {
656 $$self{USAGE_SKIPPING} = 1;
657 if (!$$self{USAGE_SELECT} || !@{ $$self{USAGE_SELECT} }) {
658 $$self{USAGE_SKIPPING} = 0;
660 my @headings = @{$$self{USAGE_HEADINGS}};
661 for my $section_spec ( @{$$self{USAGE_SELECT}} ) {
663 for (my $i = 0; $i < $Pod::Select::MAX_HEADING_LEVEL; ++$i) {
664 $headings[$i] = '' unless defined $headings[$i];
665 my $regex = $section_spec->[$i];
666 my $negated = ($regex =~ s/^\!//);
667 $match &= ($negated ? ($headings[$i] !~ /${regex}/)
668 : ($headings[$i] =~ /${regex}/));
669 last unless ($match);
670 } # end heading levels
672 $$self{USAGE_SKIPPING} = 0;
678 # Try to do some lowercasing instead of all-caps in headings, and use
679 # a colon to end all headings.
680 if($self->{USAGE_OPTIONS}->{-verbose} < 2) {
681 local $_ = $$self{PENDING}[-1][1];
682 s{([A-Z])([A-Z]+)}{((length($2) > 2) ? $1 : lc($1)) . lc($2)}ge;
683 s/\s*$/:/ unless (/:\s*$/);
685 $$self{PENDING}[-1][1] = $_;
688 if ($$self{USAGE_SKIPPING} && $element !~ m/^over-/) {
689 pop @{ $$self{PENDING} };
691 $self->SUPER::_handle_element_end($element);
695 # required for Pod::Simple API
698 $self->SUPER::start_document();
699 my $msg = $self->{USAGE_OPTIONS}->{-message} or return 1;
700 my $out_fh = $self->output_fh();
701 print $out_fh "$msg\n";
704 # required for old Pod::Parser API
707 $self->SUPER::begin_pod(); ## Have to call superclass
708 my $msg = $self->{USAGE_OPTIONS}->{-message} or return 1;
709 my $out_fh = $self->output_handle();
710 print $out_fh "$msg\n";
713 sub preprocess_paragraph {
717 ## See if this is a heading and we arent printing the entire manpage.
718 if (($self->{USAGE_OPTIONS}->{-verbose} < 2) && /^=head/) {
719 ## Change the title of the SYNOPSIS section to USAGE
720 s/^=head1\s+SYNOPSIS\s*$/=head1 USAGE/;
721 ## Try to do some lowercasing instead of all-caps in headings
722 s{([A-Z])([A-Z]+)}{((length($2) > 2) ? $1 : lc($1)) . lc($2)}ge;
723 ## Use a colon to end all headings
724 s/\s*$/:/ unless (/:\s*$/);
727 return $self->SUPER::preprocess_paragraph($_);
730 1; # keep require happy