Profile of App/Cmd/Command.pm

← 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
Statements | Executed 31 statements in 863µs

Subroutines
Calls | P | F | Exclusive Time | Inclusive Time | Subroutine
--- | --- | --- | --- | --- | ---
5 | 3 | 2 | 31µs | 54µs | App::Cmd::Command::::command_namesApp::Cmd::Command::command_names
1 | 1 | 1 | 25µs | 718µs | App::Cmd::Command::::prepareApp::Cmd::Command::prepare
5 | 1 | 1 | 22µs | 22µs | App::Cmd::Command::::CORE:matchApp::Cmd::Command::CORE:match (opcode)
1 | 1 | 1 | 20µs | 20µs | App::Cmd::Command::::BEGIN@7App::Cmd::Command::BEGIN@7
1 | 1 | 1 | 13µs | 25µs | App::Cmd::Setup::::BEGIN@1.4 App::Cmd::Setup::BEGIN@1.4
1 | 1 | 1 | 10µs | 30µs | App::Cmd::Command::::_option_processing_paramsApp::Cmd::Command::_option_processing_params
1 | 1 | 1 | 8µs | 12µs | App::Cmd::Setup::::BEGIN@2.5 App::Cmd::Setup::BEGIN@2.5
1 | 1 | 1 | 8µs | 16µs | App::Cmd::Command::::usage_descApp::Cmd::Command::usage_desc
1 | 1 | 1 | 5µs | 5µs | App::Cmd::Command::::BEGIN@6App::Cmd::Command::BEGIN@6
1 | 1 | 1 | 5µs | 5µs | App::Cmd::Command::::newApp::Cmd::Command::new
1 | 1 | 1 | 3µs | 3µs | App::Cmd::Command::::BEGIN@11App::Cmd::Command::BEGIN@11
0 | 0 | 0 | 0s | 0s | App::Cmd::Command::::_usage_textApp::Cmd::Command::_usage_text
0 | 0 | 0 | 0s | 0s | App::Cmd::Command::::abstractApp::Cmd::Command::abstract
0 | 0 | 0 | 0s | 0s | App::Cmd::Command::::appApp::Cmd::Command::app
0 | 0 | 0 | 0s | 0s | App::Cmd::Command::::descriptionApp::Cmd::Command::description
0 | 0 | 0 | 0s | 0s | App::Cmd::Command::::executeApp::Cmd::Command::execute
0 | 0 | 0 | 0s | 0s | App::Cmd::Command::::opt_specApp::Cmd::Command::opt_spec
0 | 0 | 0 | 0s | 0s | App::Cmd::Command::::usageApp::Cmd::Command::usage
0 | 0 | 0 | 0s | 0s | App::Cmd::Command::::usage_errorApp::Cmd::Command::usage_error
0 | 0 | 0 | 0s | 0s | App::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
--- | --- | --- | --- | --- | ---
1 | 2 | 22µs | 2 | 37µ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
2 | 2 | 30µs | 2 | 16µ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 |  |  |  |  |
4 |  |  |  |  | package App::Cmd::Command;
5 | 1 | 500ns |  |  | $App::Cmd::Command::VERSION = '0.330';
6 | 2 | 30µs | 1 | 5µ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
7 | 1 | 50µs | 1 | 20µ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 |  |  |  |  |
11 | 2 | 624µs | 1 | 3µ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 {
28 | 1 | 900ns |  |  | my ($class, $app, @args) = @_;
29 |  |  |  |  |
30 | 1 | 12µs | 2 | 688µ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 (
34 | 1 | 9µs | 1 | 5µ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 {
41 | 1 | 1µs |  |  | my ($class, @args) = @_;
42 |  |  |  |  |
43 |  |  |  |  | return (
44 | 1 | 9µs | 2 | 20µ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 {
57 | 1 | 2µs |  |  | my ($class, $arg) = @_;
58 | 1 | 4µ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 |  |  |  |  |
74 |  |  |  |  | sub 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 |  |  |  |  |
93 |  |  |  |  | sub 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 |  |  |  |  |
102 |  |  |  |  | sub 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
121 | 5 | 39µs | 5 | 22µs | (ref( $_[0] ) || $_[0]) =~ /([^:]+)$/; # spent 22µs making 5 calls to App::Cmd::Command::CORE:match, avg 4µs/call
122 | 5 | 20µ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 {
136 | 1 | 500ns |  |  | my ($self) = @_;
137 |  |  |  |  |
138 | 1 | 4µs | 1 | 9µs | my ($command) = $self->command_names; # spent 9µs making 1 call to App::Cmd::Command::command_names
139 | 1 | 3µ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 |  |  |  |  |
152 |  |  |  |  | sub 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 |  |  |  |  |
167 |  |  |  |  | sub 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 |  |  |  |  |
178 |  |  |  |  | sub usage_error {
179 |  |  |  |  | my ( $self, $error ) = @_;
180 |  |  |  |  | die "Error: $error\nUsage: " . $self->_usage_text;
181 |  |  |  |  | }
182 |  |  |  |  |
183 |  |  |  |  | sub _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
199 |  |  |  |  | sub 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 |  |  |  |  |
248 |  |  |  |  | sub 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 |  |  |  |  |
276 | 1 | 2µs |  |  | 1;
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