Profile of App/Cmd.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:08 2016

Filename | /usr/local/share/perl/5.18.2/App/Cmd.pm
Statements | Executed 220 statements in 3.54ms

Subroutines
Calls | P | F | Exclusive Time | Inclusive Time | Subroutine
--- | --- | --- | --- | --- | ---
1 | 1 | 1 | 2.14ms | 18.3ms | App::Cmd::::BEGIN@12 App::Cmd::BEGIN@12
1 | 1 | 1 | 1.90ms | 2.53ms | App::Cmd::::BEGIN@15 App::Cmd::BEGIN@15
1 | 1 | 1 | 1.57ms | 1.68ms | App::Cmd::::BEGIN@11 App::Cmd::BEGIN@11
1 | 1 | 1 | 944µs | 12.3ms | App::Cmd::::BEGIN@13 App::Cmd::BEGIN@13
1 | 1 | 1 | 390µs | 429µs | App::Cmd::::BEGIN@7 App::Cmd::BEGIN@7
3 | 3 | 1 | 124µs | 54.2ms | App::Cmd::::_command App::Cmd::_command
3 | 1 | 1 | 94µs | 206µs | App::Cmd::::_setup_command App::Cmd::_setup_command
3 | 1 | 1 | 50µs | 2.51ms | App::Cmd::::_load_default_plugin App::Cmd::_load_default_plugin
4 | 2 | 1 | 41µs | 4.02ms | App::Cmd::::_plugins App::Cmd::_plugins
1 | 1 | 1 | 30µs | 36µs | App::Cmd::::global_opt_spec App::Cmd::global_opt_spec
1 | 1 | 1 | 28µs | 19.4ms | App::Cmd::::get_command App::Cmd::get_command
1 | 1 | 1 | 23µs | 20.2ms | App::Cmd::::prepare_command App::Cmd::prepare_command
1 | 1 | 1 | 21µs | 30µs | App::Cmd::Setup::::BEGIN@1App::Cmd::Setup::BEGIN@1
1 | 1 | 1 | 21µs | 21µs | App::Cmd::Setup::::BEGIN@3App::Cmd::Setup::BEGIN@3
3 | 1 | 1 | 18µs | 25µs | App::Cmd::::_register_command App::Cmd::_register_command
1 | 1 | 1 | 16µs | 54.3ms | App::Cmd::::new App::Cmd::new
3 | 1 | 1 | 15µs | 15µs | App::Cmd::::should_ignore App::Cmd::should_ignore
1 | 1 | 1 | 15µs | 745µs | App::Cmd::::_prepare_command App::Cmd::_prepare_command
1 | 1 | 1 | 14µs | 20µs | App::Cmd::::plugin_search_path App::Cmd::plugin_search_path
1 | 1 | 1 | 13µs | 50µs | App::Cmd::::_global_option_processing_params App::Cmd::_global_option_processing_params
1 | 1 | 1 | 9µs | 13µs | App::Cmd::::plugin_for App::Cmd::plugin_for
1 | 1 | 1 | 7µs | 7µs | App::Cmd::::BEGIN@8 App::Cmd::BEGIN@8
1 | 1 | 1 | 7µs | 40µs | App::Cmd::::BEGIN@346 App::Cmd::BEGIN@346
1 | 1 | 1 | 6µs | 14µs | App::Cmd::::BEGIN@36 App::Cmd::BEGIN@36
1 | 1 | 1 | 5µs | 8µs | App::Cmd::Setup::::BEGIN@2App::Cmd::Setup::BEGIN@2
2 | 2 | 2 | 4µs | 4µs | App::Cmd::::_default_command_base App::Cmd::_default_command_base
4 | 1 | 1 | 4µs | 4µs | App::Cmd::::CORE:subst App::Cmd::CORE:subst (opcode)
1 | 1 | 1 | 3µs | 3µs | App::Cmd::::_default_plugin_base App::Cmd::_default_plugin_base
1 | 1 | 1 | 3µs | 3µs | App::Cmd::::prepare_args App::Cmd::prepare_args
1 | 1 | 1 | 2µs | 2µs | App::Cmd::::_cmd_from_args App::Cmd::_cmd_from_args
1 | 1 | 1 | 2µs | 2µs | App::Cmd::::CORE:sort App::Cmd::CORE:sort (opcode)
1 | 1 | 1 | 2µs | 2µs | App::Cmd::::set_global_options App::Cmd::set_global_options
1 | 1 | 1 | 1µs | 1µs | App::Cmd::::allow_any_unambiguous_abbrev App::Cmd::allow_any_unambiguous_abbrev
1 | 1 | 1 | 1µs | 1µs | App::Cmd::::usage_desc App::Cmd::usage_desc
1 | 1 | 1 | 900ns | 900ns | App::Cmd::::_module_pluggable_options App::Cmd::_module_pluggable_options
0 | 0 | 0 | 0s | 0s | App::Cmd::::END App::Cmd::END
0 | 0 | 0 | 0s | 0s | App::Cmd::::__ANON__[:22] App::Cmd::__ANON__[:22]
0 | 0 | 0 | 0s | 0s | App::Cmd::::_bad_command App::Cmd::_bad_command
0 | 0 | 0 | 0s | 0s | App::Cmd::::_plugin_plugins App::Cmd::_plugin_plugins
0 | 0 | 0 | 0s | 0s | App::Cmd::::_prepare_default_command App::Cmd::_prepare_default_command
0 | 0 | 0 | 0s | 0s | App::Cmd::::_register_ignore App::Cmd::_register_ignore
0 | 0 | 0 | 0s | 0s | App::Cmd::::_setup_ignore App::Cmd::_setup_ignore
0 | 0 | 0 | 0s | 0s | App::Cmd::::_usage_text App::Cmd::_usage_text
0 | 0 | 0 | 0s | 0s | App::Cmd::::arg0 App::Cmd::arg0
0 | 0 | 0 | 0s | 0s | App::Cmd::::command_groups App::Cmd::command_groups
0 | 0 | 0 | 0s | 0s | App::Cmd::::command_names App::Cmd::command_names
0 | 0 | 0 | 0s | 0s | App::Cmd::::command_plugins App::Cmd::command_plugins
0 | 0 | 0 | 0s | 0s | App::Cmd::::default_command App::Cmd::default_command
0 | 0 | 0 | 0s | 0s | App::Cmd::::execute_command App::Cmd::execute_command
0 | 0 | 0 | 0s | 0s | App::Cmd::::full_arg0 App::Cmd::full_arg0
0 | 0 | 0 | 0s | 0s | App::Cmd::::global_options App::Cmd::global_options
0 | 0 | 0 | 0s | 0s | App::Cmd::::run App::Cmd::run
0 | 0 | 0 | 0s | 0s | App::Cmd::::usage App::Cmd::usage
0 | 0 | 0 | 0s | 0s | App::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
--- | --- | --- | --- | --- | ---
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 use strict; # 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 use warnings; # 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 use 5.006; # 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 use App::Cmd::ArgProcessor; # 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 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 |  |  |  |  |
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 use File::Basename (); # 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 use Module::Pluggable::Object (); # 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 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 |  |  |  |  | },
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 sub _setup_command {
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 no strict 'refs'; # 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 sub new {
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 |  |  |  |  | # 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 {
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 |  |  |  |  | # 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 {
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 sub _register_command {
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 sub should_ignore {
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 sub _module_pluggable_options {
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 sub _load_default_plugin {
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 sub prepare_args {
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 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 |  |  |  |  |
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 sub prepare_command {
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 sub _prepare_command {
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 sub _default_command_base {
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 sub _default_plugin_base {
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 sub plugin_search_path {
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 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 |  |  |  |  |
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 sub set_global_options {
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 sub plugin_for {
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 sub get_command {
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 sub _cmd_from_args {
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 sub _global_option_processing_params {
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 sub usage_desc {
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 sub global_opt_spec {
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 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