← Index
NYTProf Performance Profile   « line view »
For /Users/timbo/perl5/perlbrew/perls/perl-5.18.2/bin/perlcritic
  Run on Sat Mar 19 22:12:22 2016
Reported on Sat Mar 19 22:14:10 2016

Filename/Users/timbo/perl5/perlbrew/perls/perl-5.18.2/lib/5.18.2/Pod/Usage.pm
StatementsExecuted 21 statements in 1.70ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
1113.36ms4.13msPod::Usage::::BEGIN@21Pod::Usage::BEGIN@21
1112.91ms3.15msPod::Usage::::BEGIN@18Pod::Usage::BEGIN@18
1112.75ms26.3msPod::Usage::::BEGIN@24Pod::Usage::BEGIN@24
11112µs35µsPod::Usage::::BEGIN@11Pod::Usage::BEGIN@11
1118µs19µsPod::Usage::::BEGIN@19Pod::Usage::BEGIN@19
1117µs20µsPod::Usage::::BEGIN@20Pod::Usage::BEGIN@20
1116µs47µsPod::Usage::::BEGIN@13Pod::Usage::BEGIN@13
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;
11224µs259µs
# spent 35µs (12+23) within Pod::Usage::BEGIN@11 which was called: # once (12µs+23µs) by Perl::Critic::Command::BEGIN@19 at line 11
use strict;
# spent 35µs making 1 call to Pod::Usage::BEGIN@11 # spent 23µs making 1 call to strict::import
12
13233µs288µs
# spent 47µs (6+41) within Pod::Usage::BEGIN@13 which was called: # once (6µs+41µs) by Perl::Critic::Command::BEGIN@19 at line 13
use vars qw($VERSION @ISA @EXPORT);
# spent 47µs making 1 call to Pod::Usage::BEGIN@13 # spent 41µs making 1 call to vars::import
141700ns$VERSION = '1.61'; ## Current version of this package
1518µsrequire 5.005; ## requires this Perl version or later
16
17#use diagnostics;
18284µs23.18ms
# spent 3.15ms (2.91+237µs) within Pod::Usage::BEGIN@18 which was called: # once (2.91ms+237µs) by Perl::Critic::Command::BEGIN@19 at line 18
use Carp;
# spent 3.15ms making 1 call to Pod::Usage::BEGIN@18 # spent 33µs making 1 call to Exporter::import
19220µs231µs
# spent 19µs (8+11) within Pod::Usage::BEGIN@19 which was called: # once (8µs+11µs) by Perl::Critic::Command::BEGIN@19 at line 19
use Config;
# spent 19µs making 1 call to Pod::Usage::BEGIN@19 # spent 11µs making 1 call to Config::import
20218µs232µs
# spent 20µs (7+12) within Pod::Usage::BEGIN@20 which was called: # once (7µs+12µs) by Perl::Critic::Command::BEGIN@19 at line 20
use Exporter;
# spent 20µs making 1 call to Pod::Usage::BEGIN@20 # spent 12µs making 1 call to Exporter::import
212143µs14.13ms
# spent 4.13ms (3.36+772µs) within Pod::Usage::BEGIN@21 which was called: # once (3.36ms+772µs) by Perl::Critic::Command::BEGIN@19 at line 21
use File::Spec;
# spent 4.13ms making 1 call to Pod::Usage::BEGIN@21
22
2311µs@EXPORT = qw(&pod2usage);
24
# spent 26.3ms (2.75+23.6) within Pod::Usage::BEGIN@24 which was called: # once (2.75ms+23.6ms) by Perl::Critic::Command::BEGIN@19 at line 30
BEGIN {
2511µs $Pod::Usage::Formatter ||=
26 ( $] >= 5.005_58 ? 'Pod::Text' : 'Pod::PlainText');
27115µs eval "require $Pod::Usage::Formatter";
# spent 78µs executing statements in string eval
281300ns die $@ if $@;
29112µs @ISA = ( $Pod::Usage::Formatter );
3011.25ms126.3ms}
# spent 26.3ms making 1 call to Pod::Usage::BEGIN@24
31
32186µsrequire Pod::Select;
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 doesnt 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 = File::Spec->catfile($Config{scriptdirexp}
133 || $Config{scriptdir}, 'perldoc');
134
135 my $version = sprintf("%vd",$^V);
136 if ($Config{versiononly} and $Config{startperl} =~ /\Q$version\E$/ ) {
137 $progpath .= $version;
138 }
139 $opts{'-noperldoc'} = 1 unless -e $progpath;
140
141 ## Now translate the pod document and then exit with the desired status
142 if ( !$opts{'-noperldoc'}
143 and $opts{'-verbose'} >= 2
144 and !ref($opts{'-input'})
145 and $opts{'-output'} == \*STDOUT )
146 {
147 ## spit out the entire PODs. Might as well invoke perldoc
148 print { $opts{'-output'} } ($opts{'-message'}, "\n") if($opts{'-message'});
149 if(defined $opts{-input} && $opts{-input} =~ /^\s*(\S.*?)\s*$/) {
150 # the perldocs back to 5.005 should all have -F
151 # without -F there are warnings in -T scripts
152 system($progpath, '-F', $1);
153 if($?) {
154 # RT16091: fall back to more if perldoc failed
155 system(($Config{pager} || $ENV{PAGER} || '/bin/more'), $1);
156 }
157 } else {
158 croak "Unspecified input file or insecure argument.\n";
159 }
160 }
161 else {
162 $parser->parse_from_file($opts{'-input'}, $opts{'-output'});
163 }
164
165 exit($opts{'-exitval'}) unless (lc($opts{'-exitval'}) eq 'noexit');
166}
167
168##---------------------------------------------------------------------------
169
170##-------------------------------
171## Method definitions begin here
172##-------------------------------
173
174sub new {
175 my $this = shift;
176 my $class = ref($this) || $this;
177 my %params = @_;
178 my $self = {%params};
179 bless $self, $class;
180 if ($self->can('initialize')) {
181 $self->initialize();
182 } else {
183 # pass through options to Pod::Text
184 my %opts;
185 for (qw(alt code indent loose margin quotes sentence stderr utf8 width)) {
186 my $val = $params{USAGE_OPTIONS}{"-$_"};
187 $opts{$_} = $val if defined $val;
188 }
189 $self = $self->SUPER::new(%opts);
190 %$self = (%$self, %params);
191 }
192 return $self;
193}
194
195sub select {
196 my ($self, @sections) = @_;
197 if ($ISA[0]->can('select')) {
198 $self->SUPER::select(@sections);
199 } else {
200 # we're using Pod::Simple - need to mimic the behavior of Pod::Select
201 my $add = ($sections[0] eq '+') ? shift(@sections) : '';
202 ## Reset the set of sections to use
203 unless (@sections) {
204 delete $self->{USAGE_SELECT} unless ($add);
205 return;
206 }
207 $self->{USAGE_SELECT} = []
208 unless ($add && $self->{USAGE_SELECT});
209 my $sref = $self->{USAGE_SELECT};
210 ## Compile each spec
211 for my $spec (@sections) {
212 my $cs = Pod::Select::_compile_section_spec($spec);
213 if ( defined $cs ) {
214 ## Store them in our sections array
215 push(@$sref, $cs);
216 } else {
217 carp qq{Ignoring section spec "$spec"!\n};
218 }
219 }
220 }
221}
222
223# Override Pod::Text->seq_i to return just "arg", not "*arg*".
224sub seq_i { return $_[1] }
225
226# This overrides the Pod::Text method to do something very akin to what
227# Pod::Select did as well as the work done below by preprocess_paragraph.
228# Note that the below is very, very specific to Pod::Text.
229sub _handle_element_end {
230 my ($self, $element) = @_;
231 if ($element eq 'head1') {
232 $self->{USAGE_HEADINGS} = [ $$self{PENDING}[-1][1] ];
233 if ($self->{USAGE_OPTIONS}->{-verbose} < 2) {
234 $$self{PENDING}[-1][1] =~ s/^\s*SYNOPSIS\s*$/USAGE/;
235 }
236 } elsif ($element =~ /^head(\d+)$/ && $1) { # avoid 0
237 my $idx = $1 - 1;
238 $self->{USAGE_HEADINGS} = [] unless($self->{USAGE_HEADINGS});
239 $self->{USAGE_HEADINGS}->[$idx] = $$self{PENDING}[-1][1];
240 }
241 if ($element =~ /^head\d+$/) {
242 $$self{USAGE_SKIPPING} = 1;
243 if (!$$self{USAGE_SELECT} || !@{ $$self{USAGE_SELECT} }) {
244 $$self{USAGE_SKIPPING} = 0;
245 } else {
246 my @headings = @{$$self{USAGE_HEADINGS}};
247 for my $section_spec ( @{$$self{USAGE_SELECT}} ) {
248 my $match = 1;
249 for (my $i = 0; $i < $Pod::Select::MAX_HEADING_LEVEL; ++$i) {
250 $headings[$i] = '' unless defined $headings[$i];
251 my $regex = $section_spec->[$i];
252 my $negated = ($regex =~ s/^\!//);
253 $match &= ($negated ? ($headings[$i] !~ /${regex}/)
254 : ($headings[$i] =~ /${regex}/));
255 last unless ($match);
256 } # end heading levels
257 if ($match) {
258 $$self{USAGE_SKIPPING} = 0;
259 last;
260 }
261 } # end sections
262 }
263
264 # Try to do some lowercasing instead of all-caps in headings, and use
265 # a colon to end all headings.
266 if($self->{USAGE_OPTIONS}->{-verbose} < 2) {
267 local $_ = $$self{PENDING}[-1][1];
268 s{([A-Z])([A-Z]+)}{((length($2) > 2) ? $1 : lc($1)) . lc($2)}ge;
269 s/\s*$/:/ unless (/:\s*$/);
270 $_ .= "\n";
271 $$self{PENDING}[-1][1] = $_;
272 }
273 }
274 if ($$self{USAGE_SKIPPING} && $element !~ m/^over-/) {
275 pop @{ $$self{PENDING} };
276 } else {
277 $self->SUPER::_handle_element_end($element);
278 }
279}
280
281# required for Pod::Simple API
282sub start_document {
283 my $self = shift;
284 $self->SUPER::start_document();
285 my $msg = $self->{USAGE_OPTIONS}->{-message} or return 1;
286 my $out_fh = $self->output_fh();
287 print $out_fh "$msg\n";
288}
289
290# required for old Pod::Parser API
291sub begin_pod {
292 my $self = shift;
293 $self->SUPER::begin_pod(); ## Have to call superclass
294 my $msg = $self->{USAGE_OPTIONS}->{-message} or return 1;
295 my $out_fh = $self->output_handle();
296 print $out_fh "$msg\n";
297}
298
299sub preprocess_paragraph {
300 my $self = shift;
301 local $_ = shift;
302 my $line = shift;
303 ## See if this is a heading and we arent printing the entire manpage.
304 if (($self->{USAGE_OPTIONS}->{-verbose} < 2) && /^=head/) {
305 ## Change the title of the SYNOPSIS section to USAGE
306 s/^=head1\s+SYNOPSIS\s*$/=head1 USAGE/;
307 ## Try to do some lowercasing instead of all-caps in headings
308 s{([A-Z])([A-Z]+)}{((length($2) > 2) ? $1 : lc($1)) . lc($2)}ge;
309 ## Use a colon to end all headings
310 s/\s*$/:/ unless (/:\s*$/);
311 $_ .= "\n";
312 }
313 return $self->SUPER::preprocess_paragraph($_);
314}
315
31614µs1; # keep require happy
317
318__END__
Report produced by the NYTProf 6.01 Perl profiler, developed by Tim Bunce and Adam Kaplan.