| 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 | App::Cmd::BEGIN@12 |
| 1 | 1 | 1 | 1.90ms | 2.53ms | App::Cmd::BEGIN@15 |
| 1 | 1 | 1 | 1.57ms | 1.68ms | App::Cmd::BEGIN@11 |
| 1 | 1 | 1 | 944µs | 12.3ms | App::Cmd::BEGIN@13 |
| 1 | 1 | 1 | 390µs | 429µs | App::Cmd::BEGIN@7 |
| 3 | 3 | 1 | 124µs | 54.2ms | App::Cmd::_command |
| 3 | 1 | 1 | 94µs | 206µs | App::Cmd::_setup_command |
| 3 | 1 | 1 | 50µs | 2.51ms | App::Cmd::_load_default_plugin |
| 4 | 2 | 1 | 41µs | 4.02ms | App::Cmd::_plugins |
| 1 | 1 | 1 | 30µs | 36µs | App::Cmd::global_opt_spec |
| 1 | 1 | 1 | 28µs | 19.4ms | App::Cmd::get_command |
| 1 | 1 | 1 | 23µs | 20.2ms | App::Cmd::prepare_command |
| 1 | 1 | 1 | 21µs | 30µs | App::Cmd::Setup::BEGIN@1 |
| 1 | 1 | 1 | 21µs | 21µs | App::Cmd::Setup::BEGIN@3 |
| 3 | 1 | 1 | 18µs | 25µs | App::Cmd::_register_command |
| 1 | 1 | 1 | 16µs | 54.3ms | App::Cmd::new |
| 3 | 1 | 1 | 15µs | 15µs | App::Cmd::should_ignore |
| 1 | 1 | 1 | 15µs | 745µs | App::Cmd::_prepare_command |
| 1 | 1 | 1 | 14µs | 20µs | App::Cmd::plugin_search_path |
| 1 | 1 | 1 | 13µs | 50µs | App::Cmd::_global_option_processing_params |
| 1 | 1 | 1 | 9µs | 13µs | App::Cmd::plugin_for |
| 1 | 1 | 1 | 7µs | 7µs | App::Cmd::BEGIN@8 |
| 1 | 1 | 1 | 7µs | 40µs | App::Cmd::BEGIN@346 |
| 1 | 1 | 1 | 6µs | 14µs | App::Cmd::BEGIN@36 |
| 1 | 1 | 1 | 5µs | 8µs | App::Cmd::Setup::BEGIN@2 |
| 2 | 2 | 2 | 4µs | 4µs | App::Cmd::_default_command_base |
| 4 | 1 | 1 | 4µs | 4µs | App::Cmd::CORE:subst (opcode) |
| 1 | 1 | 1 | 3µs | 3µs | App::Cmd::_default_plugin_base |
| 1 | 1 | 1 | 3µs | 3µs | App::Cmd::prepare_args |
| 1 | 1 | 1 | 2µs | 2µs | App::Cmd::_cmd_from_args |
| 1 | 1 | 1 | 2µs | 2µs | App::Cmd::CORE:sort (opcode) |
| 1 | 1 | 1 | 2µs | 2µs | App::Cmd::set_global_options |
| 1 | 1 | 1 | 1µs | 1µs | App::Cmd::allow_any_unambiguous_abbrev |
| 1 | 1 | 1 | 1µs | 1µs | App::Cmd::usage_desc |
| 1 | 1 | 1 | 900ns | 900ns | App::Cmd::_module_pluggable_options |
| 0 | 0 | 0 | 0s | 0s | App::Cmd::END |
| 0 | 0 | 0 | 0s | 0s | App::Cmd::__ANON__[:22] |
| 0 | 0 | 0 | 0s | 0s | App::Cmd::_bad_command |
| 0 | 0 | 0 | 0s | 0s | App::Cmd::_plugin_plugins |
| 0 | 0 | 0 | 0s | 0s | App::Cmd::_prepare_default_command |
| 0 | 0 | 0 | 0s | 0s | App::Cmd::_register_ignore |
| 0 | 0 | 0 | 0s | 0s | App::Cmd::_setup_ignore |
| 0 | 0 | 0 | 0s | 0s | App::Cmd::_usage_text |
| 0 | 0 | 0 | 0s | 0s | App::Cmd::arg0 |
| 0 | 0 | 0 | 0s | 0s | App::Cmd::command_groups |
| 0 | 0 | 0 | 0s | 0s | App::Cmd::command_names |
| 0 | 0 | 0 | 0s | 0s | App::Cmd::command_plugins |
| 0 | 0 | 0 | 0s | 0s | App::Cmd::default_command |
| 0 | 0 | 0 | 0s | 0s | App::Cmd::execute_command |
| 0 | 0 | 0 | 0s | 0s | App::Cmd::full_arg0 |
| 0 | 0 | 0 | 0s | 0s | App::Cmd::global_options |
| 0 | 0 | 0 | 0s | 0s | App::Cmd::run |
| 0 | 0 | 0 | 0s | 0s | App::Cmd::usage |
| 0 | 0 | 0 | 0s | 0s | App::Cmd::usage_error |
| 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 |