← Index
NYTProf Performance Profile   « line view »
For webmerge/scripts/webmerge.pl
  Run on Mon Oct 7 02:42:42 2013
Reported on Mon Oct 7 03:03:25 2013

Filename/usr/lib64/perl5/vendor_perl/5.16.0/Pod/Usage.pm
StatementsExecuted 20 statements in 12.0ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
11118.5ms240msPod::Usage::::BEGIN@450Pod::Usage::BEGIN@450
11183µs186µsPod::Usage::::BEGIN@11Pod::Usage::BEGIN@11
11166µs367µsPod::Usage::::BEGIN@13Pod::Usage::BEGIN@13
11163µs152µsPod::Usage::::BEGIN@446Pod::Usage::BEGIN@446
11162µs323µsPod::Usage::::BEGIN@444Pod::Usage::BEGIN@444
11153µs120µsPod::Usage::::BEGIN@445Pod::Usage::BEGIN@445
11135µs35µsPod::Usage::::BEGIN@447Pod::Usage::BEGIN@447
0000s0sPod::Usage::::_handle_element_endPod::Usage::_handle_element_end
0000s0sPod::Usage::::begin_podPod::Usage::begin_pod
0000s0sPod::Usage::::newPod::Usage::new
0000s0sPod::Usage::::pod2usagePod::Usage::pod2usage
0000s0sPod::Usage::::preprocess_paragraphPod::Usage::preprocess_paragraph
0000s0sPod::Usage::::selectPod::Usage::select
0000s0sPod::Usage::::seq_iPod::Usage::seq_i
0000s0sPod::Usage::::start_documentPod::Usage::start_document
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments		 Time
on line		 Calls Time
in subs		 Code
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;
112194µs2289µs
# spent 186µs (83+103) within Pod::Usage::BEGIN@11 which was called: # once (83µs+103µs) by main::BEGIN@147 at line 11
use strict;
# spent 186µs making 1 call to Pod::Usage::BEGIN@11 # spent 103µs making 1 call to strict::import
12
132923µs2669µs
# spent 367µs (66+301) within Pod::Usage::BEGIN@13 which was called: # once (66µs+301µs) by main::BEGIN@147 at line 13
use vars qw($VERSION @ISA @EXPORT);
# spent 367µs making 1 call to Pod::Usage::BEGIN@13 # spent 301µs making 1 call to vars::import
1414µs$VERSION = '1.36'; ## Current version of this package
15160µsrequire 5.005; ## requires this Perl version or later
16
17=head1 NAME
18
19Pod::Usage, pod2usage() - print a usage message from embedded pod documentation
20
21=head1 SYNOPSIS
22
23 use Pod::Usage
24
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
29
30 pod2usage($message_text);
31
32 pod2usage($exit_status);
33
34 pod2usage( { -message => $message_text ,
35 -exitval => $exit_status ,
36 -verbose => $verbose_level,
37 -output => $filehandle } );
38
39 pod2usage( -msg => $message_text ,
40 -exitval => $exit_status ,
41 -verbose => $verbose_level,
42 -output => $filehandle );
43
44 pod2usage( -verbose => 2,
45 -noperldoc => 1 )
46
47=head1 ARGUMENTS
48
49B<pod2usage> should be given either a single argument, or a list of
50arguments corresponding to an associative array (a "hash"). When a single
51argument is given, it should correspond to exactly one of the following:
52
53=over 4
54
55=item *
56
57A string containing the text of a message to print I<before> printing
58the usage message
59
60=item *
61
62A numeric value corresponding to the desired exit status
63
64=item *
65
66A reference to a hash
67
68=back
69
70If more than one argument is given then the entire argument list is
71assumed to be a hash. If a hash is supplied (either as a reference or
72as a list) it should contain one or more elements with the following
73keys:
74
75=over 4
76
77=item C<-message>
78
79=item C<-msg>
80
81The text of a message to print immediately prior to printing the
82program's usage message.
83
84=item C<-exitval>
85
86The desired exit status to pass to the B<exit()> function.
87This should be an integer, or else the string "NOEXIT" to
88indicate that control should simply be returned without
89terminating the invoking process.
90
91=item C<-verbose>
92
93The desired level of "verboseness" to use when printing the usage
94message. If the corresponding value is 0, then only the "SYNOPSIS"
95section of the pod documentation is printed. If the corresponding value
96is 1, then the "SYNOPSIS" section, along with any section entitled
97"OPTIONS", "ARGUMENTS", or "OPTIONS AND ARGUMENTS" is printed. If the
98corresponding value is 2 or more then the entire manpage is printed.
99
100The special verbosity level 99 requires to also specify the -sections
101parameter; then these sections are extracted (see L<Pod::Select>)
102and printed.
103
104=item C<-sections>
105
106A string representing a selection list for sections to be printed
107when -verbose is set to 99, e.g. C<"NAME|SYNOPSIS|DESCRIPTION|VERSION">.
108
109Alternatively, an array reference of section specifications can be used:
110
111 pod2usage(-verbose => 99,
112 -sections => [ qw(fred fred/subsection) ] );
113
114=item C<-output>
115
116A reference to a filehandle, or the pathname of a file to which the
117usage message should be written. The default is C<\*STDERR> unless the
118exit value is less than 2 (in which case the default is C<\*STDOUT>).
119
120=item C<-input>
121
122A reference to a filehandle, or the pathname of a file from which the
123invoking script's pod documentation should be read. It defaults to the
124file indicated by C<$0> (C<$PROGRAM_NAME> for users of F<English.pm>).
125
126If you are calling B<pod2usage()> from a module and want to display
127that module's POD, you can use this:
128
129 use Pod::Find qw(pod_where);
130 pod2usage( -input => pod_where({-inc => 1}, __PACKAGE__) );
131
132=item C<-pathlist>
133
134A list of directory paths. If the input file does not exist, then it
135will be searched for in the given directory list (in the order the
136directories appear in the list). It defaults to the list of directories
137implied by C<$ENV{PATH}>. The list may be specified either by a reference
138to an array, or by a string of directory paths which use the same path
139separator as C<$ENV{PATH}> on your system (e.g., C<:> for Unix, C<;> for
140MSWin32 and DOS).
141
142=item C<-noperldoc>
143
144By default, Pod::Usage will call L<perldoc> when -verbose >= 2 is
145specified. This does not work well e.g. if the script was packed
146with L<PAR>. The -noperldoc option suppresses the external call to
147L<perldoc> and uses the simple text formatter (L<Pod::Text>) to
148output the POD.
149
150=back
151
152=head1 DESCRIPTION
153
154B<pod2usage> will print a usage message for the invoking script (using
155its embedded pod documentation) and then exit the script with the
156desired exit status. The usage message printed may have any one of three
157levels of "verboseness": If the verbose level is 0, then only a synopsis
158is printed. If the verbose level is 1, then the synopsis is printed
159along with a description (if present) of the command line options and
160arguments. If the verbose level is 2, then the entire manual page is
161printed.
162
163Unless they are explicitly specified, the default values for the exit
164status, verbose level, and output stream to use are determined as
165follows:
166
167=over 4
168
169=item *
170
171If neither the exit status nor the verbose level is specified, then the
172default is to use an exit status of 2 with a verbose level of 0.
173
174=item *
175
176If an exit status I<is> specified but the verbose level is I<not>, then the
177verbose level will default to 1 if the exit status is less than 2 and
178will default to 0 otherwise.
179
180=item *
181
182If an exit status is I<not> specified but verbose level I<is> given, then
183the exit status will default to 2 if the verbose level is 0 and will
184default to 1 otherwise.
185
186=item *
187
188If the exit status used is less than 2, then output is printed on
189C<STDOUT>. Otherwise output is printed on C<STDERR>.
190
191=back
192
193Although the above may seem a bit confusing at first, it generally does
194"the right thing" in most situations. This determination of the default
195values to use is based upon the following typical Unix conventions:
196
197=over 4
198
199=item *
200
201An exit status of 0 implies "success". For example, B<diff(1)> exits
202with a status of 0 if the two files have the same contents.
203
204=item *
205
206An exit status of 1 implies possibly abnormal, but non-defective, program
207termination. For example, B<grep(1)> exits with a status of 1 if
208it did I<not> find a matching line for the given regular expression.
209
210=item *
211
212An exit status of 2 or more implies a fatal error. For example, B<ls(1)>
213exits with a status of 2 if you specify an illegal (unknown) option on
214the command line.
215
216=item *
217
218Usage messages issued as a result of bad command-line syntax should go
219to C<STDERR>. However, usage messages issued due to an explicit request
220to print usage (like specifying B<-help> on the command line) should go
221to C<STDOUT>, just in case the user wants to pipe the output to a pager
222(such as B<more(1)>).
223
224=item *
225
226If program usage has been explicitly requested by the user, it is often
227desirable to exit with a status of 1 (as opposed to 0) after issuing
228the user-requested usage message. It is also desirable to give a
229more verbose description of program usage in this case.
230
231=back
232
233B<pod2usage> doesn't force the above conventions upon you, but it will
234use them by default if you don't expressly tell it to do otherwise. The
235ability of B<pod2usage()> to accept a single number or a string makes it
236convenient to use as an innocent looking error message handling function:
237
238 use Pod::Usage;
239 use Getopt::Long;
240
241 ## Parse options
242 GetOptions("help", "man", "flag1") || pod2usage(2);
243 pod2usage(1) if ($opt_help);
244 pod2usage(-verbose => 2) if ($opt_man);
245
246 ## Check for too many filenames
247 pod2usage("$0: Too many files given.\n") if (@ARGV > 1);
248
249Some user's however may feel that the above "economy of expression" is
250not particularly readable nor consistent and may instead choose to do
251something more like the following:
252
253 use Pod::Usage;
254 use Getopt::Long;
255
256 ## Parse options
257 GetOptions("help", "man", "flag1") || pod2usage(-verbose => 0);
258 pod2usage(-verbose => 1) if ($opt_help);
259 pod2usage(-verbose => 2) if ($opt_man);
260
261 ## Check for too many filenames
262 pod2usage(-verbose => 2, -message => "$0: Too many files given.\n")
263 if (@ARGV > 1);
264
265As with all things in Perl, I<there's more than one way to do it>, and
266B<pod2usage()> adheres to this philosophy. If you are interested in
267seeing a number of different ways to invoke B<pod2usage> (although by no
268means exhaustive), please refer to L<"EXAMPLES">.
269
270=head1 EXAMPLES
271
272Each 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:
274
275 pod2usage();
276
277 pod2usage(2);
278
279 pod2usage(-verbose => 0);
280
281 pod2usage(-exitval => 2);
282
283 pod2usage({-exitval => 2, -output => \*STDERR});
284
285 pod2usage({-verbose => 0, -output => \*STDERR});
286
287 pod2usage(-exitval => 2, -verbose => 0);
288
289 pod2usage(-exitval => 2, -verbose => 0, -output => \*STDERR);
290
291Each of the following invocations of C<pod2usage()> will print a message
292of "Syntax error." (followed by a newline) to C<STDERR>, immediately
293followed by just the "SYNOPSIS" section (also printed to C<STDERR>) and
294will exit with a status of 2:
295
296 pod2usage("Syntax error.");
297
298 pod2usage(-message => "Syntax error.", -verbose => 0);
299
300 pod2usage(-msg => "Syntax error.", -exitval => 2);
301
302 pod2usage({-msg => "Syntax error.", -exitval => 2, -output => \*STDERR});
303
304 pod2usage({-msg => "Syntax error.", -verbose => 0, -output => \*STDERR});
305
306 pod2usage(-msg => "Syntax error.", -exitval => 2, -verbose => 0);
307
308 pod2usage(-message => "Syntax error.",
309 -exitval => 2,
310 -verbose => 0,
311 -output => \*STDERR);
312
313Each of the following invocations of C<pod2usage()> will print the
314"SYNOPSIS" section and any "OPTIONS" and/or "ARGUMENTS" sections to
315C<STDOUT> and will exit with a status of 1:
316
317 pod2usage(1);
318
319 pod2usage(-verbose => 1);
320
321 pod2usage(-exitval => 1);
322
323 pod2usage({-exitval => 1, -output => \*STDOUT});
324
325 pod2usage({-verbose => 1, -output => \*STDOUT});
326
327 pod2usage(-exitval => 1, -verbose => 1);
328
329 pod2usage(-exitval => 1, -verbose => 1, -output => \*STDOUT});
330
331Each of the following invocations of C<pod2usage()> will print the
332entire manual page to C<STDOUT> and will exit with a status of 1:
333
334 pod2usage(-verbose => 2);
335
336 pod2usage({-verbose => 2, -output => \*STDOUT});
337
338 pod2usage(-exitval => 1, -verbose => 2);
339
340 pod2usage({-exitval => 1, -verbose => 2, -output => \*STDOUT});
341
342=head2 Recommended Use
343
344Most scripts should print some type of usage message to C<STDERR> when a
345command line syntax error is detected. They should also provide an
346option (usually C<-H> or C<-help>) to print a (possibly more verbose)
347usage message to C<STDOUT>. Some scripts may even wish to go so far as to
348provide a means of printing their complete documentation to C<STDOUT>
349(perhaps by allowing a C<-man> option). The following complete example
350uses B<Pod::Usage> in combination with B<Getopt::Long> to do all of these
351things:
352
353 use Getopt::Long;
354 use Pod::Usage;
355
356 my $man = 0;
357 my $help = 0;
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;
363
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));
367 __END__
368
369 =head1 NAME
370
371 sample - Using GetOpt::Long and Pod::Usage
372
373 =head1 SYNOPSIS
374
375 sample [options] [file ...]
376
377 Options:
378 -help brief help message
379 -man full documentation
380
381 =head1 OPTIONS
382
383 =over 8
384
385 =item B<-help>
386
387 Print a brief help message and exits.
388
389 =item B<-man>
390
391 Prints the manual page and exits.
392
393 =back
394
395 =head1 DESCRIPTION
396
397 B<This program> will read the given input file(s) and do something
398 useful with the contents thereof.
399
400 =cut
401
402=head1 CAVEATS
403
404By default, B<pod2usage()> will use C<$0> as the path to the pod input
405file. Unfortunately, not all systems on which Perl runs will set C<$0>
406properly (although if C<$0> isn't found, B<pod2usage()> will search
407C<$ENV{PATH}> or else the list specified by the C<-pathlist> option).
408If this is the case for your system, you may need to explicitly specify
409the path to the pod docs for the invoking script using something
410similar to the following:
411
412 pod2usage(-exitval => 2, -input => "/path/to/your/pod/docs");
413
414In the pathological case that a script is called via a relative path
415I<and> the script itself changes the current working directory
416(see L<perlfunc/chdir>) I<before> calling pod2usage, Pod::Usage will
417fail even on robust platforms. Don't do that.
418
419=head1 AUTHOR
420
421Please report bugs using L<http://rt.cpan.org>.
422
423Marek Rouchal E<lt>marekr@cpan.orgE<gt>
424
425Brad Appleton E<lt>bradapp@enteract.comE<gt>
426
427Based on code for B<Pod::Text::pod2text()> written by
428Tom Christiansen E<lt>tchrist@mox.perl.comE<gt>
429
430=head1 ACKNOWLEDGMENTS
431
432Steven McDougall E<lt>swmcd@world.std.comE<gt> for his help and patience
433with re-writing this manpage.
434
435=head1 SEE ALSO
436
437L<Pod::Parser>, L<Getopt::Long>, L<Pod::Find>
438
439=cut
440
441#############################################################################
442
443#use diagnostics;
4442155µs2583µs
# spent 323µs (62+260) within Pod::Usage::BEGIN@444 which was called: # once (62µs+260µs) by main::BEGIN@147 at line 444
use Carp;
# spent 323µs making 1 call to Pod::Usage::BEGIN@444 # spent 260µs making 1 call to Exporter::import
4452160µs2186µs
# spent 120µs (53+67) within Pod::Usage::BEGIN@445 which was called: # once (53µs+67µs) by main::BEGIN@147 at line 445
use Config;
# spent 120µs making 1 call to Pod::Usage::BEGIN@445 # spent 67µs making 1 call to Config::import
4462143µs2241µs
# spent 152µs (63+89) within Pod::Usage::BEGIN@446 which was called: # once (63µs+89µs) by main::BEGIN@147 at line 446
use Exporter;
# spent 152µs making 1 call to Pod::Usage::BEGIN@446 # spent 89µs making 1 call to Exporter::import
4472579µs135µs
# spent 35µs within Pod::Usage::BEGIN@447 which was called: # once (35µs+0s) by main::BEGIN@147 at line 447
use File::Spec;
# spent 35µs making 1 call to Pod::Usage::BEGIN@447
448
44917µs@EXPORT = qw(&pod2usage);
450
# spent 240ms (18.5+222) within Pod::Usage::BEGIN@450 which was called: # once (18.5ms+222ms) by main::BEGIN@147 at line 459
BEGIN {
451143µs if ( $] >= 5.005_58 ) {
4521578µs require Pod::Text;
453176µs @ISA = qw( Pod::Text );
454 }
455 else {
456 require Pod::PlainText;
457 @ISA = qw( Pod::PlainText );
458 }
45918.54ms1240ms}
# spent 240ms making 1 call to Pod::Usage::BEGIN@450
460
4611497µsrequire Pod::Select;
462
463##---------------------------------------------------------------------------
464
465##---------------------------------
466## Function definitions begin here
467##---------------------------------
468
469sub pod2usage {
470 local($_) = shift;
471 my %opts;
472 ## Collect arguments
473 if (@_ > 0) {
474 ## Too many arguments - assume that this is a hash and
475 ## the user forgot to pass a reference to it.
476 %opts = ($_, @_);
477 }
478 elsif (!defined $_) {
479 $_ = '';
480 }
481 elsif (ref $_) {
482 ## User passed a ref to a hash
483 %opts = %{$_} if (ref($_) eq 'HASH');
484 }
485 elsif (/^[-+]?\d+$/) {
486 ## User passed in the exit value to use
487 $opts{'-exitval'} = $_;
488 }
489 else {
490 ## User passed in a message to print before issuing usage.
491 $_ and $opts{'-message'} = $_;
492 }
493
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)
498 %opts = map {
499 my ($key, $val) = ($_, $opts{$_});
500 $key =~ s/^(?=\w)/-/;
501 $key =~ /^-msg/i and $key = '-message';
502 $key =~ /^-exit/i and $key = '-exitval';
503 lc($key) => $val;
504 } (keys %opts);
505
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;
510 }
511 elsif (! defined $opts{'-exitval'}) {
512 $opts{'-exitval'} = ($opts{'-verbose'} > 0) ? 1 : 2;
513 }
514 elsif (! defined $opts{'-verbose'}) {
515 $opts{'-verbose'} = (lc($opts{'-exitval'}) eq 'noexit' ||
516 $opts{'-exitval'} < 2);
517 }
518
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'});
525
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};
532
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'} = $_);
537 }
538 }
539
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*');
544 }
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" );
550 }
551 elsif ($opts{'-verbose'} >= 2 && $opts{'-verbose'} != 99) {
552 $parser->select('.*');
553 }
554 elsif ($opts{'-verbose'} == 99) {
555 my $sections = $opts{'-sections'};
556 $parser->select( (ref $sections) ? @$sections : $sections );
557 $opts{'-verbose'} = 1;
558 }
559
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 )
565 {
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);
573 if($?) {
574 # RT16091: fall back to more if perldoc failed
575 system(($Config{pager} || $ENV{PAGER} || '/bin/more'), $1);
576 }
577 } else {
578 croak "Unspecified input file or insecure argument.\n";
579 }
580 }
581 else {
582 $parser->parse_from_file($opts{'-input'}, $opts{'-output'});
583 }
584
585 exit($opts{'-exitval'}) unless (lc($opts{'-exitval'}) eq 'noexit');
586}
587
588##---------------------------------------------------------------------------
589
590##-------------------------------
591## Method definitions begin here
592##-------------------------------
593
594sub new {
595 my $this = shift;
596 my $class = ref($this) || $this;
597 my %params = @_;
598 my $self = {%params};
599 bless $self, $class;
600 if ($self->can('initialize')) {
601 $self->initialize();
602 } else {
603 $self = $self->SUPER::new();
604 %$self = (%$self, %params);
605 }
606 return $self;
607}
608
609sub select {
610 my ($self, @sections) = @_;
611 if ($ISA[0]->can('select')) {
612 $self->SUPER::select(@sections);
613 } else {
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
617 unless (@sections) {
618 delete $self->{USAGE_SELECT} unless ($add);
619 return;
620 }
621 $self->{USAGE_SELECT} = []
622 unless ($add && $self->{USAGE_SELECT});
623 my $sref = $self->{USAGE_SELECT};
624 ## Compile each spec
625 for my $spec (@sections) {
626 my $cs = Pod::Select::_compile_section_spec($spec);
627 if ( defined $cs ) {
628 ## Store them in our sections array
629 push(@$sref, $cs);
630 } else {
631 carp qq{Ignoring section spec "$spec"!\n};
632 }
633 }
634 }
635}
636
637# Override Pod::Text->seq_i to return just "arg", not "*arg*".
638sub seq_i { return $_[1] }
639
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.
643sub _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/;
649 }
650 } elsif ($element =~ /^head(\d+)$/ && $1) { # avoid 0
651 my $idx = $1 - 1;
652 $self->{USAGE_HEADINGS} = [] unless($self->{USAGE_HEADINGS});
653 $self->{USAGE_HEADINGS}->[$idx] = $$self{PENDING}[-1][1];
654 }
655 if ($element =~ /^head\d+$/) {
656 $$self{USAGE_SKIPPING} = 1;
657 if (!$$self{USAGE_SELECT} || !@{ $$self{USAGE_SELECT} }) {
658 $$self{USAGE_SKIPPING} = 0;
659 } else {
660 my @headings = @{$$self{USAGE_HEADINGS}};
661 for my $section_spec ( @{$$self{USAGE_SELECT}} ) {
662 my $match = 1;
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
671 if ($match) {
672 $$self{USAGE_SKIPPING} = 0;
673 last;
674 }
675 } # end sections
676 }
677
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*$/);
684 $_ .= "\n";
685 $$self{PENDING}[-1][1] = $_;
686 }
687 }
688 if ($$self{USAGE_SKIPPING} && $element !~ m/^over-/) {
689 pop @{ $$self{PENDING} };
690 } else {
691 $self->SUPER::_handle_element_end($element);
692 }
693}
694
695# required for Pod::Simple API
696sub start_document {
697 my $self = shift;
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";
702}
703
704# required for old Pod::Parser API
705sub begin_pod {
706 my $self = shift;
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";
711}
712
713sub preprocess_paragraph {
714 my $self = shift;
715 local $_ = shift;
716 my $line = shift;
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*$/);
725 $_ .= "\n";
726 }
727 return $self->SUPER::preprocess_paragraph($_);
728}
729
730120µs1; # keep require happy
Report produced by the NYTProf 5.05 Perl profiler, developed by Tim Bunce and Adam Kaplan.