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