Filename | /usr/local/share/perl/5.18.2/App/Cmd.pm |
Statements | Executed 220 statements in 3.54ms |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
1 | 1 | 1 | 2.14ms | 18.3ms | BEGIN@12 | App::Cmd::
1 | 1 | 1 | 1.90ms | 2.53ms | BEGIN@15 | App::Cmd::
1 | 1 | 1 | 1.57ms | 1.68ms | BEGIN@11 | App::Cmd::
1 | 1 | 1 | 944µs | 12.3ms | BEGIN@13 | App::Cmd::
1 | 1 | 1 | 390µs | 429µs | BEGIN@7 | App::Cmd::
3 | 3 | 1 | 124µs | 54.2ms | _command | App::Cmd::
3 | 1 | 1 | 94µs | 206µs | _setup_command | App::Cmd::
3 | 1 | 1 | 50µs | 2.51ms | _load_default_plugin | App::Cmd::
4 | 2 | 1 | 41µs | 4.02ms | _plugins | App::Cmd::
1 | 1 | 1 | 30µs | 36µs | global_opt_spec | App::Cmd::
1 | 1 | 1 | 28µs | 19.4ms | get_command | App::Cmd::
1 | 1 | 1 | 23µs | 20.2ms | prepare_command | App::Cmd::
1 | 1 | 1 | 21µs | 30µs | BEGIN@1 | App::Cmd::Setup::
1 | 1 | 1 | 21µs | 21µs | BEGIN@3 | App::Cmd::Setup::
3 | 1 | 1 | 18µs | 25µs | _register_command | App::Cmd::
1 | 1 | 1 | 16µs | 54.3ms | new | App::Cmd::
3 | 1 | 1 | 15µs | 15µs | should_ignore | App::Cmd::
1 | 1 | 1 | 15µs | 745µs | _prepare_command | App::Cmd::
1 | 1 | 1 | 14µs | 20µs | plugin_search_path | App::Cmd::
1 | 1 | 1 | 13µs | 50µs | _global_option_processing_params | App::Cmd::
1 | 1 | 1 | 9µs | 13µs | plugin_for | App::Cmd::
1 | 1 | 1 | 7µs | 7µs | BEGIN@8 | App::Cmd::
1 | 1 | 1 | 7µs | 40µs | BEGIN@346 | App::Cmd::
1 | 1 | 1 | 6µs | 14µs | BEGIN@36 | App::Cmd::
1 | 1 | 1 | 5µs | 8µs | BEGIN@2 | App::Cmd::Setup::
2 | 2 | 2 | 4µs | 4µs | _default_command_base | App::Cmd::
4 | 1 | 1 | 4µs | 4µs | CORE:subst (opcode) | App::Cmd::
1 | 1 | 1 | 3µs | 3µs | _default_plugin_base | App::Cmd::
1 | 1 | 1 | 3µs | 3µs | prepare_args | App::Cmd::
1 | 1 | 1 | 2µs | 2µs | _cmd_from_args | App::Cmd::
1 | 1 | 1 | 2µs | 2µs | CORE:sort (opcode) | App::Cmd::
1 | 1 | 1 | 2µs | 2µs | set_global_options | App::Cmd::
1 | 1 | 1 | 1µs | 1µs | allow_any_unambiguous_abbrev | App::Cmd::
1 | 1 | 1 | 1µs | 1µs | usage_desc | App::Cmd::
1 | 1 | 1 | 900ns | 900ns | _module_pluggable_options | App::Cmd::
0 | 0 | 0 | 0s | 0s | END | App::Cmd::
0 | 0 | 0 | 0s | 0s | __ANON__[:22] | App::Cmd::
0 | 0 | 0 | 0s | 0s | _bad_command | App::Cmd::
0 | 0 | 0 | 0s | 0s | _plugin_plugins | App::Cmd::
0 | 0 | 0 | 0s | 0s | _prepare_default_command | App::Cmd::
0 | 0 | 0 | 0s | 0s | _register_ignore | App::Cmd::
0 | 0 | 0 | 0s | 0s | _setup_ignore | App::Cmd::
0 | 0 | 0 | 0s | 0s | _usage_text | App::Cmd::
0 | 0 | 0 | 0s | 0s | arg0 | App::Cmd::
0 | 0 | 0 | 0s | 0s | command_groups | App::Cmd::
0 | 0 | 0 | 0s | 0s | command_names | App::Cmd::
0 | 0 | 0 | 0s | 0s | command_plugins | App::Cmd::
0 | 0 | 0 | 0s | 0s | default_command | App::Cmd::
0 | 0 | 0 | 0s | 0s | execute_command | App::Cmd::
0 | 0 | 0 | 0s | 0s | full_arg0 | App::Cmd::
0 | 0 | 0 | 0s | 0s | global_options | App::Cmd::
0 | 0 | 0 | 0s | 0s | run | App::Cmd::
0 | 0 | 0 | 0s | 0s | usage | App::Cmd::
0 | 0 | 0 | 0s | 0s | usage_error | App::Cmd::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | 2 | 19µs | 2 | 39µs | # spent 30µs (21+9) within App::Cmd::Setup::BEGIN@1 which was called:
# once (21µs+9µs) by App::Cmd::Setup::BEGIN@72 at line 1 # spent 30µs making 1 call to App::Cmd::Setup::BEGIN@1
# spent 9µs making 1 call to strict::import |
2 | 2 | 18µs | 2 | 11µs | # spent 8µs (5+3) within App::Cmd::Setup::BEGIN@2 which was called:
# once (5µs+3µs) by App::Cmd::Setup::BEGIN@72 at line 2 # spent 8µs making 1 call to App::Cmd::Setup::BEGIN@2
# spent 3µs making 1 call to warnings::import |
3 | 2 | 56µs | 1 | 21µs | # spent 21µs within App::Cmd::Setup::BEGIN@3 which was called:
# once (21µs+0s) by App::Cmd::Setup::BEGIN@72 at line 3 # spent 21µs making 1 call to App::Cmd::Setup::BEGIN@3 |
4 | |||||
5 | package App::Cmd; | ||||
6 | 1 | 400ns | $App::Cmd::VERSION = '0.330'; | ||
7 | 2 | 322µs | 1 | 429µs | # spent 429µs (390+39) within App::Cmd::BEGIN@7 which was called:
# once (390µs+39µs) by App::Cmd::Setup::BEGIN@72 at line 7 # spent 429µs making 1 call to App::Cmd::BEGIN@7 |
8 | 1 | 22µs | 1 | 7µs | # spent 7µs within App::Cmd::BEGIN@8 which was called:
# once (7µs+0s) by App::Cmd::Setup::BEGIN@72 at line 8 # spent 7µs making 1 call to App::Cmd::BEGIN@8 |
9 | # ABSTRACT: write command line apps with less suffering | ||||
10 | |||||
11 | 2 | 112µs | 1 | 1.68ms | # spent 1.68ms (1.57+111µs) within App::Cmd::BEGIN@11 which was called:
# once (1.57ms+111µs) by App::Cmd::Setup::BEGIN@72 at line 11 # spent 1.68ms making 1 call to App::Cmd::BEGIN@11 |
12 | 2 | 441µs | 1 | 18.3ms | # spent 18.3ms (2.14+16.2) within App::Cmd::BEGIN@12 which was called:
# once (2.14ms+16.2ms) by App::Cmd::Setup::BEGIN@72 at line 12 # spent 18.3ms making 1 call to App::Cmd::BEGIN@12 |
13 | 2 | 126µs | 1 | 12.3ms | # spent 12.3ms (944µs+11.3) within App::Cmd::BEGIN@13 which was called:
# once (944µs+11.3ms) by App::Cmd::Setup::BEGIN@72 at line 13 # spent 12.3ms making 1 call to App::Cmd::BEGIN@13 |
14 | |||||
15 | # spent 2.53ms (1.90+627µs) within App::Cmd::BEGIN@15 which was called:
# once (1.90ms+627µs) by App::Cmd::Setup::BEGIN@72 at line 24 | ||||
16 | collectors => { | ||||
17 | -ignore => \'_setup_ignore', | ||||
18 | -command => \'_setup_command', | ||||
19 | -run => sub { | ||||
20 | warn "using -run to run your command is deprecated\n"; | ||||
21 | $_[1]->{class}->run; 1 | ||||
22 | }, | ||||
23 | }, | ||||
24 | 2 | 111µs | 2 | 2.79ms | }; # spent 2.53ms making 1 call to App::Cmd::BEGIN@15
# spent 268µs making 1 call to Sub::Exporter::__ANON__[Sub/Exporter.pm:337] |
25 | |||||
26 | # spent 206µs (94+112) within App::Cmd::_setup_command which was called 3 times, avg 69µs/call:
# 3 times (94µs+112µs) by Sub::Exporter::__ANON__[/usr/local/share/perl/5.18.2/Sub/Exporter.pm:159] at line 151 of Sub/Exporter.pm, avg 69µs/call | ||||
27 | 3 | 2µs | my ($self, $val, $data) = @_; | ||
28 | 3 | 1µs | my $into = $data->{into}; | ||
29 | |||||
30 | 3 | 24µs | 3 | 6µs | Carp::confess "App::Cmd -command setup requested for already-setup class" # spent 6µs making 3 calls to UNIVERSAL::isa, avg 2µs/call |
31 | if $into->isa('App::Cmd::Command'); | ||||
32 | |||||
33 | { | ||||
34 | 6 | 11µs | 3 | 4µs | my $base = $self->_default_command_base; # spent 4µs making 3 calls to App::Cmd::Setup::__ANON__[App/Cmd/Setup.pm:114], avg 1µs/call |
35 | 3 | 4µs | 3 | 0s | Class::Load::load_class($base); # spent 74µs making 3 calls to Class::Load::load_class, avg 25µs/call, recursion: max depth 1, sum of overlapping time 74µs |
36 | 2 | 845µs | 2 | 23µs | # spent 14µs (6+8) within App::Cmd::BEGIN@36 which was called:
# once (6µs+8µs) by App::Cmd::Setup::BEGIN@72 at line 36 # spent 14µs making 1 call to App::Cmd::BEGIN@36
# spent 8µs making 1 call to strict::unimport |
37 | 3 | 27µs | push @{"$into\::ISA"}, $base; | ||
38 | } | ||||
39 | |||||
40 | 3 | 6µs | 3 | 25µs | $self->_register_command($into); # spent 25µs making 3 calls to App::Cmd::_register_command, avg 8µs/call |
41 | |||||
42 | 3 | 8µs | 3 | 3µs | for my $plugin ($self->_plugin_plugins) { # spent 3µs making 3 calls to App::Cmd::Setup::__ANON__[App/Cmd/Setup.pm:142], avg 967ns/call |
43 | $plugin->import_from_plugin({ into => $into }); | ||||
44 | } | ||||
45 | |||||
46 | 3 | 12µs | 1; | ||
47 | } | ||||
48 | |||||
49 | sub _setup_ignore { | ||||
50 | my ($self, $val, $data ) = @_; | ||||
51 | my $into = $data->{into}; | ||||
52 | |||||
53 | Carp::confess "App::Cmd -ignore setup requested for already-setup class" | ||||
54 | if $into->isa('App::Cmd::Command'); | ||||
55 | |||||
56 | $self->_register_ignore($into); | ||||
57 | |||||
58 | 1; | ||||
59 | } | ||||
60 | |||||
61 | sub _plugin_plugins { return } | ||||
62 | |||||
63 | #pod =head1 SYNOPSIS | ||||
64 | #pod | ||||
65 | #pod in F<yourcmd>: | ||||
66 | #pod | ||||
67 | #pod use YourApp; | ||||
68 | #pod YourApp->run; | ||||
69 | #pod | ||||
70 | #pod in F<YourApp.pm>: | ||||
71 | #pod | ||||
72 | #pod package YourApp; | ||||
73 | #pod use App::Cmd::Setup -app; | ||||
74 | #pod 1; | ||||
75 | #pod | ||||
76 | #pod in F<YourApp/Command/blort.pm>: | ||||
77 | #pod | ||||
78 | #pod package YourApp::Command::blort; | ||||
79 | #pod use YourApp -command; | ||||
80 | #pod use strict; use warnings; | ||||
81 | #pod | ||||
82 | #pod sub abstract { "blortex algorithm" } | ||||
83 | #pod | ||||
84 | #pod sub description { "Long description on blortex algorithm" } | ||||
85 | #pod | ||||
86 | #pod sub opt_spec { | ||||
87 | #pod return ( | ||||
88 | #pod [ "blortex|X", "use the blortex algorithm" ], | ||||
89 | #pod [ "recheck|r", "recheck all results" ], | ||||
90 | #pod ); | ||||
91 | #pod } | ||||
92 | #pod | ||||
93 | #pod sub validate_args { | ||||
94 | #pod my ($self, $opt, $args) = @_; | ||||
95 | #pod | ||||
96 | #pod # no args allowed but options! | ||||
97 | #pod $self->usage_error("No args allowed") if @$args; | ||||
98 | #pod } | ||||
99 | #pod | ||||
100 | #pod sub execute { | ||||
101 | #pod my ($self, $opt, $args) = @_; | ||||
102 | #pod | ||||
103 | #pod my $result = $opt->{blortex} ? blortex() : blort(); | ||||
104 | #pod | ||||
105 | #pod recheck($result) if $opt->{recheck}; | ||||
106 | #pod | ||||
107 | #pod print $result; | ||||
108 | #pod } | ||||
109 | #pod | ||||
110 | #pod and, finally, at the command line: | ||||
111 | #pod | ||||
112 | #pod knight!rjbs$ yourcmd blort --recheck | ||||
113 | #pod | ||||
114 | #pod All blorts successful. | ||||
115 | #pod | ||||
116 | #pod =head1 DESCRIPTION | ||||
117 | #pod | ||||
118 | #pod App::Cmd is intended to make it easy to write complex command-line applications | ||||
119 | #pod without having to think about most of the annoying things usually involved. | ||||
120 | #pod | ||||
121 | #pod For information on how to start using App::Cmd, see L<App::Cmd::Tutorial>. | ||||
122 | #pod | ||||
123 | #pod =method new | ||||
124 | #pod | ||||
125 | #pod my $cmd = App::Cmd->new(\%arg); | ||||
126 | #pod | ||||
127 | #pod This method returns a new App::Cmd object. During initialization, command | ||||
128 | #pod plugins will be loaded. | ||||
129 | #pod | ||||
130 | #pod Valid arguments are: | ||||
131 | #pod | ||||
132 | #pod no_commands_plugin - if true, the command list plugin is not added | ||||
133 | #pod | ||||
134 | #pod no_help_plugin - if true, the help plugin is not added | ||||
135 | #pod | ||||
136 | #pod no_version_plugin - if true, the version plugin is not added | ||||
137 | #pod | ||||
138 | #pod show_version_cmd - if true, the version command will be shown in the | ||||
139 | #pod command list | ||||
140 | #pod | ||||
141 | #pod plugin_search_path - The path to search for commands in. Defaults to | ||||
142 | #pod results of plugin_search_path method | ||||
143 | #pod | ||||
144 | #pod If C<no_commands_plugin> is not given, L<App::Cmd::Command::commands> will be | ||||
145 | #pod required, and it will be registered to handle all of its command names not | ||||
146 | #pod handled by other plugins. | ||||
147 | #pod | ||||
148 | #pod If C<no_help_plugin> is not given, L<App::Cmd::Command::help> will be required, | ||||
149 | #pod and it will be registered to handle all of its command names not handled by | ||||
150 | #pod other plugins. B<Note:> "help" is the default command, so if you do not load | ||||
151 | #pod the default help plugin, you should provide your own or override the | ||||
152 | #pod C<default_command> method. | ||||
153 | #pod | ||||
154 | #pod If C<no_version_plugin> is not given, L<App::Cmd::Command::version> will be | ||||
155 | #pod required to show the application's version with command C<--version>. By | ||||
156 | #pod default, the version command is not included in the command list. Pass | ||||
157 | #pod C<show_version_cmd> to include the version command in the list. | ||||
158 | #pod | ||||
159 | #pod =cut | ||||
160 | |||||
161 | # spent 54.3ms (16µs+54.2) within App::Cmd::new which was called:
# once (16µs+54.2ms) by App::Cmd::run at line 314 | ||||
162 | 1 | 600ns | my ($class, $arg) = @_; | ||
163 | |||||
164 | 1 | 1µs | my $arg0 = $0; | ||
165 | 1 | 4µs | 1 | 59µs | my $base = File::Basename::basename $arg0; # spent 59µs making 1 call to File::Basename::basename |
166 | |||||
167 | 1 | 7µs | 1 | 54.2ms | my $self = { # spent 54.2ms making 1 call to App::Cmd::_command |
168 | command => $class->_command($arg), | ||||
169 | arg0 => $base, | ||||
170 | full_arg0 => $arg0, | ||||
171 | show_version => $arg->{show_version_cmd} || 0, | ||||
172 | }; | ||||
173 | |||||
174 | 1 | 6µs | bless $self => $class; | ||
175 | } | ||||
176 | |||||
177 | # effectively, returns the command-to-plugin mapping guts of a Cmd | ||||
178 | # if called on a class or on a Cmd with no mapping, construct a new hashref | ||||
179 | # suitable for use as the object's mapping | ||||
180 | sub _command { | ||||
181 | 3 | 1µs | my ($self, $arg) = @_; | ||
182 | 3 | 6µs | return $self->{command} if ref $self and $self->{command}; | ||
183 | |||||
184 | # TODO _default_command_base can be wrong if people are not using | ||||
185 | # ::Setup and have no ::Command :( | ||||
186 | # | ||||
187 | # my $want_isa = $self->_default_command_base; | ||||
188 | # -- kentnl, 2010-12 | ||||
189 | 1 | 300ns | my $want_isa = 'App::Cmd::Command'; | ||
190 | |||||
191 | 1 | 200ns | my %plugin; | ||
192 | 1 | 3µs | 1 | 4.01ms | for my $plugin ($self->_plugins) { # spent 4.01ms making 1 call to App::Cmd::_plugins |
193 | |||||
194 | 3 | 5µs | 3 | 47.5ms | Class::Load::load_class($plugin); # spent 47.5ms making 3 calls to Class::Load::load_class, avg 15.8ms/call |
195 | |||||
196 | # relies on either the plugin itself registering as ignored | ||||
197 | # during compile ( use MyApp::Cmd -ignore ) | ||||
198 | # or being explicitly registered elsewhere ( blacklisted ) | ||||
199 | # via $app_cmd->_register_ignore( $class ) | ||||
200 | # -- kentnl, 2011-09 | ||||
201 | 3 | 14µs | 3 | 15µs | next if $self->should_ignore( $plugin ); # spent 15µs making 3 calls to App::Cmd::should_ignore, avg 5µs/call |
202 | |||||
203 | 3 | 28µs | 3 | 6µs | die "$plugin is not a " . $want_isa # spent 6µs making 3 calls to UNIVERSAL::isa, avg 2µs/call |
204 | unless $plugin->isa($want_isa); | ||||
205 | |||||
206 | 3 | 29µs | 3 | 10µs | next unless $plugin->can("command_names"); # spent 10µs making 3 calls to UNIVERSAL::can, avg 4µs/call |
207 | |||||
208 | 3 | 14µs | 3 | 36µs | foreach my $command (map { lc } $plugin->command_names) { # spent 36µs making 3 calls to App::Cmd::Command::command_names, avg 12µs/call |
209 | 3 | 2µs | die "two plugins for command $command: $plugin and $plugin{$command}\n" | ||
210 | if exists $plugin{$command}; | ||||
211 | |||||
212 | 3 | 4µs | $plugin{$command} = $plugin; | ||
213 | } | ||||
214 | } | ||||
215 | |||||
216 | 1 | 10µs | 3 | 2.51ms | $self->_load_default_plugin($_, $arg, \%plugin) for qw(commands help version); # spent 2.51ms making 3 calls to App::Cmd::_load_default_plugin, avg 836µs/call |
217 | |||||
218 | 1 | 5µs | 1 | 1µs | if ($self->allow_any_unambiguous_abbrev) { # spent 1µs making 1 call to App::Cmd::allow_any_unambiguous_abbrev |
219 | # add abbreviations to list of authorized commands | ||||
220 | require Text::Abbrev; | ||||
221 | my %abbrev = Text::Abbrev::abbrev( keys %plugin ); | ||||
222 | @plugin{ keys %abbrev } = @plugin{ values %abbrev }; | ||||
223 | } | ||||
224 | |||||
225 | 1 | 3µs | return \%plugin; | ||
226 | } | ||||
227 | |||||
228 | # ->_plugins won't be called more than once on any given App::Cmd, but since | ||||
229 | # finding plugins can be a bit expensive, we'll do a lousy cache here. | ||||
230 | # -- rjbs, 2007-10-09 | ||||
231 | 1 | 200ns | my %plugins_for; | ||
232 | sub _plugins { | ||||
233 | 4 | 2µs | my ($self) = @_; | ||
234 | 4 | 2µs | my $class = ref $self || $self; | ||
235 | |||||
236 | 4 | 9µs | return @{ $plugins_for{$class} } if $plugins_for{$class}; | ||
237 | |||||
238 | 1 | 8µs | 3 | 24µs | my $finder = Module::Pluggable::Object->new( # spent 20µs making 1 call to App::Cmd::plugin_search_path
# spent 4µs making 1 call to Module::Pluggable::Object::new
# spent 900ns making 1 call to App::Cmd::_module_pluggable_options |
239 | search_path => $self->plugin_search_path, | ||||
240 | $self->_module_pluggable_options, | ||||
241 | ); | ||||
242 | |||||
243 | 1 | 3µs | 1 | 3.96ms | my @plugins = $finder->plugins; # spent 3.96ms making 1 call to Module::Pluggable::Object::plugins |
244 | 1 | 1µs | $plugins_for{$class} = \@plugins; | ||
245 | |||||
246 | 1 | 16µs | return @plugins; | ||
247 | } | ||||
248 | |||||
249 | # spent 25µs (18+7) within App::Cmd::_register_command which was called 3 times, avg 8µs/call:
# 3 times (18µs+7µs) by App::Cmd::_setup_command at line 40, avg 8µs/call | ||||
250 | 3 | 2µs | my ($self, $cmd_class) = @_; | ||
251 | 3 | 4µs | 3 | 7µs | $self->_plugins; # spent 7µs making 3 calls to App::Cmd::_plugins, avg 2µs/call |
252 | |||||
253 | 3 | 1µs | my $class = ref $self || $self; | ||
254 | push @{ $plugins_for{ $class } }, $cmd_class | ||||
255 | 3 | 11µs | unless grep { $_ eq $cmd_class } @{ $plugins_for{ $class } }; | ||
256 | } | ||||
257 | |||||
258 | 1 | 100ns | my %ignored_for; | ||
259 | |||||
260 | # spent 15µs within App::Cmd::should_ignore which was called 3 times, avg 5µs/call:
# 3 times (15µs+0s) by App::Cmd::_command at line 201, avg 5µs/call | ||||
261 | 3 | 2µs | my ( $self , $cmd_class ) = @_; | ||
262 | 3 | 2µs | my $class = ref $self || $self; | ||
263 | 3 | 6µs | for ( @{ $ignored_for{ $class } } ) { | ||
264 | return 1 if $_ eq $cmd_class; | ||||
265 | } | ||||
266 | 3 | 9µs | return; | ||
267 | } | ||||
268 | |||||
269 | sub _register_ignore { | ||||
270 | my ($self, $cmd_class) = @_; | ||||
271 | my $class = ref $self || $self; | ||||
272 | push @{ $ignored_for{ $class } }, $cmd_class | ||||
273 | unless grep { $_ eq $cmd_class } @{ $ignored_for{ $class } }; | ||||
274 | } | ||||
275 | |||||
276 | # spent 900ns within App::Cmd::_module_pluggable_options which was called:
# once (900ns+0s) by App::Cmd::_plugins at line 238 | ||||
277 | # my ($self) = @_; # no point in creating these ops, just to toss $self | ||||
278 | 1 | 2µs | return; | ||
279 | } | ||||
280 | |||||
281 | # load one of the stock plugins, unless requested to squash; unlike normal | ||||
282 | # plugin loading, command-to-plugin mapping conflicts are silently ignored | ||||
283 | # spent 2.51ms (50µs+2.46) within App::Cmd::_load_default_plugin which was called 3 times, avg 836µs/call:
# 3 times (50µs+2.46ms) by App::Cmd::_command at line 216, avg 836µs/call | ||||
284 | 3 | 2µs | my ($self, $plugin_name, $arg, $plugin_href) = @_; | ||
285 | 3 | 11µs | unless ($arg->{"no_$plugin_name\_plugin"}) { | ||
286 | 3 | 2µs | my $plugin = "App::Cmd::Command::$plugin_name"; | ||
287 | 3 | 3µs | 3 | 2.45ms | Class::Load::load_class($plugin); # spent 2.45ms making 3 calls to Class::Load::load_class, avg 815µs/call |
288 | 3 | 20µs | 3 | 13µs | for my $command (map { lc } $plugin->command_names) { # spent 9µs making 1 call to App::Cmd::Command::command_names
# spent 2µs making 1 call to App::Cmd::Command::help::command_names
# spent 2µs making 1 call to App::Cmd::Command::version::command_names |
289 | 7 | 7µs | $plugin_href->{$command} ||= $plugin; | ||
290 | } | ||||
291 | } | ||||
292 | } | ||||
293 | |||||
294 | #pod =method run | ||||
295 | #pod | ||||
296 | #pod $cmd->run; | ||||
297 | #pod | ||||
298 | #pod This method runs the application. If called the class, it will instantiate a | ||||
299 | #pod new App::Cmd object to run. | ||||
300 | #pod | ||||
301 | #pod It determines the requested command (generally by consuming the first | ||||
302 | #pod command-line argument), finds the plugin to handle that command, parses the | ||||
303 | #pod remaining arguments according to that plugin's rules, and runs the plugin. | ||||
304 | #pod | ||||
305 | #pod It passes the contents of the global argument array (C<@ARGV>) to | ||||
306 | #pod L</C<prepare_command>>, but C<@ARGV> is not altered by running an App::Cmd. | ||||
307 | #pod | ||||
308 | #pod =cut | ||||
309 | |||||
310 | sub run { | ||||
311 | 1 | 500ns | my ($self) = @_; | ||
312 | |||||
313 | # We should probably use Class::Default. | ||||
314 | 1 | 18µs | 1 | 54.3ms | $self = $self->new unless ref $self; # spent 54.3ms making 1 call to App::Cmd::new |
315 | |||||
316 | # prepare the command we're going to run... | ||||
317 | 1 | 5µs | 1 | 3µs | my @argv = $self->prepare_args(); # spent 3µs making 1 call to App::Cmd::prepare_args |
318 | 1 | 4µs | 1 | 20.2ms | my ($cmd, $opt, @args) = $self->prepare_command(@argv); # spent 20.2ms making 1 call to App::Cmd::prepare_command |
319 | |||||
320 | # ...and then run it | ||||
321 | 1 | 4µs | $self->execute_command($cmd, $opt, @args); | ||
322 | } | ||||
323 | |||||
324 | #pod =method prepare_args | ||||
325 | #pod | ||||
326 | #pod Normally App::Cmd uses C<@ARGV> for its commandline arguments. You can override | ||||
327 | #pod this method to change that behavior for testing or otherwise. | ||||
328 | #pod | ||||
329 | #pod =cut | ||||
330 | |||||
331 | # spent 3µs within App::Cmd::prepare_args which was called:
# once (3µs+0s) by App::Cmd::run at line 317 | ||||
332 | 1 | 400ns | my ($self) = @_; | ||
333 | return scalar(@ARGV) | ||||
334 | ? (@ARGV) | ||||
335 | 1 | 3µs | : (@{$self->default_args}); | ||
336 | } | ||||
337 | |||||
338 | #pod =method default_args | ||||
339 | #pod | ||||
340 | #pod If C<L</prepare_args>> is not changed and there are no arguments in C<@ARGV>, | ||||
341 | #pod this method is called and should return an arrayref to be used as the arguments | ||||
342 | #pod to the program. By default, it returns an empty arrayref. | ||||
343 | #pod | ||||
344 | #pod =cut | ||||
345 | |||||
346 | 2 | 911µs | 2 | 74µs | # spent 40µs (7+33) within App::Cmd::BEGIN@346 which was called:
# once (7µs+33µs) by App::Cmd::Setup::BEGIN@72 at line 346 # spent 40µs making 1 call to App::Cmd::BEGIN@346
# spent 33µs making 1 call to constant::import |
347 | |||||
348 | #pod =method abstract | ||||
349 | #pod | ||||
350 | #pod sub abstract { "command description" } | ||||
351 | #pod | ||||
352 | #pod Defines the command abstract:Â a short description that will be printed in the | ||||
353 | #pod main command options list. | ||||
354 | #pod | ||||
355 | #pod =method description | ||||
356 | #pod | ||||
357 | #pod sub description { "Long description" } | ||||
358 | #pod | ||||
359 | #pod Defines a longer command description that will be shown when the user asks for | ||||
360 | #pod help on a specific command. | ||||
361 | #pod | ||||
362 | #pod =method arg0 | ||||
363 | #pod | ||||
364 | #pod =method full_arg0 | ||||
365 | #pod | ||||
366 | #pod my $program_name = $app->arg0; | ||||
367 | #pod | ||||
368 | #pod my $full_program_name = $app->full_arg0; | ||||
369 | #pod | ||||
370 | #pod These methods return the name of the program invoked to run this application. | ||||
371 | #pod This is determined by inspecting C<$0> when the App::Cmd object is | ||||
372 | #pod instantiated, so it's probably correct, but doing weird things with App::Cmd | ||||
373 | #pod could lead to weird values from these methods. | ||||
374 | #pod | ||||
375 | #pod If the program was run like this: | ||||
376 | #pod | ||||
377 | #pod knight!rjbs$ ~/bin/rpg dice 3d6 | ||||
378 | #pod | ||||
379 | #pod Then the methods return: | ||||
380 | #pod | ||||
381 | #pod arg0 - rpg | ||||
382 | #pod full_arg0 - /Users/rjbs/bin/rpg | ||||
383 | #pod | ||||
384 | #pod These values are captured when the App::Cmd object is created, so it is safe to | ||||
385 | #pod assign to C<$0> later. | ||||
386 | #pod | ||||
387 | #pod =cut | ||||
388 | |||||
389 | sub arg0 { $_[0]->{arg0} } | ||||
390 | sub full_arg0 { $_[0]->{full_arg0} } | ||||
391 | |||||
392 | #pod =method prepare_command | ||||
393 | #pod | ||||
394 | #pod my ($cmd, $opt, @args) = $app->prepare_command(@ARGV); | ||||
395 | #pod | ||||
396 | #pod This method will load the plugin for the requested command, use its options to | ||||
397 | #pod parse the command line arguments, and eventually return everything necessary to | ||||
398 | #pod actually execute the command. | ||||
399 | #pod | ||||
400 | #pod =cut | ||||
401 | |||||
402 | # spent 20.2ms (23µs+20.2) within App::Cmd::prepare_command which was called:
# once (23µs+20.2ms) by App::Cmd::run at line 318 | ||||
403 | 1 | 800ns | my ($self, @args) = @_; | ||
404 | |||||
405 | # figure out first-level dispatch | ||||
406 | 1 | 3µs | 1 | 19.4ms | my ($command, $opt, @sub_args) = $self->get_command(@args); # spent 19.4ms making 1 call to App::Cmd::get_command |
407 | |||||
408 | # set up the global options (which we just determined) | ||||
409 | 1 | 3µs | 1 | 2µs | $self->set_global_options($opt); # spent 2µs making 1 call to App::Cmd::set_global_options |
410 | |||||
411 | # find its plugin or else call default plugin (default default is help) | ||||
412 | 1 | 11µs | 1 | 745µs | if ($command) { # spent 745µs making 1 call to App::Cmd::_prepare_command |
413 | $self->_prepare_command($command, $opt, @sub_args); | ||||
414 | } else { | ||||
415 | $self->_prepare_default_command($opt, @sub_args); | ||||
416 | } | ||||
417 | } | ||||
418 | |||||
419 | # spent 745µs (15+731) within App::Cmd::_prepare_command which was called:
# once (15µs+731µs) by App::Cmd::prepare_command at line 412 | ||||
420 | 1 | 900ns | my ($self, $command, $opt, @args) = @_; | ||
421 | 1 | 12µs | 2 | 731µs | if (my $plugin = $self->plugin_for($command)) { # spent 718µs making 1 call to App::Cmd::Command::prepare
# spent 13µs making 1 call to App::Cmd::plugin_for |
422 | return $plugin->prepare($self, @args); | ||||
423 | } else { | ||||
424 | return $self->_bad_command($command, $opt, @args); | ||||
425 | } | ||||
426 | } | ||||
427 | |||||
428 | sub _prepare_default_command { | ||||
429 | my ($self, $opt, @sub_args) = @_; | ||||
430 | $self->_prepare_command($self->default_command, $opt, @sub_args); | ||||
431 | } | ||||
432 | |||||
433 | sub _bad_command { | ||||
434 | my ($self, $command, $opt, @args) = @_; | ||||
435 | print "Unrecognized command: $command.\n\nUsage:\n" if defined($command); | ||||
436 | |||||
437 | # This should be class data so that, in Bizarro World, two App::Cmds will not | ||||
438 | # conflict. | ||||
439 | our $_bad++; | ||||
440 | $self->prepare_command(qw(commands --stderr)); | ||||
441 | } | ||||
442 | |||||
443 | END { exit 1 if our $_bad }; | ||||
444 | |||||
445 | #pod =method default_command | ||||
446 | #pod | ||||
447 | #pod This method returns the name of the command to run if none is given on the | ||||
448 | #pod command line. The default default is "help" | ||||
449 | #pod | ||||
450 | #pod =cut | ||||
451 | |||||
452 | sub default_command { "help" } | ||||
453 | |||||
454 | #pod =method execute_command | ||||
455 | #pod | ||||
456 | #pod $app->execute_command($cmd, \%opt, @args); | ||||
457 | #pod | ||||
458 | #pod This method will invoke C<validate_args> and then C<run> on C<$cmd>. | ||||
459 | #pod | ||||
460 | #pod =cut | ||||
461 | |||||
462 | sub execute_command { | ||||
463 | 1 | 500ns | my ($self, $cmd, $opt, @args) = @_; | ||
464 | |||||
465 | 1 | 500ns | local our $active_cmd = $cmd; | ||
466 | |||||
467 | 1 | 2µs | 1 | 12µs | $cmd->validate_args($opt, \@args); # spent 12µs making 1 call to PONAPI::CLI::Command::demo::validate_args |
468 | 1 | 2µs | $cmd->execute($opt, \@args); | ||
469 | } | ||||
470 | |||||
471 | #pod =method plugin_search_path | ||||
472 | #pod | ||||
473 | #pod This method returns the plugin_search_path as set. The default implementation, | ||||
474 | #pod if called on "YourApp::Cmd" will return "YourApp::Cmd::Command" | ||||
475 | #pod | ||||
476 | #pod This is a method because it's fun to override it with, for example: | ||||
477 | #pod | ||||
478 | #pod use constant plugin_search_path => __PACKAGE__; | ||||
479 | #pod | ||||
480 | #pod =cut | ||||
481 | |||||
482 | # spent 4µs within App::Cmd::_default_command_base which was called 2 times, avg 2µs/call:
# once (2µs+0s) by App::Cmd::Setup::_make_app_class at line 111 of App/Cmd/Setup.pm
# once (2µs+0s) by App::Cmd::plugin_search_path at line 498 | ||||
483 | 2 | 600ns | my ($self) = @_; | ||
484 | 2 | 1µs | my $class = ref $self || $self; | ||
485 | 2 | 7µs | return "$class\::Command"; | ||
486 | } | ||||
487 | |||||
488 | # spent 3µs within App::Cmd::_default_plugin_base which was called:
# once (3µs+0s) by App::Cmd::plugin_search_path at line 502 | ||||
489 | 1 | 300ns | my ($self) = @_; | ||
490 | 1 | 400ns | my $class = ref $self || $self; | ||
491 | 1 | 3µs | return "$class\::Plugin"; | ||
492 | } | ||||
493 | |||||
494 | # spent 20µs (14+6) within App::Cmd::plugin_search_path which was called:
# once (14µs+6µs) by App::Cmd::_plugins at line 238 | ||||
495 | 1 | 300ns | my ($self) = @_; | ||
496 | |||||
497 | 1 | 1µs | 1 | 800ns | my $dcb = $self->_default_command_base; # spent 800ns making 1 call to App::Cmd::Setup::__ANON__[App/Cmd/Setup.pm:114] |
498 | 1 | 2µs | 1 | 2µs | my $ccb = $dcb eq 'App::Cmd::Command' # spent 2µs making 1 call to App::Cmd::_default_command_base |
499 | ? $self->App::Cmd::_default_command_base | ||||
500 | : $self->_default_command_base; | ||||
501 | |||||
502 | 1 | 3µs | 1 | 3µs | my @default = ($ccb, $self->_default_plugin_base); # spent 3µs making 1 call to App::Cmd::_default_plugin_base |
503 | |||||
504 | 1 | 300ns | if (ref $self) { | ||
505 | return $self->{plugin_search_path} ||= \@default; | ||||
506 | } else { | ||||
507 | 1 | 3µs | return \@default; | ||
508 | } | ||||
509 | } | ||||
510 | |||||
511 | #pod =method allow_any_unambiguous_abbrev | ||||
512 | #pod | ||||
513 | #pod If this method returns true (which, by default, it does I<not>), then any | ||||
514 | #pod unambiguous abbreviation for a registered command name will be allowed as a | ||||
515 | #pod means to use that command. For example, given the following commands: | ||||
516 | #pod | ||||
517 | #pod reticulate | ||||
518 | #pod reload | ||||
519 | #pod rasterize | ||||
520 | #pod | ||||
521 | #pod Then the user could use C<ret> for C<reticulate> or C<ra> for C<rasterize> and | ||||
522 | #pod so on. | ||||
523 | #pod | ||||
524 | #pod =cut | ||||
525 | |||||
526 | 1 | 3µs | # spent 1µs within App::Cmd::allow_any_unambiguous_abbrev which was called:
# once (1µs+0s) by App::Cmd::_command at line 218 | ||
527 | |||||
528 | #pod =method global_options | ||||
529 | #pod | ||||
530 | #pod if ($cmd->app->global_options->{verbose}) { ... } | ||||
531 | #pod | ||||
532 | #pod This method returns the running application's global options as a hashref. If | ||||
533 | #pod there are no options specified, an empty hashref is returned. | ||||
534 | #pod | ||||
535 | #pod =cut | ||||
536 | |||||
537 | sub global_options { | ||||
538 | my $self = shift; | ||||
539 | return $self->{global_options} ||= {} if ref $self; | ||||
540 | return {}; | ||||
541 | } | ||||
542 | |||||
543 | #pod =method set_global_options | ||||
544 | #pod | ||||
545 | #pod $app->set_global_options(\%opt); | ||||
546 | #pod | ||||
547 | #pod This method sets the global options. | ||||
548 | #pod | ||||
549 | #pod =cut | ||||
550 | |||||
551 | # spent 2µs within App::Cmd::set_global_options which was called:
# once (2µs+0s) by App::Cmd::prepare_command at line 409 | ||||
552 | 1 | 300ns | my ($self, $opt) = @_; | ||
553 | 1 | 4µs | return $self->{global_options} = $opt; | ||
554 | } | ||||
555 | |||||
556 | #pod =method command_names | ||||
557 | #pod | ||||
558 | #pod my @names = $cmd->command_names; | ||||
559 | #pod | ||||
560 | #pod This returns the commands names which the App::Cmd object will handle. | ||||
561 | #pod | ||||
562 | #pod =cut | ||||
563 | |||||
564 | sub command_names { | ||||
565 | my ($self) = @_; | ||||
566 | keys %{ $self->_command }; | ||||
567 | } | ||||
568 | |||||
569 | #pod =method command_groups | ||||
570 | #pod | ||||
571 | #pod my @groups = $cmd->commands_groups; | ||||
572 | #pod | ||||
573 | #pod This method can be implemented to return a grouped list of command names with | ||||
574 | #pod optional headers. Each group is given as arrayref and each header as string. | ||||
575 | #pod If an empty list is returned, the commands plugin will show two groups without | ||||
576 | #pod headers: the first group is for the "help" and "commands" commands, and all | ||||
577 | #pod other commands are in the second group. | ||||
578 | #pod | ||||
579 | #pod =cut | ||||
580 | |||||
581 | sub command_groups { } | ||||
582 | |||||
583 | #pod =method command_plugins | ||||
584 | #pod | ||||
585 | #pod my @plugins = $cmd->command_plugins; | ||||
586 | #pod | ||||
587 | #pod This method returns the package names of the plugins that implement the | ||||
588 | #pod App::Cmd object's commands. | ||||
589 | #pod | ||||
590 | #pod =cut | ||||
591 | |||||
592 | sub command_plugins { | ||||
593 | my ($self) = @_; | ||||
594 | my %seen = map {; $_ => 1 } values %{ $self->_command }; | ||||
595 | keys %seen; | ||||
596 | } | ||||
597 | |||||
598 | #pod =method plugin_for | ||||
599 | #pod | ||||
600 | #pod my $plugin = $cmd->plugin_for($command); | ||||
601 | #pod | ||||
602 | #pod This method returns the plugin (module) for the given command. If no plugin | ||||
603 | #pod implements the command, it returns false. | ||||
604 | #pod | ||||
605 | #pod =cut | ||||
606 | |||||
607 | # spent 13µs (9+4) within App::Cmd::plugin_for which was called:
# once (9µs+4µs) by App::Cmd::_prepare_command at line 421 | ||||
608 | 1 | 500ns | my ($self, $command) = @_; | ||
609 | 1 | 200ns | return unless $command; | ||
610 | 1 | 3µs | 1 | 3µs | return unless exists $self->_command->{ $command }; # spent 3µs making 1 call to App::Cmd::_command |
611 | |||||
612 | 1 | 4µs | 1 | 900ns | return $self->_command->{ $command }; # spent 900ns making 1 call to App::Cmd::_command |
613 | } | ||||
614 | |||||
615 | #pod =method get_command | ||||
616 | #pod | ||||
617 | #pod my ($command_name, $opt, @args) = $app->get_command(@args); | ||||
618 | #pod | ||||
619 | #pod Process arguments and into a command name and (optional) global options. | ||||
620 | #pod | ||||
621 | #pod =cut | ||||
622 | |||||
623 | # spent 19.4ms (28µs+19.4) within App::Cmd::get_command which was called:
# once (28µs+19.4ms) by App::Cmd::prepare_command at line 406 | ||||
624 | 1 | 600ns | my ($self, @args) = @_; | ||
625 | |||||
626 | 1 | 9µs | 2 | 19.4ms | my ($opt, $args, %fields) # spent 19.3ms making 1 call to App::Cmd::ArgProcessor::_process_args
# spent 50µs making 1 call to App::Cmd::_global_option_processing_params |
627 | = $self->_process_args(\@args, $self->_global_option_processing_params); | ||||
628 | |||||
629 | # map --help to help command | ||||
630 | 1 | 4µs | if ($opt->{help}) { | ||
631 | unshift @$args, 'help'; | ||||
632 | delete $opt->{help}; | ||||
633 | } | ||||
634 | |||||
635 | 1 | 6µs | 1 | 2µs | my ($command, $rest) = $self->_cmd_from_args($args); # spent 2µs making 1 call to App::Cmd::_cmd_from_args |
636 | |||||
637 | 1 | 1µs | $self->{usage} = $fields{usage}; | ||
638 | |||||
639 | 1 | 5µs | return ($command, $opt, @$rest); | ||
640 | } | ||||
641 | |||||
642 | # spent 2µs within App::Cmd::_cmd_from_args which was called:
# once (2µs+0s) by App::Cmd::get_command at line 635 | ||||
643 | 1 | 400ns | my ($self, $args) = @_; | ||
644 | |||||
645 | 1 | 700ns | my $command = shift @$args; | ||
646 | 1 | 3µs | return ($command, $args); | ||
647 | } | ||||
648 | |||||
649 | # spent 50µs (13+37) within App::Cmd::_global_option_processing_params which was called:
# once (13µs+37µs) by App::Cmd::get_command at line 626 | ||||
650 | 1 | 400ns | my ($self, @args) = @_; | ||
651 | |||||
652 | return ( | ||||
653 | 1 | 8µs | 2 | 37µs | $self->usage_desc(@args), # spent 36µs making 1 call to App::Cmd::global_opt_spec
# spent 1µs making 1 call to App::Cmd::usage_desc |
654 | $self->global_opt_spec(@args), | ||||
655 | { getopt_conf => [qw/pass_through/] }, | ||||
656 | ); | ||||
657 | } | ||||
658 | |||||
659 | #pod =method usage | ||||
660 | #pod | ||||
661 | #pod print $self->app->usage->text; | ||||
662 | #pod | ||||
663 | #pod Returns the usage object for the global options. | ||||
664 | #pod | ||||
665 | #pod =cut | ||||
666 | |||||
667 | sub usage { $_[0]{usage} }; | ||||
668 | |||||
669 | #pod =method usage_desc | ||||
670 | #pod | ||||
671 | #pod The top level usage line. Looks something like | ||||
672 | #pod | ||||
673 | #pod "yourapp <command> [options]" | ||||
674 | #pod | ||||
675 | #pod =cut | ||||
676 | |||||
677 | # spent 1µs within App::Cmd::usage_desc which was called:
# once (1µs+0s) by App::Cmd::_global_option_processing_params at line 653 | ||||
678 | # my ($self) = @_; # no point in creating these ops, just to toss $self | ||||
679 | 1 | 5µs | return "%c <command> %o"; | ||
680 | } | ||||
681 | |||||
682 | #pod =method global_opt_spec | ||||
683 | #pod | ||||
684 | #pod Returns a list with help command unless C<no_help_plugin> has been specified or | ||||
685 | #pod an empty list. Can be overridden for pre-dispatch option processing. This is | ||||
686 | #pod useful for flags like --verbose. | ||||
687 | #pod | ||||
688 | #pod =cut | ||||
689 | |||||
690 | # spent 36µs (30+6) within App::Cmd::global_opt_spec which was called:
# once (30µs+6µs) by App::Cmd::_global_option_processing_params at line 653 | ||||
691 | 1 | 400ns | my ($self) = @_; | ||
692 | |||||
693 | 1 | 3µs | my $cmd = $self->{command}; | ||
694 | 1 | 200ns | my %seen; | ||
695 | 4 | 11µs | 4 | 4µs | my @help = grep { ! $seen{$_}++ } # spent 4µs making 4 calls to App::Cmd::CORE:subst, avg 900ns/call |
696 | 4 | 1µs | reverse sort map { s/^--?//; $_ } | ||
697 | 1 | 15µs | 1 | 2µs | grep { $cmd->{$_} eq 'App::Cmd::Command::help' } keys %$cmd; # spent 2µs making 1 call to App::Cmd::CORE:sort |
698 | |||||
699 | 1 | 6µs | return (@help ? [ join('|', @help) => "show help" ] : ()); | ||
700 | } | ||||
701 | |||||
702 | #pod =method usage_error | ||||
703 | #pod | ||||
704 | #pod $self->usage_error("Something's wrong!"); | ||||
705 | #pod | ||||
706 | #pod Used to die with nice usage output, during C<validate_args>. | ||||
707 | #pod | ||||
708 | #pod =cut | ||||
709 | |||||
710 | sub usage_error { | ||||
711 | my ($self, $error) = @_; | ||||
712 | die "Error: $error\nUsage: " . $self->_usage_text; | ||||
713 | } | ||||
714 | |||||
715 | sub _usage_text { | ||||
716 | my ($self) = @_; | ||||
717 | my $text = $self->usage->text; | ||||
718 | $text =~ s/\A(\s+)/!/; | ||||
719 | return $text; | ||||
720 | } | ||||
721 | |||||
722 | #pod =head1 TODO | ||||
723 | #pod | ||||
724 | #pod =for :list | ||||
725 | #pod * publish and bring in Log::Speak (simple quiet/verbose output) | ||||
726 | #pod * publish and use our internal enhanced describe_options | ||||
727 | #pod * publish and use our improved simple input routines | ||||
728 | #pod | ||||
729 | #pod =cut | ||||
730 | |||||
731 | 1 | 3µs | 1; | ||
732 | |||||
733 | __END__ | ||||
# spent 2µs within App::Cmd::CORE:sort which was called:
# once (2µs+0s) by App::Cmd::global_opt_spec at line 697 | |||||
# spent 4µs within App::Cmd::CORE:subst which was called 4 times, avg 900ns/call:
# 4 times (4µs+0s) by App::Cmd::global_opt_spec at line 695, avg 900ns/call |