← 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:08 2016

Filename/usr/local/share/perl/5.18.2/App/Cmd.pm
StatementsExecuted 220 statements in 3.54ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
1112.14ms18.3msApp::Cmd::::BEGIN@12 App::Cmd::BEGIN@12
1111.90ms2.53msApp::Cmd::::BEGIN@15 App::Cmd::BEGIN@15
1111.57ms1.68msApp::Cmd::::BEGIN@11 App::Cmd::BEGIN@11
111944µs12.3msApp::Cmd::::BEGIN@13 App::Cmd::BEGIN@13
111390µs429µsApp::Cmd::::BEGIN@7 App::Cmd::BEGIN@7
331124µs54.2msApp::Cmd::::_command App::Cmd::_command
31194µs206µsApp::Cmd::::_setup_command App::Cmd::_setup_command
31150µs2.51msApp::Cmd::::_load_default_plugin App::Cmd::_load_default_plugin
42141µs4.02msApp::Cmd::::_plugins App::Cmd::_plugins
11130µs36µsApp::Cmd::::global_opt_spec App::Cmd::global_opt_spec
11128µs19.4msApp::Cmd::::get_command App::Cmd::get_command
11123µs20.2msApp::Cmd::::prepare_command App::Cmd::prepare_command
11121µs30µsApp::Cmd::Setup::::BEGIN@1App::Cmd::Setup::BEGIN@1
11121µs21µsApp::Cmd::Setup::::BEGIN@3App::Cmd::Setup::BEGIN@3
31118µs25µsApp::Cmd::::_register_command App::Cmd::_register_command
11116µs54.3msApp::Cmd::::new App::Cmd::new
31115µs15µsApp::Cmd::::should_ignore App::Cmd::should_ignore
11115µs745µsApp::Cmd::::_prepare_command App::Cmd::_prepare_command
11114µs20µsApp::Cmd::::plugin_search_path App::Cmd::plugin_search_path
11113µs50µsApp::Cmd::::_global_option_processing_params App::Cmd::_global_option_processing_params
1119µs13µsApp::Cmd::::plugin_for App::Cmd::plugin_for
1117µs7µsApp::Cmd::::BEGIN@8 App::Cmd::BEGIN@8
1117µs40µsApp::Cmd::::BEGIN@346 App::Cmd::BEGIN@346
1116µs14µsApp::Cmd::::BEGIN@36 App::Cmd::BEGIN@36
1115µs8µsApp::Cmd::Setup::::BEGIN@2App::Cmd::Setup::BEGIN@2
2224µs4µsApp::Cmd::::_default_command_base App::Cmd::_default_command_base
4114µs4µsApp::Cmd::::CORE:subst App::Cmd::CORE:subst (opcode)
1113µs3µsApp::Cmd::::_default_plugin_base App::Cmd::_default_plugin_base
1113µs3µsApp::Cmd::::prepare_args App::Cmd::prepare_args
1112µs2µsApp::Cmd::::_cmd_from_args App::Cmd::_cmd_from_args
1112µs2µsApp::Cmd::::CORE:sort App::Cmd::CORE:sort (opcode)
1112µs2µsApp::Cmd::::set_global_options App::Cmd::set_global_options
1111µs1µsApp::Cmd::::allow_any_unambiguous_abbrev App::Cmd::allow_any_unambiguous_abbrev
1111µs1µsApp::Cmd::::usage_desc App::Cmd::usage_desc
111900ns900nsApp::Cmd::::_module_pluggable_options App::Cmd::_module_pluggable_options
0000s0sApp::Cmd::::END App::Cmd::END
0000s0sApp::Cmd::::__ANON__[:22] App::Cmd::__ANON__[:22]
0000s0sApp::Cmd::::_bad_command App::Cmd::_bad_command
0000s0sApp::Cmd::::_plugin_plugins App::Cmd::_plugin_plugins
0000s0sApp::Cmd::::_prepare_default_command App::Cmd::_prepare_default_command
0000s0sApp::Cmd::::_register_ignore App::Cmd::_register_ignore
0000s0sApp::Cmd::::_setup_ignore App::Cmd::_setup_ignore
0000s0sApp::Cmd::::_usage_text App::Cmd::_usage_text
0000s0sApp::Cmd::::arg0 App::Cmd::arg0
0000s0sApp::Cmd::::command_groups App::Cmd::command_groups
0000s0sApp::Cmd::::command_names App::Cmd::command_names
0000s0sApp::Cmd::::command_plugins App::Cmd::command_plugins
0000s0sApp::Cmd::::default_command App::Cmd::default_command
0000s0sApp::Cmd::::execute_command App::Cmd::execute_command
0000s0sApp::Cmd::::full_arg0 App::Cmd::full_arg0
0000s0sApp::Cmd::::global_options App::Cmd::global_options
0000s0sApp::Cmd::::run App::Cmd::run
0000s0sApp::Cmd::::usage App::Cmd::usage
0000s0sApp::Cmd::::usage_error App::Cmd::usage_error
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments
Time
on line
Calls Time
in subs
Code
1219µs239µ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
use strict;
# spent 30µs making 1 call to App::Cmd::Setup::BEGIN@1 # spent 9µs making 1 call to strict::import
2218µs211µ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
use warnings;
# spent 8µs making 1 call to App::Cmd::Setup::BEGIN@2 # spent 3µs making 1 call to warnings::import
3256µs121µ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
use 5.006;
# spent 21µs making 1 call to App::Cmd::Setup::BEGIN@3
4
5package App::Cmd;
61400ns$App::Cmd::VERSION = '0.330';
72322µs1429µ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
use App::Cmd::ArgProcessor;
# spent 429µs making 1 call to App::Cmd::BEGIN@7
8122µs17µ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
BEGIN { our @ISA = 'App::Cmd::ArgProcessor' };
# spent 7µs making 1 call to App::Cmd::BEGIN@8
9# ABSTRACT: write command line apps with less suffering
10
112112µs11.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
use File::Basename ();
# spent 1.68ms making 1 call to App::Cmd::BEGIN@11
122441µs118.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
use Module::Pluggable::Object ();
# spent 18.3ms making 1 call to App::Cmd::BEGIN@12
132126µs112.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
use Class::Load ();
# 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
use Sub::Exporter -setup => {
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 },
242111µs22.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
sub _setup_command {
2732µs my ($self, $val, $data) = @_;
2831µs my $into = $data->{into};
29
30324µs36µ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 {
34611µs34µ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
3534µs30s 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
362845µs223µ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
no strict 'refs';
# spent 14µs making 1 call to App::Cmd::BEGIN@36 # spent 8µs making 1 call to strict::unimport
37327µs push @{"$into\::ISA"}, $base;
38 }
39
4036µs325µs $self->_register_command($into);
# spent 25µs making 3 calls to App::Cmd::_register_command, avg 8µs/call
41
4238µs33µ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
46312µs 1;
47}
48
49sub _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
61sub _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
sub new {
1621600ns my ($class, $arg) = @_;
163
16411µs my $arg0 = $0;
16514µs159µs my $base = File::Basename::basename $arg0;
# spent 59µs making 1 call to File::Basename::basename
166
16717µs154.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
17416µ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
# spent 54.2ms (124µs+54.1) within App::Cmd::_command which was called 3 times, avg 18.1ms/call: # once (120µs+54.1ms) by App::Cmd::new at line 167 # once (3µs+0s) by App::Cmd::plugin_for at line 610 # once (900ns+0s) by App::Cmd::plugin_for at line 612
sub _command {
18131µs my ($self, $arg) = @_;
18236µ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
1891300ns my $want_isa = 'App::Cmd::Command';
190
1911200ns my %plugin;
19213µs14.01ms for my $plugin ($self->_plugins) {
# spent 4.01ms making 1 call to App::Cmd::_plugins
193
19435µs347.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
201314µs315µs next if $self->should_ignore( $plugin );
# spent 15µs making 3 calls to App::Cmd::should_ignore, avg 5µs/call
202
203328µs36µ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
206329µs310µs next unless $plugin->can("command_names");
# spent 10µs making 3 calls to UNIVERSAL::can, avg 4µs/call
207
208314µs336µ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
20932µs die "two plugins for command $command: $plugin and $plugin{$command}\n"
210 if exists $plugin{$command};
211
21234µs $plugin{$command} = $plugin;
213 }
214 }
215
216110µs32.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
21815µs11µ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
22513µ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
2311200nsmy %plugins_for;
232
# spent 4.02ms (41µs+3.98) within App::Cmd::_plugins which was called 4 times, avg 1.01ms/call: # 3 times (7µs+0s) by App::Cmd::_register_command at line 251, avg 2µs/call # once (34µs+3.98ms) by App::Cmd::_command at line 192
sub _plugins {
23342µs my ($self) = @_;
23442µs my $class = ref $self || $self;
235
23649µs return @{ $plugins_for{$class} } if $plugins_for{$class};
237
23818µs324µ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
24313µs13.96ms my @plugins = $finder->plugins;
# spent 3.96ms making 1 call to Module::Pluggable::Object::plugins
24411µs $plugins_for{$class} = \@plugins;
245
246116µ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
sub _register_command {
25032µs my ($self, $cmd_class) = @_;
25134µs37µs $self->_plugins;
# spent 7µs making 3 calls to App::Cmd::_plugins, avg 2µs/call
252
25331µs my $class = ref $self || $self;
254 push @{ $plugins_for{ $class } }, $cmd_class
255311µs unless grep { $_ eq $cmd_class } @{ $plugins_for{ $class } };
256}
257
2581100nsmy %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
sub should_ignore {
26132µs my ( $self , $cmd_class ) = @_;
26232µs my $class = ref $self || $self;
26336µs for ( @{ $ignored_for{ $class } } ) {
264 return 1 if $_ eq $cmd_class;
265 }
26639µs return;
267}
268
269sub _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
sub _module_pluggable_options {
277 # my ($self) = @_; # no point in creating these ops, just to toss $self
27812µ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
sub _load_default_plugin {
28432µs my ($self, $plugin_name, $arg, $plugin_href) = @_;
285311µs unless ($arg->{"no_$plugin_name\_plugin"}) {
28632µs my $plugin = "App::Cmd::Command::$plugin_name";
28733µs32.45ms Class::Load::load_class($plugin);
# spent 2.45ms making 3 calls to Class::Load::load_class, avg 815µs/call
288320µs313µ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
28977µ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
310sub run {
3111500ns my ($self) = @_;
312
313 # We should probably use Class::Default.
314118µs154.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...
31715µs13µs my @argv = $self->prepare_args();
# spent 3µs making 1 call to App::Cmd::prepare_args
31814µs120.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
32114µ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
sub prepare_args {
3321400ns my ($self) = @_;
333 return scalar(@ARGV)
334 ? (@ARGV)
33513µ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
3462911µs274µ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
use constant default_args => [];
# 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
389sub arg0 { $_[0]->{arg0} }
390sub 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
sub prepare_command {
4031800ns my ($self, @args) = @_;
404
405 # figure out first-level dispatch
40613µs119.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)
40913µs12µ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)
412111µs1745µ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
sub _prepare_command {
4201900ns my ($self, $command, $opt, @args) = @_;
421112µs2731µ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
428sub _prepare_default_command {
429 my ($self, $opt, @sub_args) = @_;
430 $self->_prepare_command($self->default_command, $opt, @sub_args);
431}
432
433sub _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
443END { 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
452sub 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
462sub execute_command {
4631500ns my ($self, $cmd, $opt, @args) = @_;
464
4651500ns local our $active_cmd = $cmd;
466
46712µs112µs $cmd->validate_args($opt, \@args);
# spent 12µs making 1 call to PONAPI::CLI::Command::demo::validate_args
46812µ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
sub _default_command_base {
4832600ns my ($self) = @_;
48421µs my $class = ref $self || $self;
48527µ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
sub _default_plugin_base {
4891300ns my ($self) = @_;
4901400ns my $class = ref $self || $self;
49113µ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
sub plugin_search_path {
4951300ns my ($self) = @_;
496
49711µs1800ns my $dcb = $self->_default_command_base;
# spent 800ns making 1 call to App::Cmd::Setup::__ANON__[App/Cmd/Setup.pm:114]
49812µs12µ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
50213µs13µs my @default = ($ccb, $self->_default_plugin_base);
# spent 3µs making 1 call to App::Cmd::_default_plugin_base
503
5041300ns if (ref $self) {
505 return $self->{plugin_search_path} ||= \@default;
506 } else {
50713µ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
52613µ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
sub allow_any_unambiguous_abbrev { return 0 }
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
537sub 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
sub set_global_options {
5521300ns my ($self, $opt) = @_;
55314µ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
564sub 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
581sub 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
592sub 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
sub plugin_for {
6081500ns my ($self, $command) = @_;
6091200ns return unless $command;
61013µs13µs return unless exists $self->_command->{ $command };
# spent 3µs making 1 call to App::Cmd::_command
611
61214µs1900ns 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
sub get_command {
6241600ns my ($self, @args) = @_;
625
62619µs219.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
63014µs if ($opt->{help}) {
631 unshift @$args, 'help';
632 delete $opt->{help};
633 }
634
63516µs12µs my ($command, $rest) = $self->_cmd_from_args($args);
# spent 2µs making 1 call to App::Cmd::_cmd_from_args
636
63711µs $self->{usage} = $fields{usage};
638
63915µ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
sub _cmd_from_args {
6431400ns my ($self, $args) = @_;
644
6451700ns my $command = shift @$args;
64613µ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
sub _global_option_processing_params {
6501400ns my ($self, @args) = @_;
651
652 return (
65318µs237µ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
667sub 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
sub usage_desc {
678 # my ($self) = @_; # no point in creating these ops, just to toss $self
67915µ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
sub global_opt_spec {
6911400ns my ($self) = @_;
692
69313µs my $cmd = $self->{command};
6941200ns my %seen;
695411µs44µs my @help = grep { ! $seen{$_}++ }
# spent 4µs making 4 calls to App::Cmd::CORE:subst, avg 900ns/call
69641µs reverse sort map { s/^--?//; $_ }
697115µs12µs grep { $cmd->{$_} eq 'App::Cmd::Command::help' } keys %$cmd;
# spent 2µs making 1 call to App::Cmd::CORE:sort
698
69916µ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
710sub usage_error {
711 my ($self, $error) = @_;
712 die "Error: $error\nUsage: " . $self->_usage_text;
713}
714
715sub _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
73113µs1;
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
sub App::Cmd::CORE:sort; # opcode
# 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
sub App::Cmd::CORE:subst; # opcode