This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
PodParser is now Pod-Parser on CPAN
[perl5.git] / lib / Pod / Usage.pm
CommitLineData
360aca43
GS
1#############################################################################
2# Pod/Usage.pm -- print usage messages for the running script.
3#
66aff6dd 4# Copyright (C) 1996-2000 by Bradford Appleton. All rights reserved.
360aca43
GS
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;
11
12use vars qw($VERSION);
d5c61f7c 13$VERSION = 1.30; ## Current version of this package
828c4421 14require 5.005; ## requires this Perl version or later
360aca43
GS
15
16=head1 NAME
17
18Pod::Usage, pod2usage() - print a usage message from embedded pod documentation
19
20=head1 SYNOPSIS
21
22 use Pod::Usage
23
24 my $message_text = "This text precedes the usage message.";
25 my $exit_status = 2; ## The exit status to use
26 my $verbose_level = 0; ## The verbose level to use
27 my $filehandle = \*STDERR; ## The filehandle to write to
28
29 pod2usage($message_text);
30
31 pod2usage($exit_status);
32
33 pod2usage( { -message => $message_text ,
34 -exitval => $exit_status ,
35 -verbose => $verbose_level,
36 -output => $filehandle } );
37
38 pod2usage( -msg => $message_text ,
39 -exitval => $exit_status ,
40 -verbose => $verbose_level,
41 -output => $filehandle );
42
43=head1 ARGUMENTS
44
45B<pod2usage> should be given either a single argument, or a list of
46arguments corresponding to an associative array (a "hash"). When a single
47argument is given, it should correspond to exactly one of the following:
48
92e3d63a 49=over 4
360aca43
GS
50
51=item *
52
53A string containing the text of a message to print I<before> printing
54the usage message
55
56=item *
57
58A numeric value corresponding to the desired exit status
59
60=item *
61
62A reference to a hash
63
64=back
65
66If more than one argument is given then the entire argument list is
67assumed to be a hash. If a hash is supplied (either as a reference or
68as a list) it should contain one or more elements with the following
69keys:
70
92e3d63a 71=over 4
360aca43
GS
72
73=item C<-message>
74
75=item C<-msg>
76
77The text of a message to print immediately prior to printing the
78program's usage message.
79
80=item C<-exitval>
81
82The desired exit status to pass to the B<exit()> function.
39a52d2c
JH
83This should be an integer, or else the string "NOEXIT" to
84indicate that control should simply be returned without
85terminating the invoking process.
360aca43
GS
86
87=item C<-verbose>
88
89The desired level of "verboseness" to use when printing the usage
90message. If the corresponding value is 0, then only the "SYNOPSIS"
91section of the pod documentation is printed. If the corresponding value
92is 1, then the "SYNOPSIS" section, along with any section entitled
93"OPTIONS", "ARGUMENTS", or "OPTIONS AND ARGUMENTS" is printed. If the
94corresponding value is 2 or more then the entire manpage is printed.
95
d5c61f7c
RGS
96The special verbosity level 99 requires to also specify the -section
97parameter; then these sections are extracted and printed.
98
99=item C<-section>
100
101A string representing a selection list for sections to be printed
102when -verbose is set to 99, e.g. C<"NAME|SYNOPSIS|DESCRIPTION|VERSION">.
103
360aca43
GS
104=item C<-output>
105
106A reference to a filehandle, or the pathname of a file to which the
107usage message should be written. The default is C<\*STDERR> unless the
108exit value is less than 2 (in which case the default is C<\*STDOUT>).
109
110=item C<-input>
111
112A reference to a filehandle, or the pathname of a file from which the
113invoking script's pod documentation should be read. It defaults to the
114file indicated by C<$0> (C<$PROGRAM_NAME> for users of F<English.pm>).
115
116=item C<-pathlist>
117
118A list of directory paths. If the input file does not exist, then it
119will be searched for in the given directory list (in the order the
120directories appear in the list). It defaults to the list of directories
121implied by C<$ENV{PATH}>. The list may be specified either by a reference
122to an array, or by a string of directory paths which use the same path
123separator as C<$ENV{PATH}> on your system (e.g., C<:> for Unix, C<;> for
124MSWin32 and DOS).
125
126=back
127
128=head1 DESCRIPTION
129
130B<pod2usage> will print a usage message for the invoking script (using
131its embedded pod documentation) and then exit the script with the
132desired exit status. The usage message printed may have any one of three
133levels of "verboseness": If the verbose level is 0, then only a synopsis
134is printed. If the verbose level is 1, then the synopsis is printed
135along with a description (if present) of the command line options and
136arguments. If the verbose level is 2, then the entire manual page is
137printed.
138
139Unless they are explicitly specified, the default values for the exit
140status, verbose level, and output stream to use are determined as
141follows:
142
92e3d63a 143=over 4
360aca43
GS
144
145=item *
146
147If neither the exit status nor the verbose level is specified, then the
148default is to use an exit status of 2 with a verbose level of 0.
149
150=item *
151
152If an exit status I<is> specified but the verbose level is I<not>, then the
153verbose level will default to 1 if the exit status is less than 2 and
154will default to 0 otherwise.
155
156=item *
157
158If an exit status is I<not> specified but verbose level I<is> given, then
159the exit status will default to 2 if the verbose level is 0 and will
160default to 1 otherwise.
161
162=item *
163
164If the exit status used is less than 2, then output is printed on
165C<STDOUT>. Otherwise output is printed on C<STDERR>.
166
167=back
168
169Although the above may seem a bit confusing at first, it generally does
170"the right thing" in most situations. This determination of the default
171values to use is based upon the following typical Unix conventions:
172
92e3d63a 173=over 4
360aca43
GS
174
175=item *
176
177An exit status of 0 implies "success". For example, B<diff(1)> exits
178with a status of 0 if the two files have the same contents.
179
180=item *
181
182An exit status of 1 implies possibly abnormal, but non-defective, program
183termination. For example, B<grep(1)> exits with a status of 1 if
184it did I<not> find a matching line for the given regular expression.
185
186=item *
187
188An exit status of 2 or more implies a fatal error. For example, B<ls(1)>
189exits with a status of 2 if you specify an illegal (unknown) option on
190the command line.
191
192=item *
193
194Usage messages issued as a result of bad command-line syntax should go
195to C<STDERR>. However, usage messages issued due to an explicit request
196to print usage (like specifying B<-help> on the command line) should go
197to C<STDOUT>, just in case the user wants to pipe the output to a pager
198(such as B<more(1)>).
199
200=item *
201
202If program usage has been explicitly requested by the user, it is often
3c4b39be
PF
203desirable to exit with a status of 1 (as opposed to 0) after issuing
204the user-requested usage message. It is also desirable to give a
360aca43
GS
205more verbose description of program usage in this case.
206
207=back
208
209B<pod2usage> doesn't force the above conventions upon you, but it will
210use them by default if you don't expressly tell it to do otherwise. The
211ability of B<pod2usage()> to accept a single number or a string makes it
212convenient to use as an innocent looking error message handling function:
213
214 use Pod::Usage;
215 use Getopt::Long;
216
217 ## Parse options
218 GetOptions("help", "man", "flag1") || pod2usage(2);
219 pod2usage(1) if ($opt_help);
220 pod2usage(-verbose => 2) if ($opt_man);
221
222 ## Check for too many filenames
223 pod2usage("$0: Too many files given.\n") if (@ARGV > 1);
224
92e3d63a 225Some user's however may feel that the above "economy of expression" is
360aca43
GS
226not particularly readable nor consistent and may instead choose to do
227something more like the following:
228
229 use Pod::Usage;
230 use Getopt::Long;
231
232 ## Parse options
233 GetOptions("help", "man", "flag1") || pod2usage(-verbose => 0);
234 pod2usage(-verbose => 1) if ($opt_help);
235 pod2usage(-verbose => 2) if ($opt_man);
236
237 ## Check for too many filenames
238 pod2usage(-verbose => 2, -message => "$0: Too many files given.\n")
239 if (@ARGV > 1);
240
241As with all things in Perl, I<there's more than one way to do it>, and
242B<pod2usage()> adheres to this philosophy. If you are interested in
243seeing a number of different ways to invoke B<pod2usage> (although by no
244means exhaustive), please refer to L<"EXAMPLES">.
245
246=head1 EXAMPLES
247
248Each of the following invocations of C<pod2usage()> will print just the
249"SYNOPSIS" section to C<STDERR> and will exit with a status of 2:
250
251 pod2usage();
252
253 pod2usage(2);
254
255 pod2usage(-verbose => 0);
256
257 pod2usage(-exitval => 2);
258
259 pod2usage({-exitval => 2, -output => \*STDERR});
260
261 pod2usage({-verbose => 0, -output => \*STDERR});
262
263 pod2usage(-exitval => 2, -verbose => 0);
264
265 pod2usage(-exitval => 2, -verbose => 0, -output => \*STDERR);
266
267Each of the following invocations of C<pod2usage()> will print a message
268of "Syntax error." (followed by a newline) to C<STDERR>, immediately
269followed by just the "SYNOPSIS" section (also printed to C<STDERR>) and
270will exit with a status of 2:
271
272 pod2usage("Syntax error.");
273
274 pod2usage(-message => "Syntax error.", -verbose => 0);
275
276 pod2usage(-msg => "Syntax error.", -exitval => 2);
277
278 pod2usage({-msg => "Syntax error.", -exitval => 2, -output => \*STDERR});
279
280 pod2usage({-msg => "Syntax error.", -verbose => 0, -output => \*STDERR});
281
282 pod2usage(-msg => "Syntax error.", -exitval => 2, -verbose => 0);
283
284 pod2usage(-message => "Syntax error.",
285 -exitval => 2,
286 -verbose => 0,
287 -output => \*STDERR);
288
289Each of the following invocations of C<pod2usage()> will print the
290"SYNOPSIS" section and any "OPTIONS" and/or "ARGUMENTS" sections to
291C<STDOUT> and will exit with a status of 1:
292
293 pod2usage(1);
294
295 pod2usage(-verbose => 1);
296
297 pod2usage(-exitval => 1);
298
299 pod2usage({-exitval => 1, -output => \*STDOUT});
300
301 pod2usage({-verbose => 1, -output => \*STDOUT});
302
303 pod2usage(-exitval => 1, -verbose => 1);
304
305 pod2usage(-exitval => 1, -verbose => 1, -output => \*STDOUT});
306
307Each of the following invocations of C<pod2usage()> will print the
308entire manual page to C<STDOUT> and will exit with a status of 1:
309
310 pod2usage(-verbose => 2);
311
312 pod2usage({-verbose => 2, -output => \*STDOUT});
313
314 pod2usage(-exitval => 1, -verbose => 2);
315
316 pod2usage({-exitval => 1, -verbose => 2, -output => \*STDOUT});
317
318=head2 Recommended Use
319
320Most scripts should print some type of usage message to C<STDERR> when a
321command line syntax error is detected. They should also provide an
322option (usually C<-H> or C<-help>) to print a (possibly more verbose)
323usage message to C<STDOUT>. Some scripts may even wish to go so far as to
324provide a means of printing their complete documentation to C<STDOUT>
f48e6a7e
GS
325(perhaps by allowing a C<-man> option). The following complete example
326uses B<Pod::Usage> in combination with B<Getopt::Long> to do all of these
360aca43
GS
327things:
328
329 use Getopt::Long;
330 use Pod::Usage;
331
f48e6a7e
GS
332 my $man = 0;
333 my $help = 0;
360aca43
GS
334 ## Parse options and print usage if there is a syntax error,
335 ## or if usage was explicitly requested.
f48e6a7e
GS
336 GetOptions('help|?' => \$help, man => \$man) or pod2usage(2);
337 pod2usage(1) if $help;
338 pod2usage(-verbose => 2) if $man;
360aca43
GS
339
340 ## If no arguments were given, then allow STDIN to be used only
341 ## if it's not connected to a terminal (otherwise print usage)
342 pod2usage("$0: No files given.") if ((@ARGV == 0) && (-t STDIN));
f48e6a7e
GS
343 __END__
344
345 =head1 NAME
346
347 sample - Using GetOpt::Long and Pod::Usage
348
349 =head1 SYNOPSIS
350
351 sample [options] [file ...]
352
353 Options:
354 -help brief help message
355 -man full documentation
356
357 =head1 OPTIONS
358
359 =over 8
360
361 =item B<-help>
362
363 Print a brief help message and exits.
364
365 =item B<-man>
366
367 Prints the manual page and exits.
368
369 =back
370
371 =head1 DESCRIPTION
372
373 B<This program> will read the given input file(s) and do something
374 useful with the contents thereof.
375
376 =cut
360aca43
GS
377
378=head1 CAVEATS
379
380By default, B<pod2usage()> will use C<$0> as the path to the pod input
381file. Unfortunately, not all systems on which Perl runs will set C<$0>
382properly (although if C<$0> isn't found, B<pod2usage()> will search
383C<$ENV{PATH}> or else the list specified by the C<-pathlist> option).
384If this is the case for your system, you may need to explicitly specify
385the path to the pod docs for the invoking script using something
386similar to the following:
387
388 pod2usage(-exitval => 2, -input => "/path/to/your/pod/docs");
389
390=head1 AUTHOR
391
aaa799f9
NC
392Please report bugs using L<http://rt.cpan.org>.
393
360aca43
GS
394Brad Appleton E<lt>bradapp@enteract.comE<gt>
395
396Based on code for B<Pod::Text::pod2text()> written by
397Tom Christiansen E<lt>tchrist@mox.perl.comE<gt>
398
399=head1 ACKNOWLEDGEMENTS
400
401Steven McDougall E<lt>swmcd@world.std.comE<gt> for his help and patience
402with re-writing this manpage.
403
404=cut
405
406#############################################################################
407
408use strict;
409#use diagnostics;
410use Carp;
39a52d2c 411use Config;
360aca43 412use Exporter;
360aca43
GS
413use File::Spec;
414
415use vars qw(@ISA @EXPORT);
360aca43 416@EXPORT = qw(&pod2usage);
664bb207
GS
417BEGIN {
418 if ( $] >= 5.005_58 ) {
419 require Pod::Text;
420 @ISA = qw( Pod::Text );
421 }
422 else {
423 require Pod::PlainText;
424 @ISA = qw( Pod::PlainText );
425 }
426}
427
360aca43
GS
428
429##---------------------------------------------------------------------------
430
431##---------------------------------
432## Function definitions begin here
433##---------------------------------
434
435sub pod2usage {
436 local($_) = shift || "";
437 my %opts;
438 ## Collect arguments
439 if (@_ > 0) {
440 ## Too many arguments - assume that this is a hash and
441 ## the user forgot to pass a reference to it.
442 %opts = ($_, @_);
443 }
444 elsif (ref $_) {
445 ## User passed a ref to a hash
446 %opts = %{$_} if (ref($_) eq 'HASH');
447 }
e9fdc7d2 448 elsif (/^[-+]?\d+$/) {
360aca43
GS
449 ## User passed in the exit value to use
450 $opts{"-exitval"} = $_;
451 }
452 else {
453 ## User passed in a message to print before issuing usage.
454 $_ and $opts{"-message"} = $_;
455 }
456
457 ## Need this for backward compatibility since we formerly used
458 ## options that were all uppercase words rather than ones that
459 ## looked like Unix command-line options.
460 ## to be uppercase keywords)
461 %opts = map {
462 my $val = $opts{$_};
463 s/^(?=\w)/-/;
464 /^-msg/i and $_ = '-message';
465 /^-exit/i and $_ = '-exitval';
466 lc($_) => $val;
467 } (keys %opts);
468
469 ## Now determine default -exitval and -verbose values to use
470 if ((! defined $opts{"-exitval"}) && (! defined $opts{"-verbose"})) {
471 $opts{"-exitval"} = 2;
472 $opts{"-verbose"} = 0;
473 }
474 elsif (! defined $opts{"-exitval"}) {
475 $opts{"-exitval"} = ($opts{"-verbose"} > 0) ? 1 : 2;
476 }
477 elsif (! defined $opts{"-verbose"}) {
bc8c94cb
SP
478 $opts{"-verbose"} = (lc($opts{"-exitval"}) eq "noexit" ||
479 $opts{"-exitval"} < 2);
360aca43
GS
480 }
481
482 ## Default the output file
2dd58eb2
JH
483 $opts{"-output"} = (lc($opts{"-exitval"}) eq "noexit" ||
484 $opts{"-exitval"} < 2) ? \*STDOUT : \*STDERR
360aca43
GS
485 unless (defined $opts{"-output"});
486 ## Default the input file
487 $opts{"-input"} = $0 unless (defined $opts{"-input"});
488
489 ## Look up input file in path if it doesnt exist.
490 unless ((ref $opts{"-input"}) || (-e $opts{"-input"})) {
491 my ($dirname, $basename) = ('', $opts{"-input"});
492 my $pathsep = ($^O =~ /^(?:dos|os2|MSWin32)$/) ? ";"
0cb07b6b 493 : (($^O eq 'MacOS' || $^O eq 'VMS') ? ',' : ":");
360aca43
GS
494 my $pathspec = $opts{"-pathlist"} || $ENV{PATH} || $ENV{PERL5LIB};
495
496 my @paths = (ref $pathspec) ? @$pathspec : split($pathsep, $pathspec);
497 for $dirname (@paths) {
498 $_ = File::Spec->catfile($dirname, $basename) if length;
499 last if (-e $_) && ($opts{"-input"} = $_);
500 }
501 }
502
503 ## Now create a pod reader and constrain it to the desired sections.
504 my $parser = new Pod::Usage(USAGE_OPTIONS => \%opts);
505 if ($opts{"-verbose"} == 0) {
506 $parser->select("SYNOPSIS");
507 }
508 elsif ($opts{"-verbose"} == 1) {
509 my $opt_re = '(?i)' .
510 '(?:OPTIONS|ARGUMENTS)' .
511 '(?:\s*(?:AND|\/)\s*(?:OPTIONS|ARGUMENTS))?';
512 $parser->select( 'SYNOPSIS', $opt_re, "DESCRIPTION/$opt_re" );
513 }
d5c61f7c
RGS
514 elsif ($opts{"-verbose"} == 99) {
515 $parser->select( $opts{"-sections"} );
516 $opts{"-verbose"} = 1;
517 }
360aca43
GS
518
519 ## Now translate the pod document and then exit with the desired status
39a52d2c
JH
520 if ( $opts{"-verbose"} >= 2
521 and !ref($opts{"-input"})
522 and $opts{"-output"} == \*STDOUT )
523 {
524 ## spit out the entire PODs. Might as well invoke perldoc
2dd58eb2 525 my $progpath = File::Spec->catfile($Config{scriptdir}, "perldoc");
39a52d2c
JH
526 system($progpath, $opts{"-input"});
527 }
528 else {
529 $parser->parse_from_file($opts{"-input"}, $opts{"-output"});
530 }
531
532 exit($opts{"-exitval"}) unless (lc($opts{"-exitval"}) eq 'noexit');
360aca43
GS
533}
534
535##---------------------------------------------------------------------------
536
537##-------------------------------
538## Method definitions begin here
539##-------------------------------
540
541sub new {
542 my $this = shift;
543 my $class = ref($this) || $this;
544 my %params = @_;
545 my $self = {%params};
546 bless $self, $class;
d5c61f7c
RGS
547 if ($self->can('initialize')) {
548 $self->initialize();
549 } else {
550 $self = $self->SUPER::new();
551 %$self = (%$self, %params);
552 }
360aca43
GS
553 return $self;
554}
555
d5c61f7c
RGS
556sub select {
557 my ($self, @res) = @_;
558 if ($ISA[0]->can('select')) {
559 $self->SUPER::select(@_);
560 } else {
561 $self->{USAGE_SELECT} = \@res;
562 }
563}
564
565# This overrides the Pod::Text method to do something very akin to what
566# Pod::Select did as well as the work done below by preprocess_paragraph.
567# Note that the below is very, very specific to Pod::Text.
568sub _handle_element_end {
569 my ($self, $element) = @_;
570 if ($element eq 'head1') {
571 $$self{USAGE_HEAD1} = $$self{PENDING}[-1][1];
572 $$self{PENDING}[-1][1] =~ s/^\s*SYNOPSIS\s*$/USAGE/;
573 } elsif ($element eq 'head2') {
574 $$self{USAGE_HEAD2} = $$self{PENDING}[-1][1];
575 }
576 if ($element eq 'head1' || $element eq 'head2') {
577 $$self{USAGE_SKIPPING} = 1;
578 my $heading = $$self{USAGE_HEAD1};
579 $heading .= '/' . $$self{USAGE_HEAD2} if defined $$self{USAGE_HEAD2};
580 for (@{ $$self{USAGE_SELECT} }) {
581 if ($heading =~ /^$_\s*$/) {
582 $$self{USAGE_SKIPPING} = 0;
583 last;
584 }
585 }
586
587 # Try to do some lowercasing instead of all-caps in headings, and use
588 # a colon to end all headings.
589 local $_ = $$self{PENDING}[-1][1];
590 s{([A-Z])([A-Z]+)}{((length($2) > 2) ? $1 : lc($1)) . lc($2)}ge;
591 s/\s*$/:/ unless (/:\s*$/);
592 $_ .= "\n";
593 $$self{PENDING}[-1][1] = $_;
594 }
595 if ($$self{USAGE_SKIPPING}) {
596 pop @{ $$self{PENDING} };
597 } else {
598 $self->SUPER::_handle_element_end($element);
599 }
600}
601
602sub start_document {
603 my $self = shift;
604 $self->SUPER::start_document();
605 my $msg = $self->{USAGE_OPTIONS}->{-message} or return 1;
606 my $out_fh = $self->output_fh();
607 print $out_fh "$msg\n";
608}
609
360aca43
GS
610sub begin_pod {
611 my $self = shift;
612 $self->SUPER::begin_pod(); ## Have to call superclass
613 my $msg = $self->{USAGE_OPTIONS}->{-message} or return 1;
614 my $out_fh = $self->output_handle();
615 print $out_fh "$msg\n";
616}
617
618sub preprocess_paragraph {
619 my $self = shift;
620 local $_ = shift;
621 my $line = shift;
622 ## See if this is a heading and we arent printing the entire manpage.
e9fdc7d2 623 if (($self->{USAGE_OPTIONS}->{-verbose} < 2) && /^=head/) {
360aca43 624 ## Change the title of the SYNOPSIS section to USAGE
e9fdc7d2 625 s/^=head1\s+SYNOPSIS\s*$/=head1 USAGE/;
360aca43
GS
626 ## Try to do some lowercasing instead of all-caps in headings
627 s{([A-Z])([A-Z]+)}{((length($2) > 2) ? $1 : lc($1)) . lc($2)}ge;
628 ## Use a colon to end all headings
e9fdc7d2 629 s/\s*$/:/ unless (/:\s*$/);
360aca43
GS
630 $_ .= "\n";
631 }
632 return $self->SUPER::preprocess_paragraph($_);
633}
634
8abb48c2 6351; # keep require happy