Filename | /usr/local/share/perl/5.18.2/App/Cmd/Command.pm |
Statements | Executed 31 statements in 863µs |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
5 | 3 | 2 | 31µs | 54µs | command_names | App::Cmd::Command::
1 | 1 | 1 | 25µs | 718µs | prepare | App::Cmd::Command::
5 | 1 | 1 | 22µs | 22µs | CORE:match (opcode) | App::Cmd::Command::
1 | 1 | 1 | 20µs | 20µs | BEGIN@7 | App::Cmd::Command::
1 | 1 | 1 | 13µs | 25µs | BEGIN@1.4 | App::Cmd::Setup::
1 | 1 | 1 | 10µs | 30µs | _option_processing_params | App::Cmd::Command::
1 | 1 | 1 | 8µs | 12µs | BEGIN@2.5 | App::Cmd::Setup::
1 | 1 | 1 | 8µs | 16µs | usage_desc | App::Cmd::Command::
1 | 1 | 1 | 5µs | 5µs | BEGIN@6 | App::Cmd::Command::
1 | 1 | 1 | 5µs | 5µs | new | App::Cmd::Command::
1 | 1 | 1 | 3µs | 3µs | BEGIN@11 | App::Cmd::Command::
0 | 0 | 0 | 0s | 0s | _usage_text | App::Cmd::Command::
0 | 0 | 0 | 0s | 0s | abstract | App::Cmd::Command::
0 | 0 | 0 | 0s | 0s | app | App::Cmd::Command::
0 | 0 | 0 | 0s | 0s | description | App::Cmd::Command::
0 | 0 | 0 | 0s | 0s | execute | App::Cmd::Command::
0 | 0 | 0 | 0s | 0s | opt_spec | App::Cmd::Command::
0 | 0 | 0 | 0s | 0s | usage | App::Cmd::Command::
0 | 0 | 0 | 0s | 0s | usage_error | App::Cmd::Command::
0 | 0 | 0 | 0s | 0s | validate_args | App::Cmd::Command::
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 # 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 # 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 # 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 # 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 # 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 | ||||
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 | ||||
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 | ||||
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 | ||||
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 | ||||
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 |