| Filename | /home/ss5/perl5/perlbrew/perls/perl-5.22.0/lib/site_perl/5.22.0/App/Rad.pm |
| Statements | Executed 839 statements in 3.05ms |
| Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
|---|---|---|---|---|---|
| 1 | 1 | 1 | 5.15ms | 8.85ms | App::Rad::getopt |
| 2 | 2 | 1 | 659µs | 659µs | App::Rad::_get_subs_from |
| 1 | 1 | 1 | 302µs | 6.03ms | App::Rad::BEGIN@3 |
| 1 | 1 | 1 | 296µs | 53.5s | App::Rad::run |
| 1 | 1 | 1 | 117µs | 459µs | App::Rad::register_commands |
| 3 | 3 | 2 | 47µs | 61µs | App::Rad::register |
| 1 | 1 | 1 | 46µs | 394µs | App::Rad::_register_functions |
| 1 | 1 | 1 | 40µs | 53.5s | App::Rad::execute |
| 1 | 1 | 1 | 28µs | 85µs | App::Rad::_init |
| 1 | 1 | 1 | 26µs | 35µs | App::Rad::_tinygetopt |
| 26 | 10 | 1 | 23µs | 23µs | App::Rad::debug |
| 1 | 1 | 1 | 22µs | 61µs | App::Rad::_get_input |
| 1 | 1 | 1 | 12µs | 12µs | App::Rad::BEGIN@2 |
| 6 | 6 | 2 | 9µs | 9µs | App::Rad::argv |
| 1 | 1 | 1 | 8µs | 11µs | App::Rad::post_process |
| 7 | 7 | 2 | 7µs | 7µs | App::Rad::options |
| 1 | 1 | 1 | 6µs | 14µs | App::Rad::BEGIN@93 |
| 4 | 1 | 1 | 5µs | 5µs | App::Rad::CORE:match (opcode) |
| 1 | 1 | 1 | 5µs | 5µs | App::Rad::unregister |
| 1 | 1 | 1 | 5µs | 11µs | App::Rad::BEGIN@121 |
| 2 | 2 | 1 | 5µs | 5µs | App::Rad::cmd |
| 1 | 1 | 1 | 5µs | 6µs | App::Rad::BEGIN@6 |
| 1 | 1 | 1 | 4µs | 10µs | App::Rad::unregister_command |
| 1 | 1 | 1 | 3µs | 7µs | App::Rad::BEGIN@5 |
| 1 | 1 | 1 | 3µs | 3µs | App::Rad::output |
| 1 | 1 | 1 | 3µs | 3µs | App::Rad::is_command |
| 1 | 1 | 1 | 3µs | 3µs | App::Rad::BEGIN@4 |
| 1 | 1 | 1 | 2µs | 2µs | App::Rad::import |
| 1 | 1 | 1 | 1µs | 1µs | App::Rad::pre_process |
| 0 | 0 | 0 | 0s | 0s | App::Rad::command |
| 0 | 0 | 0 | 0s | 0s | App::Rad::commands |
| 0 | 0 | 0 | 0s | 0s | App::Rad::config |
| 0 | 0 | 0 | 0s | 0s | App::Rad::create_command_name |
| 0 | 0 | 0 | 0s | 0s | App::Rad::default |
| 0 | 0 | 0 | 0s | 0s | App::Rad::invalid |
| 0 | 0 | 0 | 0s | 0s | App::Rad::load_config |
| 0 | 0 | 0 | 0s | 0s | App::Rad::load_plugin |
| 0 | 0 | 0 | 0s | 0s | App::Rad::plugins |
| 0 | 0 | 0 | 0s | 0s | App::Rad::register_command |
| 0 | 0 | 0 | 0s | 0s | App::Rad::setup |
| 0 | 0 | 0 | 0s | 0s | App::Rad::stash |
| 0 | 0 | 0 | 0s | 0s | App::Rad::teardown |
| Line | State ments |
Time on line |
Calls | Time in subs |
Code |
|---|---|---|---|---|---|
| 1 | package App::Rad; | ||||
| 2 | 2 | 27µs | 1 | 12µs | # spent 12µs within App::Rad::BEGIN@2 which was called:
# once (12µs+0s) by main::BEGIN@9 at line 2 # spent 12µs making 1 call to App::Rad::BEGIN@2 |
| 3 | 2 | 56µs | 1 | 6.03ms | # spent 6.03ms (302µs+5.72) within App::Rad::BEGIN@3 which was called:
# once (302µs+5.72ms) by main::BEGIN@9 at line 3 # spent 6.03ms making 1 call to App::Rad::BEGIN@3 |
| 4 | 2 | 12µs | 1 | 3µs | # spent 3µs within App::Rad::BEGIN@4 which was called:
# once (3µs+0s) by main::BEGIN@9 at line 4 # spent 3µs making 1 call to App::Rad::BEGIN@4 |
| 5 | 2 | 12µs | 2 | 10µs | # spent 7µs (3+4) within App::Rad::BEGIN@5 which was called:
# once (3µs+4µs) by main::BEGIN@9 at line 5 # spent 7µs making 1 call to App::Rad::BEGIN@5
# spent 4µs making 1 call to warnings::import |
| 6 | 2 | 207µs | 2 | 7µs | # spent 6µs (5+1) within App::Rad::BEGIN@6 which was called:
# once (5µs+1µs) by main::BEGIN@9 at line 6 # spent 6µs making 1 call to App::Rad::BEGIN@6
# spent 1µs making 1 call to strict::import |
| 7 | |||||
| 8 | 1 | 400ns | our $VERSION = '1.05'; | ||
| 9 | { | ||||
| 10 | |||||
| 11 | #========================# | ||||
| 12 | # INTERNAL FUNCTIONS # | ||||
| 13 | #========================# | ||||
| 14 | |||||
| 15 | 1 | 700ns | my @OPTIONS = (); | ||
| 16 | |||||
| 17 | # spent 85µs (28+57) within App::Rad::_init which was called:
# once (28µs+57µs) by App::Rad::run at line 358 | ||||
| 18 | 1 | 600ns | my $c = shift; | ||
| 19 | |||||
| 20 | # instantiate references for the first time | ||||
| 21 | 1 | 5µs | $c->{'_ARGV' } = []; | ||
| 22 | 1 | 1µs | $c->{'_options'} = {}; | ||
| 23 | 1 | 700ns | $c->{'_stash' } = {}; | ||
| 24 | 1 | 2µs | $c->{'_config' } = {}; | ||
| 25 | 1 | 700ns | $c->{'_plugins'} = []; | ||
| 26 | |||||
| 27 | # this internal variable holds | ||||
| 28 | # references to all special | ||||
| 29 | # pre-defined control functions | ||||
| 30 | 1 | 6µs | $c->{'_functions'} = { | ||
| 31 | 'setup' => \&setup, | ||||
| 32 | 'pre_process' => \&pre_process, | ||||
| 33 | 'post_process' => \&post_process, | ||||
| 34 | 'default' => \&default, | ||||
| 35 | 'invalid' => \&invalid, | ||||
| 36 | 'teardown' => \&teardown, | ||||
| 37 | }; | ||||
| 38 | |||||
| 39 | #load extensions | ||||
| 40 | 1 | 16µs | 1 | 57µs | App::Rad::Help->load($c); # spent 57µs making 1 call to App::Rad::Help::load |
| 41 | 1 | 2µs | foreach (@OPTIONS) { | ||
| 42 | if ($_ eq 'include') { | ||||
| 43 | eval 'use App::Rad::Include; App::Rad::Include->load($c)'; | ||||
| 44 | Carp::croak 'error loading "include" extension.' if ($@); | ||||
| 45 | } | ||||
| 46 | elsif ($_ eq 'exclude') { | ||||
| 47 | eval 'use App::Rad::Exclude; App::Rad::Exclude->load($c)'; | ||||
| 48 | Carp::croak 'error loading "exclude" extension.' if ($@); | ||||
| 49 | } | ||||
| 50 | elsif ($_ eq 'debug') { | ||||
| 51 | $c->{'debug'} = 1; | ||||
| 52 | } | ||||
| 53 | else { | ||||
| 54 | $c->load_plugin($_); | ||||
| 55 | } | ||||
| 56 | } | ||||
| 57 | |||||
| 58 | # tiny cheat to avoid doing a lot of processing | ||||
| 59 | # when not in debug mode. If needed, I'll create | ||||
| 60 | # an actual is_debugging() method or something | ||||
| 61 | 1 | 3µs | if ($c->{'debug'}) { | ||
| 62 | $c->debug('initializing: default commands are: ' | ||||
| 63 | . join ( ', ', $c->commands() ) | ||||
| 64 | ); | ||||
| 65 | } | ||||
| 66 | } | ||||
| 67 | |||||
| 68 | # spent 2µs within App::Rad::import which was called:
# once (2µs+0s) by main::BEGIN@9 at line 9 of /home/ss5/perl5/perlbrew/perls/perl-5.22.0/bin/benchmarkanything-storage | ||||
| 69 | 1 | 300ns | my $class = shift; | ||
| 70 | 1 | 5µs | @OPTIONS = @_; | ||
| 71 | } | ||||
| 72 | |||||
| 73 | sub load_plugin { | ||||
| 74 | my $c = shift; | ||||
| 75 | my $plugin = shift; | ||||
| 76 | my $class = ref $c; | ||||
| 77 | |||||
| 78 | my $plugin_fullname = ''; | ||||
| 79 | if ($plugin =~ s{^\+}{} ) { | ||||
| 80 | $plugin_fullname = $plugin; | ||||
| 81 | } | ||||
| 82 | else { | ||||
| 83 | $plugin_fullname = "App::Rad::Plugin::$plugin"; | ||||
| 84 | } | ||||
| 85 | eval "use $plugin_fullname ()"; | ||||
| 86 | Carp::croak "error loading plugin '$plugin_fullname': $@\n" | ||||
| 87 | if $@; | ||||
| 88 | my %methods = _get_subs_from($plugin_fullname); | ||||
| 89 | |||||
| 90 | Carp::croak "No methods found for plugin '$plugin_fullname'\n" | ||||
| 91 | unless keys %methods > 0; | ||||
| 92 | |||||
| 93 | 2 | 89µs | 2 | 22µs | # spent 14µs (6+8) within App::Rad::BEGIN@93 which was called:
# once (6µs+8µs) by main::BEGIN@9 at line 93 # spent 14µs making 1 call to App::Rad::BEGIN@93
# spent 8µs making 1 call to strict::unimport |
| 94 | foreach my $method (keys %methods) { | ||||
| 95 | # don't add plugin's internal methods | ||||
| 96 | next if substr ($method, 0, 1) eq '_'; | ||||
| 97 | |||||
| 98 | *{"$class\::$method"} = $methods{$method}; | ||||
| 99 | $c->debug("-- method '$method' added [$plugin_fullname]"); | ||||
| 100 | |||||
| 101 | # fill $c->plugins() | ||||
| 102 | push @{ $c->{'_plugins'} }, $plugin; | ||||
| 103 | } | ||||
| 104 | } | ||||
| 105 | |||||
| 106 | # this function browses a file's | ||||
| 107 | # symbol table (usually 'main') and maps | ||||
| 108 | # each function to a hash | ||||
| 109 | # | ||||
| 110 | # FIXME: if I create a sub here (Rad.pm) and | ||||
| 111 | # there is a global variable with that same name | ||||
| 112 | # inside the user's program (e.g.: sub ARGV {}), | ||||
| 113 | # the name will appear here as a command. It really | ||||
| 114 | # shouldn't... | ||||
| 115 | sub _get_subs_from { | ||||
| 116 | 2 | 1µs | my $package = shift || 'main'; | ||
| 117 | 2 | 2µs | $package .= '::'; | ||
| 118 | |||||
| 119 | 2 | 2µs | my %subs = (); | ||
| 120 | |||||
| 121 | 2 | 1.04ms | 2 | 18µs | # spent 11µs (5+6) within App::Rad::BEGIN@121 which was called:
# once (5µs+6µs) by main::BEGIN@9 at line 121 # spent 11µs making 1 call to App::Rad::BEGIN@121
# spent 6µs making 1 call to strict::unimport |
| 122 | 2 | 446µs | while (my ($key, $value) = ( each %{*{$package}} )) { | ||
| 123 | 288 | 69µs | local (*SYMBOL) = $value; | ||
| 124 | 288 | 104µs | if ( defined $value && defined *SYMBOL{CODE} ) { | ||
| 125 | $subs{$key} = $value; | ||||
| 126 | } | ||||
| 127 | } | ||||
| 128 | 2 | 40µs | return %subs; | ||
| 129 | } | ||||
| 130 | |||||
| 131 | |||||
| 132 | # overrides our pre-defined control | ||||
| 133 | # functions with any available | ||||
| 134 | # user-defined ones | ||||
| 135 | # spent 394µs (46+348) within App::Rad::_register_functions which was called:
# once (46µs+348µs) by App::Rad::run at line 362 | ||||
| 136 | 1 | 500ns | my $c = shift; | ||
| 137 | 1 | 19µs | 1 | 346µs | my %subs = _get_subs_from('main'); # spent 346µs making 1 call to App::Rad::_get_subs_from |
| 138 | |||||
| 139 | # replaces only if the function is | ||||
| 140 | # in 'default', 'pre_process' or 'post_process' | ||||
| 141 | 1 | 14µs | foreach ( keys %{$c->{'_functions'}} ) { | ||
| 142 | 6 | 3µs | if ( defined $subs{$_} ) { | ||
| 143 | 2 | 4µs | 2 | 2µs | $c->debug("overriding $_ with user-defined function."); # spent 2µs making 2 calls to App::Rad::debug, avg 1µs/call |
| 144 | 2 | 2µs | $c->{'_functions'}->{$_} = $subs{$_}; | ||
| 145 | } | ||||
| 146 | } | ||||
| 147 | } | ||||
| 148 | |||||
| 149 | # retrieves command line arguments | ||||
| 150 | # to be executed by the main program | ||||
| 151 | # spent 61µs (22+39) within App::Rad::_get_input which was called:
# once (22µs+39µs) by App::Rad::run at line 370 | ||||
| 152 | 1 | 400ns | my $c = shift; | ||
| 153 | |||||
| 154 | 1 | 2µs | my $cmd = (defined ($ARGV[0]) and substr($ARGV[0], 0, 1) ne '-') | ||
| 155 | ? shift @ARGV | ||||
| 156 | : '' | ||||
| 157 | ; | ||||
| 158 | |||||
| 159 | 1 | 4µs | 1 | 2µs | @{$c->argv} = @ARGV; # spent 2µs making 1 call to App::Rad::argv |
| 160 | 1 | 1µs | $c->{'cmd'} = $cmd; | ||
| 161 | |||||
| 162 | 1 | 2µs | 1 | 700ns | $c->debug('received command: ' . $c->{'cmd'}); # spent 700ns making 1 call to App::Rad::debug |
| 163 | 1 | 3µs | 2 | 1µs | $c->debug('received parameters: ' . join (' ', @{$c->argv} )); # spent 700ns making 1 call to App::Rad::debug
# spent 600ns making 1 call to App::Rad::argv |
| 164 | |||||
| 165 | 1 | 4µs | 1 | 35µs | $c->_tinygetopt(); # spent 35µs making 1 call to App::Rad::_tinygetopt |
| 166 | } | ||||
| 167 | |||||
| 168 | # stores arguments passed to a | ||||
| 169 | # command via --param[=value] or -p | ||||
| 170 | # spent 35µs (26+9) within App::Rad::_tinygetopt which was called:
# once (26µs+9µs) by App::Rad::_get_input at line 165 | ||||
| 171 | 1 | 300ns | my $c = shift; | ||
| 172 | |||||
| 173 | 1 | 500ns | my @argv = (); | ||
| 174 | 1 | 2µs | 1 | 700ns | foreach ( @{$c->argv} ) { # spent 700ns making 1 call to App::Rad::argv |
| 175 | |||||
| 176 | # single option (could be grouped) | ||||
| 177 | 2 | 21µs | 5 | 8µs | if ( m/^\-([^\-\=]+)$/o) { # spent 5µs making 4 calls to App::Rad::CORE:match, avg 1µs/call
# spent 3µs making 1 call to App::Rad::options |
| 178 | my @args = split //, $1; | ||||
| 179 | foreach (@args) { | ||||
| 180 | if ($c->options->{$_}) { | ||||
| 181 | $c->options->{$_}++; | ||||
| 182 | } | ||||
| 183 | else { | ||||
| 184 | $c->options->{$_} = 1; | ||||
| 185 | } | ||||
| 186 | } | ||||
| 187 | } | ||||
| 188 | # long option: --name or --name=value | ||||
| 189 | elsif (m/^\-\-([^\-\=]+)(?:\=(.+))?$/o) { | ||||
| 190 | $c->options->{$1} = defined $2 ? $2 | ||||
| 191 | : 1 | ||||
| 192 | ; | ||||
| 193 | } | ||||
| 194 | else { | ||||
| 195 | 1 | 800ns | push @argv, $_; | ||
| 196 | } | ||||
| 197 | } | ||||
| 198 | 1 | 5µs | 1 | 700ns | @{$c->argv} = @argv; # spent 700ns making 1 call to App::Rad::argv |
| 199 | } | ||||
| 200 | |||||
| 201 | |||||
| 202 | #========================# | ||||
| 203 | # PUBLIC METHODS # | ||||
| 204 | #========================# | ||||
| 205 | |||||
| 206 | sub load_config { | ||||
| 207 | require App::Rad::Config; | ||||
| 208 | App::Rad::Config::load_config(@_); | ||||
| 209 | } | ||||
| 210 | |||||
| 211 | |||||
| 212 | #TODO: this code probably could use some optimization | ||||
| 213 | # spent 459µs (117+342) within App::Rad::register_commands which was called:
# once (117µs+342µs) by main::setup at line 23 of /home/ss5/perl5/perlbrew/perls/perl-5.22.0/bin/benchmarkanything-storage | ||||
| 214 | 1 | 400ns | my $c = shift; | ||
| 215 | 1 | 2µs | my %help_for_sub = (); | ||
| 216 | 1 | 500ns | my %rules = (); | ||
| 217 | |||||
| 218 | # process parameters | ||||
| 219 | 1 | 900ns | foreach my $item (@_) { | ||
| 220 | 12 | 5µs | if ( ref ($item) ) { | ||
| 221 | Carp::croak '"register_commands" may receive only HASH references' | ||||
| 222 | unless ref ($item) eq 'HASH'; | ||||
| 223 | foreach my $params (keys %{$item}) { | ||||
| 224 | if ($params eq '-ignore_prefix' | ||||
| 225 | or $params eq '-ignore_suffix' | ||||
| 226 | or $params eq '-ignore_regexp' | ||||
| 227 | ) { | ||||
| 228 | $rules{$params} = $item->{$params}; | ||||
| 229 | } | ||||
| 230 | else { | ||||
| 231 | $help_for_sub{$params} = $item->{$params}; | ||||
| 232 | } | ||||
| 233 | } | ||||
| 234 | } | ||||
| 235 | else { | ||||
| 236 | 12 | 6µs | $help_for_sub{$item} = undef; # no help text | ||
| 237 | } | ||||
| 238 | } | ||||
| 239 | |||||
| 240 | 1 | 16µs | 1 | 314µs | my %subs = _get_subs_from('main'); # spent 314µs making 1 call to App::Rad::_get_subs_from |
| 241 | |||||
| 242 | 1 | 4µs | foreach (keys %help_for_sub) { | ||
| 243 | |||||
| 244 | # we only add the sub to the commands | ||||
| 245 | # list if it's *not* a control function | ||||
| 246 | 12 | 9µs | if ( not defined $c->{'_functions'}->{$_} ) { | ||
| 247 | |||||
| 248 | # user want to register a valid (existant) sub | ||||
| 249 | 12 | 4µs | if ( exists $subs{$_} ) { | ||
| 250 | 12 | 13µs | 12 | 8µs | $c->debug("registering $_ as a command."); # spent 8µs making 12 calls to App::Rad::debug, avg 633ns/call |
| 251 | 12 | 13µs | $c->{'_commands'}->{$_}->{'code'} = $subs{$_}; | ||
| 252 | 12 | 13µs | 12 | 20µs | App::Rad::Help->register_help($c, $_, $help_for_sub{$_}); # spent 20µs making 12 calls to App::Rad::Help::register_help, avg 2µs/call |
| 253 | } | ||||
| 254 | else { | ||||
| 255 | Carp::croak "'$_' does not appear to be a valid sub. Registering seems impossible.\n"; | ||||
| 256 | } | ||||
| 257 | } | ||||
| 258 | } | ||||
| 259 | |||||
| 260 | # no parameters, or params+rules: try to register everything | ||||
| 261 | 1 | 10µs | if ((!%help_for_sub) or %rules) { | ||
| 262 | foreach my $subname (keys %subs) { | ||||
| 263 | |||||
| 264 | # we only add the sub to the commands | ||||
| 265 | # list if it's *not* a control function | ||||
| 266 | if ( not defined $c->{'_functions'}->{$subname} ) { | ||||
| 267 | |||||
| 268 | if ( $rules{'-ignore_prefix'} ) { | ||||
| 269 | next if ( substr ($subname, 0, length($rules{'-ignore_prefix'})) | ||||
| 270 | eq $rules{'-ignore_prefix'} | ||||
| 271 | ); | ||||
| 272 | } | ||||
| 273 | if ( $rules{'-ignore_suffix'} ) { | ||||
| 274 | next if ( substr ($subname, | ||||
| 275 | length($subname) - length($rules{'-ignore_suffix'}), | ||||
| 276 | length($rules{'-ignore_suffix'}) | ||||
| 277 | ) | ||||
| 278 | eq $rules{'-ignore_suffix'} | ||||
| 279 | ); | ||||
| 280 | } | ||||
| 281 | if ( $rules{'-ignore_regexp'} ) { | ||||
| 282 | my $re = $rules{'-ignore_regexp'}; | ||||
| 283 | next if $subname =~ m/$re/o; | ||||
| 284 | } | ||||
| 285 | |||||
| 286 | # avoid duplicate registration | ||||
| 287 | if ( !exists $help_for_sub{$subname} ) { | ||||
| 288 | $c->{'_commands'}->{$subname}->{'code'} = $subs{$subname}; | ||||
| 289 | App::Rad::Help->register_help($c, $subname, undef); | ||||
| 290 | } | ||||
| 291 | } | ||||
| 292 | } | ||||
| 293 | } | ||||
| 294 | } | ||||
| 295 | |||||
| 296 | |||||
| 297 | sub register_command { return register(@_) } | ||||
| 298 | # spent 61µs (47+14) within App::Rad::register which was called 3 times, avg 20µs/call:
# once (30µs+9µs) by App::Rad::Help::load at line 10 of App/Rad/Help.pm
# once (10µs+3µs) by main::setup at line 24 of /home/ss5/perl5/perlbrew/perls/perl-5.22.0/bin/benchmarkanything-storage
# once (7µs+3µs) by main::setup at line 25 of /home/ss5/perl5/perlbrew/perls/perl-5.22.0/bin/benchmarkanything-storage | ||||
| 299 | 3 | 2µs | my ($c, $command_name, $coderef, $helptext) = @_; | ||
| 300 | 3 | 16µs | 3 | 5µs | $c->debug("got: " . ref $coderef); # spent 5µs making 3 calls to App::Rad::debug, avg 2µs/call |
| 301 | return undef | ||||
| 302 | 3 | 1µs | unless ( (ref $coderef) eq 'CODE' ); | ||
| 303 | |||||
| 304 | 3 | 4µs | 3 | 2µs | $c->debug("registering $command_name as a command."); # spent 2µs making 3 calls to App::Rad::debug, avg 633ns/call |
| 305 | 3 | 4µs | $c->{'_commands'}->{$command_name}->{'code'} = $coderef; | ||
| 306 | 3 | 6µs | 3 | 7µs | App::Rad::Help->register_help($c, $command_name, $helptext); # spent 7µs making 3 calls to App::Rad::Help::register_help, avg 2µs/call |
| 307 | 3 | 7µs | return $command_name; | ||
| 308 | } | ||||
| 309 | |||||
| 310 | 1 | 4µs | 1 | 5µs | # spent 10µs (4+5) within App::Rad::unregister_command which was called:
# once (4µs+5µs) by main::setup at line 22 of /home/ss5/perl5/perlbrew/perls/perl-5.22.0/bin/benchmarkanything-storage # spent 5µs making 1 call to App::Rad::unregister |
| 311 | # spent 5µs within App::Rad::unregister which was called:
# once (5µs+0s) by App::Rad::unregister_command at line 310 | ||||
| 312 | 1 | 2µs | my ($c, $command_name) = @_; | ||
| 313 | |||||
| 314 | 1 | 5µs | if ( $c->{'_commands'}->{$command_name} ) { | ||
| 315 | delete $c->{'_commands'}->{$command_name}; | ||||
| 316 | } | ||||
| 317 | else { | ||||
| 318 | return undef; | ||||
| 319 | } | ||||
| 320 | } | ||||
| 321 | |||||
| 322 | |||||
| 323 | sub create_command_name { | ||||
| 324 | my $id = 0; | ||||
| 325 | foreach (commands()) { | ||||
| 326 | if ( m/^cmd(\d+)$/ ) { | ||||
| 327 | $id = $1 if ($1 > $id); | ||||
| 328 | } | ||||
| 329 | } | ||||
| 330 | return 'cmd' . ($id + 1); | ||||
| 331 | } | ||||
| 332 | |||||
| 333 | |||||
| 334 | sub commands { | ||||
| 335 | return ( keys %{$_[0]->{'_commands'}} ); | ||||
| 336 | } | ||||
| 337 | |||||
| 338 | |||||
| 339 | # spent 3µs within App::Rad::is_command which was called:
# once (3µs+0s) by App::Rad::execute at line 405 | ||||
| 340 | 1 | 600ns | my ($c, $cmd) = @_; | ||
| 341 | 1 | 4µs | return (defined $c->{'_commands'}->{$cmd} | ||
| 342 | ? 1 | ||||
| 343 | : 0 | ||||
| 344 | ); | ||||
| 345 | } | ||||
| 346 | |||||
| 347 | sub command :lvalue { cmd(@_) } | ||||
| 348 | # spent 5µs within App::Rad::cmd which was called 2 times, avg 2µs/call:
# once (3µs+0s) by main::teardown at line 32 of /home/ss5/perl5/perlbrew/perls/perl-5.22.0/bin/benchmarkanything-storage
# once (2µs+0s) by main::_connect at line 167 of /home/ss5/perl5/perlbrew/perls/perl-5.22.0/bin/benchmarkanything-storage | ||||
| 349 | 2 | 8µs | $_[0]->{'cmd'}; | ||
| 350 | } | ||||
| 351 | |||||
| 352 | |||||
| 353 | # spent 53.5s (296µs+53.5) within App::Rad::run which was called:
# once (296µs+53.5s) by main::RUNTIME at line 17 of /home/ss5/perl5/perlbrew/perls/perl-5.22.0/bin/benchmarkanything-storage | ||||
| 354 | 1 | 700ns | my $class = shift; | ||
| 355 | 1 | 1µs | my $c = {}; | ||
| 356 | 1 | 800ns | bless $c, $class; | ||
| 357 | |||||
| 358 | 1 | 5µs | 1 | 85µs | $c->_init(); # spent 85µs making 1 call to App::Rad::_init |
| 359 | |||||
| 360 | # first we update the control functions | ||||
| 361 | # with any overriden value | ||||
| 362 | 1 | 2µs | 1 | 394µs | $c->_register_functions(); # spent 394µs making 1 call to App::Rad::_register_functions |
| 363 | |||||
| 364 | # then we run the setup to register | ||||
| 365 | # some commands | ||||
| 366 | 1 | 3µs | 1 | 506µs | $c->{'_functions'}->{'setup'}->($c); # spent 506µs making 1 call to main::setup |
| 367 | |||||
| 368 | # now we get the actual input from | ||||
| 369 | # the command line (someone using the app!) | ||||
| 370 | 1 | 2µs | 1 | 61µs | $c->_get_input(); # spent 61µs making 1 call to App::Rad::_get_input |
| 371 | |||||
| 372 | # run the specified command | ||||
| 373 | 1 | 2µs | 1 | 53.5s | $c->execute(); # spent 53.5s making 1 call to App::Rad::execute |
| 374 | |||||
| 375 | # that's it. Tear down everything and go home :) | ||||
| 376 | 1 | 5µs | 1 | 55µs | $c->{'_functions'}->{'teardown'}->($c); # spent 55µs making 1 call to main::teardown |
| 377 | |||||
| 378 | 1 | 393µs | return 0; | ||
| 379 | } | ||||
| 380 | |||||
| 381 | # run operations | ||||
| 382 | # in a shell-like environment | ||||
| 383 | #sub shell { | ||||
| 384 | # my $class = shift; | ||||
| 385 | # App::Rad::Shell::shell($class); | ||||
| 386 | #} | ||||
| 387 | |||||
| 388 | # spent 53.5s (40µs+53.5) within App::Rad::execute which was called:
# once (40µs+53.5s) by App::Rad::run at line 373 | ||||
| 389 | 1 | 700ns | my ($c, $cmd) = @_; | ||
| 390 | |||||
| 391 | # given command has precedence | ||||
| 392 | 1 | 400ns | if ($cmd) { | ||
| 393 | $c->{'cmd'} = $cmd; | ||||
| 394 | } | ||||
| 395 | else { | ||||
| 396 | 1 | 600ns | $cmd = $c->{'cmd'}; # now $cmd always has the called cmd | ||
| 397 | } | ||||
| 398 | |||||
| 399 | 1 | 1µs | 1 | 500ns | $c->debug('calling pre_process function...'); # spent 500ns making 1 call to App::Rad::debug |
| 400 | 1 | 2µs | 1 | 1µs | $c->{'_functions'}->{'pre_process'}->($c); # spent 1µs making 1 call to App::Rad::pre_process |
| 401 | |||||
| 402 | 1 | 2µs | 1 | 500ns | $c->debug("executing '$cmd'..."); # spent 500ns making 1 call to App::Rad::debug |
| 403 | |||||
| 404 | # valid command, run it | ||||
| 405 | 1 | 7µs | 2 | 53.5s | if ($c->is_command($c->{'cmd'}) ) { # spent 53.5s making 1 call to main::processqueue
# spent 3µs making 1 call to App::Rad::is_command |
| 406 | $c->{'output'} = $c->{'_commands'}->{$cmd}->{'code'}->($c); | ||||
| 407 | } | ||||
| 408 | # no command, run default() | ||||
| 409 | elsif ( $cmd eq '' ) { | ||||
| 410 | $c->debug('no command detected. Falling to default'); | ||||
| 411 | $c->{'output'} = $c->{'_functions'}->{'default'}->($c); | ||||
| 412 | } | ||||
| 413 | # invalid command, run invalid() | ||||
| 414 | else { | ||||
| 415 | $c->debug("'$cmd' is not a valid command. Falling to invalid."); | ||||
| 416 | $c->{'output'} = $c->{'_functions'}->{'invalid'}->($c); | ||||
| 417 | } | ||||
| 418 | |||||
| 419 | # 3: post-process the result | ||||
| 420 | # from the command | ||||
| 421 | 1 | 3µs | 1 | 3µs | $c->debug('calling post_process function...'); # spent 3µs making 1 call to App::Rad::debug |
| 422 | 1 | 3µs | 1 | 11µs | $c->{'_functions'}->{'post_process'}->($c); # spent 11µs making 1 call to App::Rad::post_process |
| 423 | |||||
| 424 | 1 | 1µs | 1 | 600ns | $c->debug('reseting output'); # spent 600ns making 1 call to App::Rad::debug |
| 425 | 1 | 3µs | $c->{'output'} = undef; | ||
| 426 | } | ||||
| 427 | |||||
| 428 | 6 | 17µs | # spent 9µs within App::Rad::argv which was called 6 times, avg 1µs/call:
# once (3µs+0s) by main::_set_defaults at line 215 of /home/ss5/perl5/perlbrew/perls/perl-5.22.0/bin/benchmarkanything-storage
# once (2µs+0s) by App::Rad::getopt at line 455
# once (2µs+0s) by App::Rad::_get_input at line 159
# once (700ns+0s) by App::Rad::_tinygetopt at line 198
# once (700ns+0s) by App::Rad::_tinygetopt at line 174
# once (600ns+0s) by App::Rad::_get_input at line 163 | ||
| 429 | 7 | 14µs | # spent 7µs within App::Rad::options which was called 7 times, avg 1µs/call:
# once (3µs+0s) by App::Rad::_tinygetopt at line 177
# once (2µs+0s) by main::_connect at line 159 of /home/ss5/perl5/perlbrew/perls/perl-5.22.0/bin/benchmarkanything-storage
# once (1µs+0s) by main::_set_defaults at line 216 of /home/ss5/perl5/perlbrew/perls/perl-5.22.0/bin/benchmarkanything-storage
# once (300ns+0s) by main::_set_defaults at line 217 of /home/ss5/perl5/perlbrew/perls/perl-5.22.0/bin/benchmarkanything-storage
# once (200ns+0s) by main::_set_defaults at line 218 of /home/ss5/perl5/perlbrew/perls/perl-5.22.0/bin/benchmarkanything-storage
# once (200ns+0s) by main::_processqueue at line 405 of /home/ss5/perl5/perlbrew/perls/perl-5.22.0/bin/benchmarkanything-storage
# once (200ns+0s) by main::_set_defaults at line 219 of /home/ss5/perl5/perlbrew/perls/perl-5.22.0/bin/benchmarkanything-storage | ||
| 430 | sub stash { return $_[0]->{'_stash'} } | ||||
| 431 | sub config { return $_[0]->{'_config'} } | ||||
| 432 | |||||
| 433 | # $c->plugins is sort of "read-only" externally | ||||
| 434 | sub plugins { | ||||
| 435 | my @plugins = @{$_[0]->{'_plugins'}}; | ||||
| 436 | return @plugins; | ||||
| 437 | } | ||||
| 438 | |||||
| 439 | |||||
| 440 | # spent 8.85ms (5.15+3.70) within App::Rad::getopt which was called:
# once (5.15ms+3.70ms) by main::_getopt at line 185 of /home/ss5/perl5/perlbrew/perls/perl-5.22.0/bin/benchmarkanything-storage | ||||
| 441 | 1 | 79µs | require Getopt::Long; | ||
| 442 | 1 | 2µs | Carp::croak "Getopt::Long needs to be version 2.36 or above" | ||
| 443 | unless $Getopt::Long::VERSION >= 2.36; | ||||
| 444 | |||||
| 445 | 1 | 4µs | my ($c, @options) = @_; | ||
| 446 | |||||
| 447 | # reset values from tinygetopt | ||||
| 448 | 1 | 2µs | $c->{'_options'} = {}; | ||
| 449 | |||||
| 450 | 1 | 3µs | 1 | 13µs | my $parser = new Getopt::Long::Parser; # spent 13µs making 1 call to Getopt::Long::Parser::new |
| 451 | 1 | 2µs | 1 | 29µs | $parser->configure( qw(bundling) ); # spent 29µs making 1 call to Getopt::Long::Parser::configure |
| 452 | |||||
| 453 | 1 | 1µs | my @tARGV = @ARGV; # we gotta stick to our API | ||
| 454 | 1 | 2µs | 1 | 539µs | my $ret = $parser->getoptions($c->{'_options'}, @options); # spent 539µs making 1 call to Getopt::Long::Parser::getoptions |
| 455 | 1 | 4µs | 1 | 2µs | @{$c->argv} = @ARGV; # spent 2µs making 1 call to App::Rad::argv |
| 456 | 1 | 2µs | @ARGV = @tARGV; | ||
| 457 | |||||
| 458 | 1 | 11µs | return $ret; | ||
| 459 | } | ||||
| 460 | |||||
| 461 | # spent 23µs within App::Rad::debug which was called 26 times, avg 885ns/call:
# 12 times (8µs+0s) by App::Rad::register_commands at line 250, avg 633ns/call
# 3 times (5µs+0s) by App::Rad::register at line 300, avg 2µs/call
# 3 times (2µs+0s) by App::Rad::register at line 304, avg 633ns/call
# 2 times (2µs+0s) by App::Rad::_register_functions at line 143, avg 1µs/call
# once (3µs+0s) by App::Rad::execute at line 421
# once (700ns+0s) by App::Rad::_get_input at line 163
# once (700ns+0s) by App::Rad::_get_input at line 162
# once (600ns+0s) by App::Rad::execute at line 424
# once (500ns+0s) by App::Rad::execute at line 399
# once (500ns+0s) by App::Rad::execute at line 402 | ||||
| 462 | 26 | 53µs | if (shift->{'debug'}) { | ||
| 463 | print "[debug] @_\n"; | ||||
| 464 | } | ||||
| 465 | } | ||||
| 466 | |||||
| 467 | # gets/sets the output (returned value) | ||||
| 468 | # of a command, to be post processed | ||||
| 469 | # spent 3µs within App::Rad::output which was called:
# once (3µs+0s) by App::Rad::post_process at line 493 | ||||
| 470 | 1 | 700ns | my ($c, @msg) = @_; | ||
| 471 | 1 | 700ns | if (@msg) { | ||
| 472 | $c->{'output'} = join(' ', @msg); | ||||
| 473 | } | ||||
| 474 | else { | ||||
| 475 | 1 | 4µs | return $c->{'output'}; | ||
| 476 | } | ||||
| 477 | } | ||||
| 478 | |||||
| 479 | |||||
| 480 | #=========================# | ||||
| 481 | # CONTROL FUNCTIONS # | ||||
| 482 | #=========================# | ||||
| 483 | |||||
| 484 | sub setup { $_[0]->register_commands( {-ignore_prefix => '_'} ) } | ||||
| 485 | |||||
| 486 | sub teardown {} | ||||
| 487 | |||||
| 488 | 1 | 3µs | # spent 1µs within App::Rad::pre_process which was called:
# once (1µs+0s) by App::Rad::execute at line 400 | ||
| 489 | |||||
| 490 | # spent 11µs (8+3) within App::Rad::post_process which was called:
# once (8µs+3µs) by App::Rad::execute at line 422 | ||||
| 491 | 1 | 2µs | my $c = shift; | ||
| 492 | |||||
| 493 | 1 | 4µs | 1 | 3µs | if ($c->output()) { # spent 3µs making 1 call to App::Rad::output |
| 494 | print $c->output() . $/; | ||||
| 495 | } | ||||
| 496 | } | ||||
| 497 | |||||
| 498 | |||||
| 499 | sub default { | ||||
| 500 | my $c = shift; | ||||
| 501 | return $c->{'_commands'}->{'help'}->{'code'}->($c); | ||||
| 502 | } | ||||
| 503 | |||||
| 504 | |||||
| 505 | sub invalid { | ||||
| 506 | my $c = shift; | ||||
| 507 | return $c->{'_functions'}->{'default'}->($c); | ||||
| 508 | } | ||||
| 509 | |||||
| 510 | |||||
| 511 | } | ||||
| 512 | 2 | 3µs | 42; # ...and thus ends thy module ;) | ||
| 513 | __END__ | ||||
# spent 5µs within App::Rad::CORE:match which was called 4 times, avg 1µs/call:
# 4 times (5µs+0s) by App::Rad::_tinygetopt at line 177, avg 1µs/call |