← Index
NYTProf Performance Profile   « line view »
For /usr/local/bin/sa-learn
  Run on Sun Nov 5 03:09:29 2017
Reported on Mon Nov 6 13:20:44 2017

Filename/usr/local/lib/perl5/5.24/Pod/Usage.pm
StatementsExecuted 21 statements in 5.28ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
1117.85ms74.3msPod::Usage::::BEGIN@25Pod::Usage::BEGIN@25
1117.18ms8.02msPod::Usage::::BEGIN@19Pod::Usage::BEGIN@19
1115.17ms6.74msPod::Usage::::BEGIN@22Pod::Usage::BEGIN@22
11138µs47µsPod::Usage::::BEGIN@12Pod::Usage::BEGIN@12
11123µs72µsPod::Usage::::BEGIN@20Pod::Usage::BEGIN@20
11119µs169µsPod::Usage::::BEGIN@14Pod::Usage::BEGIN@14
11119µs74µsPod::Usage::::BEGIN@21Pod::Usage::BEGIN@21
0000s0sPod::Usage::::_compile_section_specPod::Usage::_compile_section_spec
0000s0sPod::Usage::::_handle_element_endPod::Usage::_handle_element_end
0000s0sPod::Usage::::begin_podPod::Usage::begin_pod
0000s0sPod::Usage::::cmd_iPod::Usage::cmd_i
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# Copyright (c) 2001-2016 by Marek Rouchal.
6# This file is part of "Pod-Usage". Pod-Usage is free software;
7# you can redistribute it and/or modify it under the same terms
8# as Perl itself.
9#############################################################################
10
11package Pod::Usage;
12262µs256µs
# spent 47µs (38+9) within Pod::Usage::BEGIN@12 which was called: # once (38µs+9µs) by main::BEGIN@25 at line 12
use strict;
# spent 47µs making 1 call to Pod::Usage::BEGIN@12 # spent 9µs making 1 call to strict::import
13
14279µs2318µs
# spent 169µs (19+150) within Pod::Usage::BEGIN@14 which was called: # once (19µs+150µs) by main::BEGIN@25 at line 14
use vars qw($VERSION @ISA @EXPORT);
# spent 169µs making 1 call to Pod::Usage::BEGIN@14 # spent 150µs making 1 call to vars::import
1512µs$VERSION = '1.68'; ## Current version of this package
16124µsrequire 5.006; ## requires this Perl version or later
17
18#use diagnostics;
192309µs28.19ms
# spent 8.02ms (7.18+837µs) within Pod::Usage::BEGIN@19 which was called: # once (7.18ms+837µs) by main::BEGIN@25 at line 19
use Carp;
# spent 8.02ms making 1 call to Pod::Usage::BEGIN@19 # spent 171µs making 1 call to Exporter::import
20255µs2121µs
# spent 72µs (23+49) within Pod::Usage::BEGIN@20 which was called: # once (23µs+49µs) by main::BEGIN@25 at line 20
use Config;
# spent 72µs making 1 call to Pod::Usage::BEGIN@20 # spent 49µs making 1 call to Config::import
21250µs2130µs
# spent 74µs (19+55) within Pod::Usage::BEGIN@21 which was called: # once (19µs+55µs) by main::BEGIN@25 at line 21
use Exporter;
# spent 74µs making 1 call to Pod::Usage::BEGIN@21 # spent 55µs making 1 call to Exporter::import
222469µs16.74ms
# spent 6.74ms (5.17+1.57) within Pod::Usage::BEGIN@22 which was called: # once (5.17ms+1.57ms) by main::BEGIN@25 at line 22
use File::Spec;
# spent 6.74ms making 1 call to Pod::Usage::BEGIN@22
23
2414µs@EXPORT = qw(&pod2usage);
25
# spent 74.3ms (7.85+66.5) within Pod::Usage::BEGIN@25 which was called: # once (7.85ms+66.5ms) by main::BEGIN@25 at line 30
BEGIN {
2612µs $Pod::Usage::Formatter ||= 'Pod::Text';
27144µs eval "require $Pod::Usage::Formatter";
# spent 296µs executing statements in string eval
2812µs die $@ if $@;
29127µs @ISA = ( $Pod::Usage::Formatter );
3014.13ms174.3ms}
# spent 74.3ms making 1 call to Pod::Usage::BEGIN@25
31
3212µsour $MAX_HEADING_LEVEL = 3;
33
34##---------------------------------------------------------------------------
35
36##---------------------------------
37## Function definitions begin here
38##---------------------------------
39
40sub pod2usage {
41 local($_) = shift;
42 my %opts;
43 ## Collect arguments
44 if (@_ > 0) {
45 ## Too many arguments - assume that this is a hash and
46 ## the user forgot to pass a reference to it.
47 %opts = ($_, @_);
48 }
49 elsif (!defined $_) {
50 $_ = '';
51 }
52 elsif (ref $_) {
53 ## User passed a ref to a hash
54 %opts = %{$_} if (ref($_) eq 'HASH');
55 }
56 elsif (/^[-+]?\d+$/) {
57 ## User passed in the exit value to use
58 $opts{'-exitval'} = $_;
59 }
60 else {
61 ## User passed in a message to print before issuing usage.
62 $_ and $opts{'-message'} = $_;
63 }
64
65 ## Need this for backward compatibility since we formerly used
66 ## options that were all uppercase words rather than ones that
67 ## looked like Unix command-line options.
68 ## to be uppercase keywords)
69 %opts = map {
70 my ($key, $val) = ($_, $opts{$_});
71 $key =~ s/^(?=\w)/-/;
72 $key =~ /^-msg/i and $key = '-message';
73 $key =~ /^-exit/i and $key = '-exitval';
74 lc($key) => $val;
75 } (keys %opts);
76
77 ## Now determine default -exitval and -verbose values to use
78 if ((! defined $opts{'-exitval'}) && (! defined $opts{'-verbose'})) {
79 $opts{'-exitval'} = 2;
80 $opts{'-verbose'} = 0;
81 }
82 elsif (! defined $opts{'-exitval'}) {
83 $opts{'-exitval'} = ($opts{'-verbose'} > 0) ? 1 : 2;
84 }
85 elsif (! defined $opts{'-verbose'}) {
86 $opts{'-verbose'} = (lc($opts{'-exitval'}) eq 'noexit' ||
87 $opts{'-exitval'} < 2);
88 }
89
90 ## Default the output file
91 $opts{'-output'} = (lc($opts{'-exitval'}) eq 'noexit' ||
92 $opts{'-exitval'} < 2) ? \*STDOUT : \*STDERR
93 unless (defined $opts{'-output'});
94 ## Default the input file
95 $opts{'-input'} = $0 unless (defined $opts{'-input'});
96
97 ## Look up input file in path if it doesn't exist.
98 unless ((ref $opts{'-input'}) || (-e $opts{'-input'})) {
99 my $basename = $opts{'-input'};
100 my $pathsep = ($^O =~ /^(?:dos|os2|MSWin32)$/i) ? ';'
101 : (($^O eq 'MacOS' || $^O eq 'VMS') ? ',' : ':');
102 my $pathspec = $opts{'-pathlist'} || $ENV{PATH} || $ENV{PERL5LIB};
103
104 my @paths = (ref $pathspec) ? @$pathspec : split($pathsep, $pathspec);
105 for my $dirname (@paths) {
106 $_ = File::Spec->catfile($dirname, $basename) if length;
107 last if (-e $_) && ($opts{'-input'} = $_);
108 }
109 }
110
111 ## Now create a pod reader and constrain it to the desired sections.
112 my $parser = new Pod::Usage(USAGE_OPTIONS => \%opts);
113 if ($opts{'-verbose'} == 0) {
114 $parser->select('(?:SYNOPSIS|USAGE)\s*');
115 }
116 elsif ($opts{'-verbose'} == 1) {
117 my $opt_re = '(?i)' .
118 '(?:OPTIONS|ARGUMENTS)' .
119 '(?:\s*(?:AND|\/)\s*(?:OPTIONS|ARGUMENTS))?';
120 $parser->select( '(?:SYNOPSIS|USAGE)\s*', $opt_re, "DESCRIPTION/$opt_re" );
121 }
122 elsif ($opts{'-verbose'} >= 2 && $opts{'-verbose'} != 99) {
123 $parser->select('.*');
124 }
125 elsif ($opts{'-verbose'} == 99) {
126 my $sections = $opts{'-sections'};
127 $parser->select( (ref $sections) ? @$sections : $sections );
128 $opts{'-verbose'} = 1;
129 }
130
131 ## Check for perldoc
132 my $progpath = $opts{'-perldoc'} ? $opts{'-perldoc'} :
133 File::Spec->catfile($Config{scriptdirexp}
134 || $Config{scriptdir}, 'perldoc');
135
136 my $version = sprintf("%vd",$^V);
137 if ($Config{versiononly} and $Config{startperl} =~ /\Q$version\E$/ ) {
138 $progpath .= $version;
139 }
140 $opts{'-noperldoc'} = 1 unless -e $progpath;
141
142 ## Now translate the pod document and then exit with the desired status
143 if ( !$opts{'-noperldoc'}
144 and $opts{'-verbose'} >= 2
145 and !ref($opts{'-input'})
146 and $opts{'-output'} == \*STDOUT )
147 {
148 ## spit out the entire PODs. Might as well invoke perldoc
149 print { $opts{'-output'} } ($opts{'-message'}, "\n") if($opts{'-message'});
150 if(defined $opts{-input} && $opts{-input} =~ /^\s*(\S.*?)\s*$/) {
151 # the perldocs back to 5.005 should all have -F
152 # without -F there are warnings in -T scripts
153 my $f = $1;
154 my @perldoc_cmd = ($progpath);
155 if ($opts{'-perldocopt'}) {
156 $opts{'-perldocopt'} =~ s/^\s+|\s+$//g;
157 push @perldoc_cmd, split(/\s+/, $opts{'-perldocopt'});
158 }
159 push @perldoc_cmd, ('-F', $f);
160 unshift @perldoc_cmd, $opts{'-perlcmd'} if $opts{'-perlcmd'};
161 system(@perldoc_cmd);
162 if($?) {
163 # RT16091: fall back to more if perldoc failed
164 system(($Config{pager} || $ENV{PAGER} || '/bin/more'), $1);
165 }
166 } else {
167 croak "Unspecified input file or insecure argument.\n";
168 }
169 }
170 else {
171 $parser->parse_from_file($opts{'-input'}, $opts{'-output'});
172 }
173
174 exit($opts{'-exitval'}) unless (lc($opts{'-exitval'}) eq 'noexit');
175}
176
177##---------------------------------------------------------------------------
178
179##-------------------------------
180## Method definitions begin here
181##-------------------------------
182
183sub new {
184 my $this = shift;
185 my $class = ref($this) || $this;
186 my %params = @_;
187 my $self = {%params};
188 bless $self, $class;
189 if ($self->can('initialize')) {
190 $self->initialize();
191 } else {
192 # pass through options to Pod::Text
193 my %opts;
194 for (qw(alt code indent loose margin quotes sentence stderr utf8 width)) {
195 my $val = $params{USAGE_OPTIONS}{"-$_"};
196 $opts{$_} = $val if defined $val;
197 }
198 $self = $self->SUPER::new(%opts);
199 %$self = (%$self, %params);
200 }
201 return $self;
202}
203
204# This subroutine was copied in whole-cloth from Pod::Select 1.60 in order to
205# allow the ejection of Pod::Select from the core without breaking Pod::Usage.
206# -- rjbs, 2013-03-18
207sub _compile_section_spec {
208 my ($section_spec) = @_;
209 my (@regexs, $negated);
210
211 ## Compile the spec into a list of regexs
212 local $_ = $section_spec;
213 s{\\\\}{\001}g; ## handle escaped backward slashes
214 s{\\/}{\002}g; ## handle escaped forward slashes
215
216 ## Parse the regexs for the heading titles
217 @regexs = split(/\//, $_, $MAX_HEADING_LEVEL);
218
219 ## Set default regex for ommitted levels
220 for (my $i = 0; $i < $MAX_HEADING_LEVEL; ++$i) {
221 $regexs[$i] = '.*' unless ((defined $regexs[$i])
222 && (length $regexs[$i]));
223 }
224 ## Modify the regexs as needed and validate their syntax
225 my $bad_regexs = 0;
226 for (@regexs) {
227 $_ .= '.+' if ($_ eq '!');
228 s{\001}{\\\\}g; ## restore escaped backward slashes
229 s{\002}{\\/}g; ## restore escaped forward slashes
230 $negated = s/^\!//; ## check for negation
231 eval "m{$_}"; ## check regex syntax
232 if ($@) {
233 ++$bad_regexs;
234 carp qq{Bad regular expression /$_/ in "$section_spec": $@\n};
235 }
236 else {
237 ## Add the forward and rear anchors (and put the negator back)
238 $_ = '^' . $_ unless (/^\^/);
239 $_ = $_ . '$' unless (/\$$/);
240 $_ = '!' . $_ if ($negated);
241 }
242 }
243 return (! $bad_regexs) ? [ @regexs ] : undef;
244}
245
246sub select {
247 my ($self, @sections) = @_;
248 if ($ISA[0]->can('select')) {
249 $self->SUPER::select(@sections);
250 } else {
251 # we're using Pod::Simple - need to mimic the behavior of Pod::Select
252 my $add = ($sections[0] eq '+') ? shift(@sections) : '';
253 ## Reset the set of sections to use
254 unless (@sections) {
255 delete $self->{USAGE_SELECT} unless ($add);
256 return;
257 }
258 $self->{USAGE_SELECT} = []
259 unless ($add && $self->{USAGE_SELECT});
260 my $sref = $self->{USAGE_SELECT};
261 ## Compile each spec
262 for my $spec (@sections) {
263 my $cs = _compile_section_spec($spec);
264 if ( defined $cs ) {
265 ## Store them in our sections array
266 push(@$sref, $cs);
267 } else {
268 carp qq{Ignoring section spec "$spec"!\n};
269 }
270 }
271 }
272}
273
274# Override Pod::Text->seq_i to return just "arg", not "*arg*".
275sub seq_i { return $_[1] }
276# Override Pod::Text->cmd_i to return just "arg", not "*arg*".
277# newer version based on Pod::Simple
278sub cmd_i { return $_[2] }
279
280# This overrides the Pod::Text method to do something very akin to what
281# Pod::Select did as well as the work done below by preprocess_paragraph.
282# Note that the below is very, very specific to Pod::Text and Pod::Simple.
283sub _handle_element_end {
284 my ($self, $element) = @_;
285 if ($element eq 'head1') {
286 $self->{USAGE_HEADINGS} = [ $$self{PENDING}[-1][1] ];
287 if ($self->{USAGE_OPTIONS}->{-verbose} < 2) {
288 $$self{PENDING}[-1][1] =~ s/^\s*SYNOPSIS\s*$/USAGE/;
289 }
290 } elsif ($element =~ /^head(\d+)$/ && $1) { # avoid 0
291 my $idx = $1 - 1;
292 $self->{USAGE_HEADINGS} = [] unless($self->{USAGE_HEADINGS});
293 $self->{USAGE_HEADINGS}->[$idx] = $$self{PENDING}[-1][1];
294 # we have to get rid of the lower headings
295 splice(@{$self->{USAGE_HEADINGS}},$idx+1);
296 }
297 if ($element =~ /^head\d+$/) {
298 $$self{USAGE_SKIPPING} = 1;
299 if (!$$self{USAGE_SELECT} || !@{ $$self{USAGE_SELECT} }) {
300 $$self{USAGE_SKIPPING} = 0;
301 } else {
302 my @headings = @{$$self{USAGE_HEADINGS}};
303 for my $section_spec ( @{$$self{USAGE_SELECT}} ) {
304 my $match = 1;
305 for (my $i = 0; $i < $MAX_HEADING_LEVEL; ++$i) {
306 $headings[$i] = '' unless defined $headings[$i];
307 my $regex = $section_spec->[$i];
308 my $negated = ($regex =~ s/^\!//);
309 $match &= ($negated ? ($headings[$i] !~ /${regex}/)
310 : ($headings[$i] =~ /${regex}/));
311 last unless ($match);
312 } # end heading levels
313 if ($match) {
314 $$self{USAGE_SKIPPING} = 0;
315 last;
316 }
317 } # end sections
318 }
319
320 # Try to do some lowercasing instead of all-caps in headings, and use
321 # a colon to end all headings.
322 if($self->{USAGE_OPTIONS}->{-verbose} < 2) {
323 local $_ = $$self{PENDING}[-1][1];
324 s{([A-Z])([A-Z]+)}{((length($2) > 2) ? $1 : lc($1)) . lc($2)}ge;
325 s/\s*$/:/ unless (/:\s*$/);
326 $_ .= "\n";
327 $$self{PENDING}[-1][1] = $_;
328 }
329 }
330 if ($$self{USAGE_SKIPPING} && $element !~ m/^over-|^[BCFILSZ]$/) {
331 pop @{ $$self{PENDING} };
332 } else {
333 $self->SUPER::_handle_element_end($element);
334 }
335}
336
337# required for Pod::Simple API
338sub start_document {
339 my $self = shift;
340 $self->SUPER::start_document();
341 my $msg = $self->{USAGE_OPTIONS}->{-message} or return 1;
342 my $out_fh = $self->output_fh();
343 print $out_fh "$msg\n";
344}
345
346# required for old Pod::Parser API
347sub begin_pod {
348 my $self = shift;
349 $self->SUPER::begin_pod(); ## Have to call superclass
350 my $msg = $self->{USAGE_OPTIONS}->{-message} or return 1;
351 my $out_fh = $self->output_handle();
352 print $out_fh "$msg\n";
353}
354
355sub preprocess_paragraph {
356 my $self = shift;
357 local $_ = shift;
358 my $line = shift;
359 ## See if this is a heading and we aren't printing the entire manpage.
360 if (($self->{USAGE_OPTIONS}->{-verbose} < 2) && /^=head/) {
361 ## Change the title of the SYNOPSIS section to USAGE
362 s/^=head1\s+SYNOPSIS\s*$/=head1 USAGE/;
363 ## Try to do some lowercasing instead of all-caps in headings
364 s{([A-Z])([A-Z]+)}{((length($2) > 2) ? $1 : lc($1)) . lc($2)}ge;
365 ## Use a colon to end all headings
366 s/\s*$/:/ unless (/:\s*$/);
367 $_ .= "\n";
368 }
369 return $self->SUPER::preprocess_paragraph($_);
370}
371
372112µs1; # keep require happy
373
374__END__
Report produced by the NYTProf 6.04 Perl profiler, developed by Tim Bunce based on work by Adam Kaplan and Salvador Fandiño García.