| Filename | /usr/local/share/perl/5.18.2/App/Cmd/Command.pm |
| Statements | Executed 31 statements in 863µs |
| Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
|---|---|---|---|---|---|
| 5 | 3 | 2 | 31µs | 54µs | App::Cmd::Command::command_names |
| 1 | 1 | 1 | 25µs | 718µs | App::Cmd::Command::prepare |
| 5 | 1 | 1 | 22µs | 22µs | App::Cmd::Command::CORE:match (opcode) |
| 1 | 1 | 1 | 20µs | 20µs | App::Cmd::Command::BEGIN@7 |
| 1 | 1 | 1 | 13µs | 25µs | App::Cmd::Setup::BEGIN@1.4 |
| 1 | 1 | 1 | 10µs | 30µs | App::Cmd::Command::_option_processing_params |
| 1 | 1 | 1 | 8µs | 12µs | App::Cmd::Setup::BEGIN@2.5 |
| 1 | 1 | 1 | 8µs | 16µs | App::Cmd::Command::usage_desc |
| 1 | 1 | 1 | 5µs | 5µs | App::Cmd::Command::BEGIN@6 |
| 1 | 1 | 1 | 5µs | 5µs | App::Cmd::Command::new |
| 1 | 1 | 1 | 3µs | 3µs | App::Cmd::Command::BEGIN@11 |
| 0 | 0 | 0 | 0s | 0s | App::Cmd::Command::_usage_text |
| 0 | 0 | 0 | 0s | 0s | App::Cmd::Command::abstract |
| 0 | 0 | 0 | 0s | 0s | App::Cmd::Command::app |
| 0 | 0 | 0 | 0s | 0s | App::Cmd::Command::description |
| 0 | 0 | 0 | 0s | 0s | App::Cmd::Command::execute |
| 0 | 0 | 0 | 0s | 0s | App::Cmd::Command::opt_spec |
| 0 | 0 | 0 | 0s | 0s | App::Cmd::Command::usage |
| 0 | 0 | 0 | 0s | 0s | App::Cmd::Command::usage_error |
| 0 | 0 | 0 | 0s | 0s | App::Cmd::Command::validate_args |
| Line | State ments |
Time on line |
Calls | Time in subs |
Code |
|---|---|---|---|---|---|
| 1 | 2 | 22µs | 2 | 37µs | # spent 25µs (13+12) within App::Cmd::Setup::BEGIN@1.4 which was called:
# once (13µs+12µs) by App::Cmd::Setup::BEGIN@73 at line 1 # spent 25µs making 1 call to App::Cmd::Setup::BEGIN@1.4
# spent 12µs making 1 call to strict::import |
| 2 | 2 | 30µs | 2 | 16µs | # spent 12µs (8+4) within App::Cmd::Setup::BEGIN@2.5 which was called:
# once (8µs+4µs) by App::Cmd::Setup::BEGIN@73 at line 2 # spent 12µs making 1 call to App::Cmd::Setup::BEGIN@2.5
# spent 4µs making 1 call to warnings::import |
| 3 | |||||
| 4 | package App::Cmd::Command; | ||||
| 5 | 1 | 500ns | $App::Cmd::Command::VERSION = '0.330'; | ||
| 6 | 2 | 30µs | 1 | 5µs | # spent 5µs within App::Cmd::Command::BEGIN@6 which was called:
# once (5µs+0s) by App::Cmd::Setup::BEGIN@73 at line 6 # spent 5µs making 1 call to App::Cmd::Command::BEGIN@6 |
| 7 | 1 | 50µs | 1 | 20µs | # spent 20µs within App::Cmd::Command::BEGIN@7 which was called:
# once (20µs+0s) by App::Cmd::Setup::BEGIN@73 at line 7 # spent 20µs making 1 call to App::Cmd::Command::BEGIN@7 |
| 8 | |||||
| 9 | # ABSTRACT: a base class for App::Cmd commands | ||||
| 10 | |||||
| 11 | 2 | 624µs | 1 | 3µs | # spent 3µs within App::Cmd::Command::BEGIN@11 which was called:
# once (3µs+0s) by App::Cmd::Setup::BEGIN@73 at line 11 # spent 3µs making 1 call to App::Cmd::Command::BEGIN@11 |
| 12 | |||||
| 13 | #pod =method prepare | ||||
| 14 | #pod | ||||
| 15 | #pod my ($cmd, $opt, $args) = $class->prepare($app, @args); | ||||
| 16 | #pod | ||||
| 17 | #pod This method is the primary way in which App::Cmd::Command objects are built. | ||||
| 18 | #pod Given the remaining command line arguments meant for the command, it returns | ||||
| 19 | #pod the Command object, parsed options (as a hashref), and remaining arguments (as | ||||
| 20 | #pod an arrayref). | ||||
| 21 | #pod | ||||
| 22 | #pod In the usage above, C<$app> is the App::Cmd object that is invoking the | ||||
| 23 | #pod command. | ||||
| 24 | #pod | ||||
| 25 | #pod =cut | ||||
| 26 | |||||
| 27 | # spent 718µs (25+693) within App::Cmd::Command::prepare which was called:
# once (25µs+693µs) by App::Cmd::_prepare_command at line 421 of App/Cmd.pm | ||||
| 28 | 1 | 900ns | my ($class, $app, @args) = @_; | ||
| 29 | |||||
| 30 | 1 | 12µs | 2 | 688µs | my ($opt, $args, %fields) # spent 658µs making 1 call to App::Cmd::ArgProcessor::_process_args
# spent 30µs making 1 call to App::Cmd::Command::_option_processing_params |
| 31 | = $class->_process_args(\@args, $class->_option_processing_params($app)); | ||||
| 32 | |||||
| 33 | return ( | ||||
| 34 | 1 | 9µs | 1 | 5µs | $class->new({ app => $app, %fields }), # spent 5µs making 1 call to App::Cmd::Command::new |
| 35 | $opt, | ||||
| 36 | @$args, | ||||
| 37 | ); | ||||
| 38 | } | ||||
| 39 | |||||
| 40 | # spent 30µs (10+20) within App::Cmd::Command::_option_processing_params which was called:
# once (10µs+20µs) by App::Cmd::Command::prepare at line 30 | ||||
| 41 | 1 | 1µs | my ($class, @args) = @_; | ||
| 42 | |||||
| 43 | return ( | ||||
| 44 | 1 | 9µs | 2 | 20µs | $class->usage_desc(@args), # spent 16µs making 1 call to App::Cmd::Command::usage_desc
# spent 4µs making 1 call to PONAPI::CLI::Command::demo::opt_spec |
| 45 | $class->opt_spec(@args), | ||||
| 46 | ); | ||||
| 47 | } | ||||
| 48 | |||||
| 49 | #pod =method new | ||||
| 50 | #pod | ||||
| 51 | #pod This returns a new instance of the command plugin. Probably only C<prepare> | ||||
| 52 | #pod should use this. | ||||
| 53 | #pod | ||||
| 54 | #pod =cut | ||||
| 55 | |||||
| 56 | # spent 5µs within App::Cmd::Command::new which was called:
# once (5µs+0s) by App::Cmd::Command::prepare at line 34 | ||||
| 57 | 1 | 2µs | my ($class, $arg) = @_; | ||
| 58 | 1 | 4µs | bless $arg => $class; | ||
| 59 | } | ||||
| 60 | |||||
| 61 | #pod =method execute | ||||
| 62 | #pod | ||||
| 63 | #pod $command_plugin->execute(\%opt, \@args); | ||||
| 64 | #pod | ||||
| 65 | #pod This method does whatever it is the command should do! It is passed a hash | ||||
| 66 | #pod reference of the parsed command-line options and an array reference of left | ||||
| 67 | #pod over arguments. | ||||
| 68 | #pod | ||||
| 69 | #pod If no C<execute> method is defined, it will try to call C<run> -- but it will | ||||
| 70 | #pod warn about this behavior during testing, to remind you to fix the method name! | ||||
| 71 | #pod | ||||
| 72 | #pod =cut | ||||
| 73 | |||||
| 74 | sub execute { | ||||
| 75 | my $class = shift; | ||||
| 76 | |||||
| 77 | if (my $run = $class->can('run')) { | ||||
| 78 | warn "App::Cmd::Command subclasses should implement ->execute not ->run" | ||||
| 79 | if $ENV{HARNESS_ACTIVE}; | ||||
| 80 | |||||
| 81 | return $class->$run(@_); | ||||
| 82 | } | ||||
| 83 | |||||
| 84 | Carp::croak ref($class) . " does not implement mandatory method 'execute'\n"; | ||||
| 85 | } | ||||
| 86 | |||||
| 87 | #pod =method app | ||||
| 88 | #pod | ||||
| 89 | #pod This method returns the App::Cmd object into which this command is plugged. | ||||
| 90 | #pod | ||||
| 91 | #pod =cut | ||||
| 92 | |||||
| 93 | sub app { $_[0]->{app}; } | ||||
| 94 | |||||
| 95 | #pod =method usage | ||||
| 96 | #pod | ||||
| 97 | #pod This method returns the usage object for this command. (See | ||||
| 98 | #pod L<Getopt::Long::Descriptive>). | ||||
| 99 | #pod | ||||
| 100 | #pod =cut | ||||
| 101 | |||||
| 102 | sub usage { $_[0]->{usage}; } | ||||
| 103 | |||||
| 104 | #pod =method command_names | ||||
| 105 | #pod | ||||
| 106 | #pod This method returns a list of command names handled by this plugin. The | ||||
| 107 | #pod first item returned is the 'canonical' name of the command. | ||||
| 108 | #pod | ||||
| 109 | #pod If this method is not overridden by an App::Cmd::Command subclass, it will | ||||
| 110 | #pod return the last part of the plugin's package name, converted to lowercase. | ||||
| 111 | #pod For example, YourApp::Cmd::Command::Init will, by default, handle the command | ||||
| 112 | #pod "init". | ||||
| 113 | #pod | ||||
| 114 | #pod Subclasses should generally get the superclass value of C<command_names> | ||||
| 115 | #pod and then append aliases. | ||||
| 116 | #pod | ||||
| 117 | #pod =cut | ||||
| 118 | |||||
| 119 | # spent 54µs (31+22) within App::Cmd::Command::command_names which was called 5 times, avg 11µs/call:
# 3 times (20µs+15µs) by App::Cmd::_command at line 208 of App/Cmd.pm, avg 12µs/call
# once (6µs+4µs) by App::Cmd::_load_default_plugin at line 288 of App/Cmd.pm
# once (5µs+3µs) by App::Cmd::Command::usage_desc at line 138 | ||||
| 120 | # from UNIVERSAL::moniker | ||||
| 121 | 5 | 39µs | 5 | 22µs | (ref( $_[0] ) || $_[0]) =~ /([^:]+)$/; # spent 22µs making 5 calls to App::Cmd::Command::CORE:match, avg 4µs/call |
| 122 | 5 | 20µs | return lc $1; | ||
| 123 | } | ||||
| 124 | |||||
| 125 | #pod =method usage_desc | ||||
| 126 | #pod | ||||
| 127 | #pod This method should be overridden to provide a usage string. (This is the first | ||||
| 128 | #pod argument passed to C<describe_options> from Getopt::Long::Descriptive.) | ||||
| 129 | #pod | ||||
| 130 | #pod If not overridden, it returns "%c COMMAND %o"; COMMAND is the first item in | ||||
| 131 | #pod the result of the C<command_names> method. | ||||
| 132 | #pod | ||||
| 133 | #pod =cut | ||||
| 134 | |||||
| 135 | # spent 16µs (8+9) within App::Cmd::Command::usage_desc which was called:
# once (8µs+9µs) by App::Cmd::Command::_option_processing_params at line 44 | ||||
| 136 | 1 | 500ns | my ($self) = @_; | ||
| 137 | |||||
| 138 | 1 | 4µs | 1 | 9µs | my ($command) = $self->command_names; # spent 9µs making 1 call to App::Cmd::Command::command_names |
| 139 | 1 | 3µs | return "%c $command %o" | ||
| 140 | } | ||||
| 141 | |||||
| 142 | #pod =method opt_spec | ||||
| 143 | #pod | ||||
| 144 | #pod This method should be overridden to provide option specifications. (This is | ||||
| 145 | #pod list of arguments passed to C<describe_options> from Getopt::Long::Descriptive, | ||||
| 146 | #pod after the first.) | ||||
| 147 | #pod | ||||
| 148 | #pod If not overridden, it returns an empty list. | ||||
| 149 | #pod | ||||
| 150 | #pod =cut | ||||
| 151 | |||||
| 152 | sub opt_spec { | ||||
| 153 | return; | ||||
| 154 | } | ||||
| 155 | |||||
| 156 | #pod =method validate_args | ||||
| 157 | #pod | ||||
| 158 | #pod $command_plugin->validate_args(\%opt, \@args); | ||||
| 159 | #pod | ||||
| 160 | #pod This method is passed a hashref of command line options (as processed by | ||||
| 161 | #pod Getopt::Long::Descriptive) and an arrayref of leftover arguments. It may throw | ||||
| 162 | #pod an exception (preferably by calling C<usage_error>, below) if they are invalid, | ||||
| 163 | #pod or it may do nothing to allow processing to continue. | ||||
| 164 | #pod | ||||
| 165 | #pod =cut | ||||
| 166 | |||||
| 167 | sub validate_args { } | ||||
| 168 | |||||
| 169 | #pod =method usage_error | ||||
| 170 | #pod | ||||
| 171 | #pod $self->usage_error("This command must not be run by root!"); | ||||
| 172 | #pod | ||||
| 173 | #pod This method should be called to die with human-friendly usage output, during | ||||
| 174 | #pod C<validate_args>. | ||||
| 175 | #pod | ||||
| 176 | #pod =cut | ||||
| 177 | |||||
| 178 | sub usage_error { | ||||
| 179 | my ( $self, $error ) = @_; | ||||
| 180 | die "Error: $error\nUsage: " . $self->_usage_text; | ||||
| 181 | } | ||||
| 182 | |||||
| 183 | sub _usage_text { | ||||
| 184 | my ($self) = @_; | ||||
| 185 | local $@; | ||||
| 186 | join "\n", eval { $self->app->_usage_text }, eval { $self->usage->text }; | ||||
| 187 | } | ||||
| 188 | |||||
| 189 | #pod =method abstract | ||||
| 190 | #pod | ||||
| 191 | #pod This method returns a short description of the command's purpose. If this | ||||
| 192 | #pod method is not overridden, it will return the abstract from the module's Pod. | ||||
| 193 | #pod If it can't find the abstract, it will look for a comment starting with | ||||
| 194 | #pod "ABSTRACT:" like the ones used by L<Pod::Weaver::Section::Name>. | ||||
| 195 | #pod | ||||
| 196 | #pod =cut | ||||
| 197 | |||||
| 198 | # stolen from ExtUtils::MakeMaker | ||||
| 199 | sub abstract { | ||||
| 200 | my ($class) = @_; | ||||
| 201 | $class = ref $class if ref $class; | ||||
| 202 | |||||
| 203 | my $result; | ||||
| 204 | my $weaver_abstract; | ||||
| 205 | |||||
| 206 | # classname to filename | ||||
| 207 | (my $pm_file = $class) =~ s!::!/!g; | ||||
| 208 | $pm_file .= '.pm'; | ||||
| 209 | $pm_file = $INC{$pm_file} or return "(unknown)"; | ||||
| 210 | |||||
| 211 | # if the pm file exists, open it and parse it | ||||
| 212 | open my $fh, "<", $pm_file or return "(unknown)"; | ||||
| 213 | |||||
| 214 | local $/ = "\n"; | ||||
| 215 | my $inpod; | ||||
| 216 | |||||
| 217 | while (local $_ = <$fh>) { | ||||
| 218 | # =cut toggles, it doesn't end :-/ | ||||
| 219 | $inpod = /^=cut/ ? !$inpod : $inpod || /^=(?!cut)/; | ||||
| 220 | |||||
| 221 | if (/#+\s*ABSTRACT: (.*)/){ | ||||
| 222 | # takes ABSTRACT: ... if no POD defined yet | ||||
| 223 | $weaver_abstract = $1; | ||||
| 224 | } | ||||
| 225 | |||||
| 226 | next unless $inpod; | ||||
| 227 | chomp; | ||||
| 228 | |||||
| 229 | next unless /^(?:$class\s-\s)(.*)/; | ||||
| 230 | |||||
| 231 | $result = $1; | ||||
| 232 | last; | ||||
| 233 | } | ||||
| 234 | |||||
| 235 | return $result || $weaver_abstract || "(unknown)"; | ||||
| 236 | } | ||||
| 237 | |||||
| 238 | #pod =method description | ||||
| 239 | #pod | ||||
| 240 | #pod This method can be overridden to provide full option description. It | ||||
| 241 | #pod is used by the built-in L<help|App::Cmd::Command::help> command. | ||||
| 242 | #pod | ||||
| 243 | #pod If not overridden, it uses L<Pod::Usage> to extract the description | ||||
| 244 | #pod from the module's Pod DESCRIPTION section or the empty string. | ||||
| 245 | #pod | ||||
| 246 | #pod =cut | ||||
| 247 | |||||
| 248 | sub description { | ||||
| 249 | my ($class) = @_; | ||||
| 250 | $class = ref $class if ref $class; | ||||
| 251 | |||||
| 252 | # classname to filename | ||||
| 253 | (my $pm_file = $class) =~ s!::!/!g; | ||||
| 254 | $pm_file .= '.pm'; | ||||
| 255 | $pm_file = $INC{$pm_file} or return ''; | ||||
| 256 | |||||
| 257 | open my $input, "<", $pm_file or return ''; | ||||
| 258 | |||||
| 259 | my $descr = ""; | ||||
| 260 | open my $output, ">", \$descr; | ||||
| 261 | |||||
| 262 | require Pod::Usage; | ||||
| 263 | Pod::Usage::pod2usage( -input => $input, | ||||
| 264 | -output => $output, | ||||
| 265 | -exit => "NOEXIT", | ||||
| 266 | -verbose => 99, | ||||
| 267 | -sections => "DESCRIPTION", | ||||
| 268 | indent => 0 | ||||
| 269 | ); | ||||
| 270 | $descr =~ s/Description:\n//m; | ||||
| 271 | chomp $descr; | ||||
| 272 | |||||
| 273 | return $descr; | ||||
| 274 | } | ||||
| 275 | |||||
| 276 | 1 | 2µs | 1; | ||
| 277 | |||||
| 278 | __END__ | ||||
# spent 22µs within App::Cmd::Command::CORE:match which was called 5 times, avg 4µs/call:
# 5 times (22µs+0s) by App::Cmd::Command::command_names at line 121, avg 4µs/call |