← Index
NYTProf Performance Profile   « line view »
For script/ponapi
  Run on Wed Feb 10 15:51:26 2016
Reported on Thu Feb 11 09:43:09 2016

Filename/usr/local/share/perl/5.18.2/App/Cmd/Command.pm
StatementsExecuted 31 statements in 863µs
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
53231µs54µsApp::Cmd::Command::::command_namesApp::Cmd::Command::command_names
11125µs718µsApp::Cmd::Command::::prepareApp::Cmd::Command::prepare
51122µs22µsApp::Cmd::Command::::CORE:matchApp::Cmd::Command::CORE:match (opcode)
11120µs20µsApp::Cmd::Command::::BEGIN@7App::Cmd::Command::BEGIN@7
11113µs25µsApp::Cmd::Setup::::BEGIN@1.4 App::Cmd::Setup::BEGIN@1.4
11110µs30µsApp::Cmd::Command::::_option_processing_paramsApp::Cmd::Command::_option_processing_params
1118µs12µsApp::Cmd::Setup::::BEGIN@2.5 App::Cmd::Setup::BEGIN@2.5
1118µs16µsApp::Cmd::Command::::usage_descApp::Cmd::Command::usage_desc
1115µs5µsApp::Cmd::Command::::BEGIN@6App::Cmd::Command::BEGIN@6
1115µs5µsApp::Cmd::Command::::newApp::Cmd::Command::new
1113µs3µsApp::Cmd::Command::::BEGIN@11App::Cmd::Command::BEGIN@11
0000s0sApp::Cmd::Command::::_usage_textApp::Cmd::Command::_usage_text
0000s0sApp::Cmd::Command::::abstractApp::Cmd::Command::abstract
0000s0sApp::Cmd::Command::::appApp::Cmd::Command::app
0000s0sApp::Cmd::Command::::descriptionApp::Cmd::Command::description
0000s0sApp::Cmd::Command::::executeApp::Cmd::Command::execute
0000s0sApp::Cmd::Command::::opt_specApp::Cmd::Command::opt_spec
0000s0sApp::Cmd::Command::::usageApp::Cmd::Command::usage
0000s0sApp::Cmd::Command::::usage_errorApp::Cmd::Command::usage_error
0000s0sApp::Cmd::Command::::validate_argsApp::Cmd::Command::validate_args
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments
Time
on line
Calls Time
in subs
Code
1222µs237µs
# spent 25µs (13+12) within App::Cmd::Setup::BEGIN@1.4 which was called: # once (13µs+12µs) by App::Cmd::Setup::BEGIN@73 at line 1
use strict;
# spent 25µs making 1 call to App::Cmd::Setup::BEGIN@1.4 # spent 12µs making 1 call to strict::import
2230µs216µs
# spent 12µs (8+4) within App::Cmd::Setup::BEGIN@2.5 which was called: # once (8µs+4µs) by App::Cmd::Setup::BEGIN@73 at line 2
use warnings;
# spent 12µs making 1 call to App::Cmd::Setup::BEGIN@2.5 # spent 4µs making 1 call to warnings::import
3
4package App::Cmd::Command;
51500ns$App::Cmd::Command::VERSION = '0.330';
6230µs15µs
# spent 5µs within App::Cmd::Command::BEGIN@6 which was called: # once (5µs+0s) by App::Cmd::Setup::BEGIN@73 at line 6
use App::Cmd::ArgProcessor;
# spent 5µs making 1 call to App::Cmd::Command::BEGIN@6
7150µs120µs
# spent 20µs within App::Cmd::Command::BEGIN@7 which was called: # once (20µs+0s) by App::Cmd::Setup::BEGIN@73 at line 7
BEGIN { our @ISA = 'App::Cmd::ArgProcessor' };
# spent 20µs making 1 call to App::Cmd::Command::BEGIN@7
8
9# ABSTRACT: a base class for App::Cmd commands
10
112624µs13µs
# spent 3µs within App::Cmd::Command::BEGIN@11 which was called: # once (3µs+0s) by App::Cmd::Setup::BEGIN@73 at line 11
use Carp ();
# spent 3µs making 1 call to App::Cmd::Command::BEGIN@11
12
13#pod =method prepare
14#pod
15#pod my ($cmd, $opt, $args) = $class->prepare($app, @args);
16#pod
17#pod This method is the primary way in which App::Cmd::Command objects are built.
18#pod Given the remaining command line arguments meant for the command, it returns
19#pod the Command object, parsed options (as a hashref), and remaining arguments (as
20#pod an arrayref).
21#pod
22#pod In the usage above, C<$app> is the App::Cmd object that is invoking the
23#pod command.
24#pod
25#pod =cut
26
27
# spent 718µs (25+693) within App::Cmd::Command::prepare which was called: # once (25µs+693µs) by App::Cmd::_prepare_command at line 421 of App/Cmd.pm
sub prepare {
281900ns my ($class, $app, @args) = @_;
29
30112µs2688µs my ($opt, $args, %fields)
# spent 658µs making 1 call to App::Cmd::ArgProcessor::_process_args # spent 30µs making 1 call to App::Cmd::Command::_option_processing_params
31 = $class->_process_args(\@args, $class->_option_processing_params($app));
32
33 return (
3419µs15µs $class->new({ app => $app, %fields }),
# spent 5µs making 1 call to App::Cmd::Command::new
35 $opt,
36 @$args,
37 );
38}
39
40
# spent 30µs (10+20) within App::Cmd::Command::_option_processing_params which was called: # once (10µs+20µs) by App::Cmd::Command::prepare at line 30
sub _option_processing_params {
4111µs my ($class, @args) = @_;
42
43 return (
4419µs220µs $class->usage_desc(@args),
# spent 16µs making 1 call to App::Cmd::Command::usage_desc # spent 4µs making 1 call to PONAPI::CLI::Command::demo::opt_spec
45 $class->opt_spec(@args),
46 );
47}
48
49#pod =method new
50#pod
51#pod This returns a new instance of the command plugin. Probably only C<prepare>
52#pod should use this.
53#pod
54#pod =cut
55
56
# spent 5µs within App::Cmd::Command::new which was called: # once (5µs+0s) by App::Cmd::Command::prepare at line 34
sub new {
5712µs my ($class, $arg) = @_;
5814µs bless $arg => $class;
59}
60
61#pod =method execute
62#pod
63#pod $command_plugin->execute(\%opt, \@args);
64#pod
65#pod This method does whatever it is the command should do! It is passed a hash
66#pod reference of the parsed command-line options and an array reference of left
67#pod over arguments.
68#pod
69#pod If no C<execute> method is defined, it will try to call C<run> -- but it will
70#pod warn about this behavior during testing, to remind you to fix the method name!
71#pod
72#pod =cut
73
74sub execute {
75 my $class = shift;
76
77 if (my $run = $class->can('run')) {
78 warn "App::Cmd::Command subclasses should implement ->execute not ->run"
79 if $ENV{HARNESS_ACTIVE};
80
81 return $class->$run(@_);
82 }
83
84 Carp::croak ref($class) . " does not implement mandatory method 'execute'\n";
85}
86
87#pod =method app
88#pod
89#pod This method returns the App::Cmd object into which this command is plugged.
90#pod
91#pod =cut
92
93sub app { $_[0]->{app}; }
94
95#pod =method usage
96#pod
97#pod This method returns the usage object for this command. (See
98#pod L<Getopt::Long::Descriptive>).
99#pod
100#pod =cut
101
102sub usage { $_[0]->{usage}; }
103
104#pod =method command_names
105#pod
106#pod This method returns a list of command names handled by this plugin. The
107#pod first item returned is the 'canonical' name of the command.
108#pod
109#pod If this method is not overridden by an App::Cmd::Command subclass, it will
110#pod return the last part of the plugin's package name, converted to lowercase.
111#pod For example, YourApp::Cmd::Command::Init will, by default, handle the command
112#pod "init".
113#pod
114#pod Subclasses should generally get the superclass value of C<command_names>
115#pod and then append aliases.
116#pod
117#pod =cut
118
119
# spent 54µs (31+22) within App::Cmd::Command::command_names which was called 5 times, avg 11µs/call: # 3 times (20µs+15µs) by App::Cmd::_command at line 208 of App/Cmd.pm, avg 12µs/call # once (6µs+4µs) by App::Cmd::_load_default_plugin at line 288 of App/Cmd.pm # once (5µs+3µs) by App::Cmd::Command::usage_desc at line 138
sub command_names {
120 # from UNIVERSAL::moniker
121539µs522µs (ref( $_[0] ) || $_[0]) =~ /([^:]+)$/;
# spent 22µs making 5 calls to App::Cmd::Command::CORE:match, avg 4µs/call
122520µs return lc $1;
123}
124
125#pod =method usage_desc
126#pod
127#pod This method should be overridden to provide a usage string. (This is the first
128#pod argument passed to C<describe_options> from Getopt::Long::Descriptive.)
129#pod
130#pod If not overridden, it returns "%c COMMAND %o"; COMMAND is the first item in
131#pod the result of the C<command_names> method.
132#pod
133#pod =cut
134
135
# spent 16µs (8+9) within App::Cmd::Command::usage_desc which was called: # once (8µs+9µs) by App::Cmd::Command::_option_processing_params at line 44
sub usage_desc {
1361500ns my ($self) = @_;
137
13814µs19µs my ($command) = $self->command_names;
# spent 9µs making 1 call to App::Cmd::Command::command_names
13913µs return "%c $command %o"
140}
141
142#pod =method opt_spec
143#pod
144#pod This method should be overridden to provide option specifications. (This is
145#pod list of arguments passed to C<describe_options> from Getopt::Long::Descriptive,
146#pod after the first.)
147#pod
148#pod If not overridden, it returns an empty list.
149#pod
150#pod =cut
151
152sub opt_spec {
153 return;
154}
155
156#pod =method validate_args
157#pod
158#pod $command_plugin->validate_args(\%opt, \@args);
159#pod
160#pod This method is passed a hashref of command line options (as processed by
161#pod Getopt::Long::Descriptive) and an arrayref of leftover arguments. It may throw
162#pod an exception (preferably by calling C<usage_error>, below) if they are invalid,
163#pod or it may do nothing to allow processing to continue.
164#pod
165#pod =cut
166
167sub validate_args { }
168
169#pod =method usage_error
170#pod
171#pod $self->usage_error("This command must not be run by root!");
172#pod
173#pod This method should be called to die with human-friendly usage output, during
174#pod C<validate_args>.
175#pod
176#pod =cut
177
178sub usage_error {
179 my ( $self, $error ) = @_;
180 die "Error: $error\nUsage: " . $self->_usage_text;
181}
182
183sub _usage_text {
184 my ($self) = @_;
185 local $@;
186 join "\n", eval { $self->app->_usage_text }, eval { $self->usage->text };
187}
188
189#pod =method abstract
190#pod
191#pod This method returns a short description of the command's purpose. If this
192#pod method is not overridden, it will return the abstract from the module's Pod.
193#pod If it can't find the abstract, it will look for a comment starting with
194#pod "ABSTRACT:" like the ones used by L<Pod::Weaver::Section::Name>.
195#pod
196#pod =cut
197
198# stolen from ExtUtils::MakeMaker
199sub abstract {
200 my ($class) = @_;
201 $class = ref $class if ref $class;
202
203 my $result;
204 my $weaver_abstract;
205
206 # classname to filename
207 (my $pm_file = $class) =~ s!::!/!g;
208 $pm_file .= '.pm';
209 $pm_file = $INC{$pm_file} or return "(unknown)";
210
211 # if the pm file exists, open it and parse it
212 open my $fh, "<", $pm_file or return "(unknown)";
213
214 local $/ = "\n";
215 my $inpod;
216
217 while (local $_ = <$fh>) {
218 # =cut toggles, it doesn't end :-/
219 $inpod = /^=cut/ ? !$inpod : $inpod || /^=(?!cut)/;
220
221 if (/#+\s*ABSTRACT: (.*)/){
222 # takes ABSTRACT: ... if no POD defined yet
223 $weaver_abstract = $1;
224 }
225
226 next unless $inpod;
227 chomp;
228
229 next unless /^(?:$class\s-\s)(.*)/;
230
231 $result = $1;
232 last;
233 }
234
235 return $result || $weaver_abstract || "(unknown)";
236}
237
238#pod =method description
239#pod
240#pod This method can be overridden to provide full option description. It
241#pod is used by the built-in L<help|App::Cmd::Command::help> command.
242#pod
243#pod If not overridden, it uses L<Pod::Usage> to extract the description
244#pod from the module's Pod DESCRIPTION section or the empty string.
245#pod
246#pod =cut
247
248sub description {
249 my ($class) = @_;
250 $class = ref $class if ref $class;
251
252 # classname to filename
253 (my $pm_file = $class) =~ s!::!/!g;
254 $pm_file .= '.pm';
255 $pm_file = $INC{$pm_file} or return '';
256
257 open my $input, "<", $pm_file or return '';
258
259 my $descr = "";
260 open my $output, ">", \$descr;
261
262 require Pod::Usage;
263 Pod::Usage::pod2usage( -input => $input,
264 -output => $output,
265 -exit => "NOEXIT",
266 -verbose => 99,
267 -sections => "DESCRIPTION",
268 indent => 0
269 );
270 $descr =~ s/Description:\n//m;
271 chomp $descr;
272
273 return $descr;
274}
275
27612µs1;
277
278__END__
 
# spent 22µs within App::Cmd::Command::CORE:match which was called 5 times, avg 4µs/call: # 5 times (22µs+0s) by App::Cmd::Command::command_names at line 121, avg 4µs/call
sub App::Cmd::Command::CORE:match; # opcode