Commit | Line | Data |
360aca43 |
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 |
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); |
d5c61f7c |
13 | $VERSION = 1.30; ## Current version of this package |
828c4421 |
14 | require 5.005; ## requires this Perl version or later |
360aca43 |
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 | |
92e3d63a |
49 | =over 4 |
360aca43 |
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 | |
92e3d63a |
71 | =over 4 |
360aca43 |
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. |
39a52d2c |
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. |
360aca43 |
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 | |
d5c61f7c |
96 | The special verbosity level 99 requires to also specify the -section |
97 | parameter; then these sections are extracted and printed. |
98 | |
99 | =item C<-section> |
100 | |
101 | A string representing a selection list for sections to be printed |
102 | when -verbose is set to 99, e.g. C<"NAME|SYNOPSIS|DESCRIPTION|VERSION">. |
103 | |
360aca43 |
104 | =item C<-output> |
105 | |
106 | A reference to a filehandle, or the pathname of a file to which the |
107 | usage message should be written. The default is C<\*STDERR> unless the |
108 | exit value is less than 2 (in which case the default is C<\*STDOUT>). |
109 | |
110 | =item C<-input> |
111 | |
112 | A reference to a filehandle, or the pathname of a file from which the |
113 | invoking script's pod documentation should be read. It defaults to the |
114 | file indicated by C<$0> (C<$PROGRAM_NAME> for users of F<English.pm>). |
115 | |
116 | =item C<-pathlist> |
117 | |
118 | A list of directory paths. If the input file does not exist, then it |
119 | will be searched for in the given directory list (in the order the |
120 | directories appear in the list). It defaults to the list of directories |
121 | implied by C<$ENV{PATH}>. The list may be specified either by a reference |
122 | to an array, or by a string of directory paths which use the same path |
123 | separator as C<$ENV{PATH}> on your system (e.g., C<:> for Unix, C<;> for |
124 | MSWin32 and DOS). |
125 | |
126 | =back |
127 | |
128 | =head1 DESCRIPTION |
129 | |
130 | B<pod2usage> will print a usage message for the invoking script (using |
131 | its embedded pod documentation) and then exit the script with the |
132 | desired exit status. The usage message printed may have any one of three |
133 | levels of "verboseness": If the verbose level is 0, then only a synopsis |
134 | is printed. If the verbose level is 1, then the synopsis is printed |
135 | along with a description (if present) of the command line options and |
136 | arguments. If the verbose level is 2, then the entire manual page is |
137 | printed. |
138 | |
139 | Unless they are explicitly specified, the default values for the exit |
140 | status, verbose level, and output stream to use are determined as |
141 | follows: |
142 | |
92e3d63a |
143 | =over 4 |
360aca43 |
144 | |
145 | =item * |
146 | |
147 | If neither the exit status nor the verbose level is specified, then the |
148 | default is to use an exit status of 2 with a verbose level of 0. |
149 | |
150 | =item * |
151 | |
152 | If an exit status I<is> specified but the verbose level is I<not>, then the |
153 | verbose level will default to 1 if the exit status is less than 2 and |
154 | will default to 0 otherwise. |
155 | |
156 | =item * |
157 | |
158 | If an exit status is I<not> specified but verbose level I<is> given, then |
159 | the exit status will default to 2 if the verbose level is 0 and will |
160 | default to 1 otherwise. |
161 | |
162 | =item * |
163 | |
164 | If the exit status used is less than 2, then output is printed on |
165 | C<STDOUT>. Otherwise output is printed on C<STDERR>. |
166 | |
167 | =back |
168 | |
169 | Although the above may seem a bit confusing at first, it generally does |
170 | "the right thing" in most situations. This determination of the default |
171 | values to use is based upon the following typical Unix conventions: |
172 | |
92e3d63a |
173 | =over 4 |
360aca43 |
174 | |
175 | =item * |
176 | |
177 | An exit status of 0 implies "success". For example, B<diff(1)> exits |
178 | with a status of 0 if the two files have the same contents. |
179 | |
180 | =item * |
181 | |
182 | An exit status of 1 implies possibly abnormal, but non-defective, program |
183 | termination. For example, B<grep(1)> exits with a status of 1 if |
184 | it did I<not> find a matching line for the given regular expression. |
185 | |
186 | =item * |
187 | |
188 | An exit status of 2 or more implies a fatal error. For example, B<ls(1)> |
189 | exits with a status of 2 if you specify an illegal (unknown) option on |
190 | the command line. |
191 | |
192 | =item * |
193 | |
194 | Usage messages issued as a result of bad command-line syntax should go |
195 | to C<STDERR>. However, usage messages issued due to an explicit request |
196 | to print usage (like specifying B<-help> on the command line) should go |
197 | to 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 | |
202 | If program usage has been explicitly requested by the user, it is often |
203 | desireable to exit with a status of 1 (as opposed to 0) after issuing |
204 | the user-requested usage message. It is also desireable to give a |
205 | more verbose description of program usage in this case. |
206 | |
207 | =back |
208 | |
209 | B<pod2usage> doesn't force the above conventions upon you, but it will |
210 | use them by default if you don't expressly tell it to do otherwise. The |
211 | ability of B<pod2usage()> to accept a single number or a string makes it |
212 | convenient 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 |
225 | Some user's however may feel that the above "economy of expression" is |
360aca43 |
226 | not particularly readable nor consistent and may instead choose to do |
227 | something 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 | |
241 | As with all things in Perl, I<there's more than one way to do it>, and |
242 | B<pod2usage()> adheres to this philosophy. If you are interested in |
243 | seeing a number of different ways to invoke B<pod2usage> (although by no |
244 | means exhaustive), please refer to L<"EXAMPLES">. |
245 | |
246 | =head1 EXAMPLES |
247 | |
248 | Each 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 | |
267 | Each of the following invocations of C<pod2usage()> will print a message |
268 | of "Syntax error." (followed by a newline) to C<STDERR>, immediately |
269 | followed by just the "SYNOPSIS" section (also printed to C<STDERR>) and |
270 | will 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 | |
289 | Each of the following invocations of C<pod2usage()> will print the |
290 | "SYNOPSIS" section and any "OPTIONS" and/or "ARGUMENTS" sections to |
291 | C<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 | |
307 | Each of the following invocations of C<pod2usage()> will print the |
308 | entire 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 | |
320 | Most scripts should print some type of usage message to C<STDERR> when a |
321 | command line syntax error is detected. They should also provide an |
322 | option (usually C<-H> or C<-help>) to print a (possibly more verbose) |
323 | usage message to C<STDOUT>. Some scripts may even wish to go so far as to |
324 | provide a means of printing their complete documentation to C<STDOUT> |
f48e6a7e |
325 | (perhaps by allowing a C<-man> option). The following complete example |
326 | uses B<Pod::Usage> in combination with B<Getopt::Long> to do all of these |
360aca43 |
327 | things: |
328 | |
329 | use Getopt::Long; |
330 | use Pod::Usage; |
331 | |
f48e6a7e |
332 | my $man = 0; |
333 | my $help = 0; |
360aca43 |
334 | ## Parse options and print usage if there is a syntax error, |
335 | ## or if usage was explicitly requested. |
f48e6a7e |
336 | GetOptions('help|?' => \$help, man => \$man) or pod2usage(2); |
337 | pod2usage(1) if $help; |
338 | pod2usage(-verbose => 2) if $man; |
360aca43 |
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 |
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 |
377 | |
378 | =head1 CAVEATS |
379 | |
380 | By default, B<pod2usage()> will use C<$0> as the path to the pod input |
381 | file. Unfortunately, not all systems on which Perl runs will set C<$0> |
382 | properly (although if C<$0> isn't found, B<pod2usage()> will search |
383 | C<$ENV{PATH}> or else the list specified by the C<-pathlist> option). |
384 | If this is the case for your system, you may need to explicitly specify |
385 | the path to the pod docs for the invoking script using something |
386 | similar to the following: |
387 | |
388 | pod2usage(-exitval => 2, -input => "/path/to/your/pod/docs"); |
389 | |
390 | =head1 AUTHOR |
391 | |
aaa799f9 |
392 | Please report bugs using L<http://rt.cpan.org>. |
393 | |
360aca43 |
394 | Brad Appleton E<lt>bradapp@enteract.comE<gt> |
395 | |
396 | Based on code for B<Pod::Text::pod2text()> written by |
397 | Tom Christiansen E<lt>tchrist@mox.perl.comE<gt> |
398 | |
399 | =head1 ACKNOWLEDGEMENTS |
400 | |
401 | Steven McDougall E<lt>swmcd@world.std.comE<gt> for his help and patience |
402 | with re-writing this manpage. |
403 | |
404 | =cut |
405 | |
406 | ############################################################################# |
407 | |
408 | use strict; |
409 | #use diagnostics; |
410 | use Carp; |
39a52d2c |
411 | use Config; |
360aca43 |
412 | use Exporter; |
360aca43 |
413 | use File::Spec; |
414 | |
415 | use vars qw(@ISA @EXPORT); |
360aca43 |
416 | @EXPORT = qw(&pod2usage); |
664bb207 |
417 | BEGIN { |
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 |
428 | |
429 | ##--------------------------------------------------------------------------- |
430 | |
431 | ##--------------------------------- |
432 | ## Function definitions begin here |
433 | ##--------------------------------- |
434 | |
435 | sub 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 |
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 |
478 | $opts{"-verbose"} = (lc($opts{"-exitval"}) eq "noexit" || |
479 | $opts{"-exitval"} < 2); |
360aca43 |
480 | } |
481 | |
482 | ## Default the output file |
2dd58eb2 |
483 | $opts{"-output"} = (lc($opts{"-exitval"}) eq "noexit" || |
484 | $opts{"-exitval"} < 2) ? \*STDOUT : \*STDERR |
360aca43 |
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 |
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 |
514 | elsif ($opts{"-verbose"} == 99) { |
515 | $parser->select( $opts{"-sections"} ); |
516 | $opts{"-verbose"} = 1; |
517 | } |
360aca43 |
518 | |
519 | ## Now translate the pod document and then exit with the desired status |
39a52d2c |
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 |
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 |
533 | } |
534 | |
535 | ##--------------------------------------------------------------------------- |
536 | |
537 | ##------------------------------- |
538 | ## Method definitions begin here |
539 | ##------------------------------- |
540 | |
541 | sub new { |
542 | my $this = shift; |
543 | my $class = ref($this) || $this; |
544 | my %params = @_; |
545 | my $self = {%params}; |
546 | bless $self, $class; |
d5c61f7c |
547 | if ($self->can('initialize')) { |
548 | $self->initialize(); |
549 | } else { |
550 | $self = $self->SUPER::new(); |
551 | %$self = (%$self, %params); |
552 | } |
360aca43 |
553 | return $self; |
554 | } |
555 | |
d5c61f7c |
556 | sub 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. |
568 | sub _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 | |
602 | sub 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 |
610 | sub 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 | |
618 | sub 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 |
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 |
630 | $_ .= "\n"; |
631 | } |
632 | return $self->SUPER::preprocess_paragraph($_); |
633 | } |
634 | |
8abb48c2 |
635 | 1; # keep require happy |