| Filename | /home/ss5/perl5/perlbrew/perls/perl-5.14.1/lib/site_perl/5.14.1/App/Rad.pm |
| Statements | Executed 1276 statements in 19.5ms |
| Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
|---|---|---|---|---|---|
| 2 | 2 | 1 | 6.91ms | 6.91ms | App::Rad::_get_subs_from |
| 1 | 1 | 1 | 2.50ms | 35.4ms | App::Rad::BEGIN@3 |
| 1 | 1 | 1 | 568µs | 568µs | App::Rad::CORE:print (opcode) |
| 1 | 1 | 1 | 198µs | 3.65ms | App::Rad::register_commands |
| 1 | 1 | 1 | 182µs | 899µs | App::Rad::execute |
| 1 | 1 | 1 | 171µs | 8.86ms | App::Rad::run |
| 1 | 1 | 1 | 145µs | 3.70ms | App::Rad::_register_functions |
| 12 | 10 | 1 | 106µs | 106µs | App::Rad::debug |
| 1 | 1 | 1 | 92µs | 169µs | App::Rad::_get_input |
| 1 | 1 | 1 | 89µs | 89µs | App::Rad::BEGIN@2 |
| 1 | 1 | 1 | 73µs | 189µs | App::Rad::_init |
| 1 | 1 | 1 | 66µs | 94µs | App::Rad::register |
| 1 | 1 | 1 | 61µs | 663µs | App::Rad::post_process |
| 1 | 1 | 1 | 44µs | 100µs | App::Rad::BEGIN@93 |
| 1 | 1 | 1 | 40µs | 52µs | App::Rad::_tinygetopt |
| 1 | 1 | 1 | 39µs | 52µs | App::Rad::BEGIN@6 |
| 1 | 1 | 1 | 37µs | 73µs | App::Rad::BEGIN@121 |
| 2 | 1 | 1 | 34µs | 34µs | App::Rad::output |
| 1 | 1 | 1 | 27µs | 57µs | App::Rad::BEGIN@5 |
| 4 | 4 | 1 | 26µs | 26µs | App::Rad::argv |
| 1 | 1 | 1 | 21µs | 21µs | App::Rad::BEGIN@4 |
| 1 | 1 | 1 | 20µs | 20µs | App::Rad::import |
| 1 | 1 | 1 | 20µs | 20µs | App::Rad::unregister |
| 1 | 1 | 1 | 18µs | 38µs | App::Rad::unregister_command |
| 1 | 1 | 1 | 14µs | 14µs | App::Rad::is_command |
| 1 | 1 | 1 | 6µs | 6µs | App::Rad::pre_process |
| 1 | 1 | 1 | 5µs | 5µs | App::Rad::teardown |
| 0 | 0 | 0 | 0s | 0s | App::Rad::cmd |
| 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::getopt |
| 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::options |
| 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 |
| Line | State ments |
Time on line |
Calls | Time in subs |
Code |
|---|---|---|---|---|---|
| 1 | package App::Rad; | ||||
| 2 | 2 | 185µs | 1 | 89µs | # spent 89µs within App::Rad::BEGIN@2 which was called:
# once (89µs+0s) by main::BEGIN@9 at line 2 # spent 89µs making 1 call to App::Rad::BEGIN@2 |
| 3 | 2 | 517µs | 1 | 35.4ms | # spent 35.4ms (2.50+32.9) within App::Rad::BEGIN@3 which was called:
# once (2.50ms+32.9ms) by main::BEGIN@9 at line 3 # spent 35.4ms making 1 call to App::Rad::BEGIN@3 |
| 4 | 2 | 86µs | 1 | 21µs | # spent 21µs within App::Rad::BEGIN@4 which was called:
# once (21µs+0s) by main::BEGIN@9 at line 4 # spent 21µs making 1 call to App::Rad::BEGIN@4 |
| 5 | 2 | 96µs | 2 | 87µs | # spent 57µs (27+30) within App::Rad::BEGIN@5 which was called:
# once (27µs+30µs) by main::BEGIN@9 at line 5 # spent 57µs making 1 call to App::Rad::BEGIN@5
# spent 30µs making 1 call to warnings::import |
| 6 | 2 | 1.65ms | 2 | 65µs | # spent 52µs (39+13) within App::Rad::BEGIN@6 which was called:
# once (39µs+13µs) by main::BEGIN@9 at line 6 # spent 52µs making 1 call to App::Rad::BEGIN@6
# spent 13µs making 1 call to strict::import |
| 7 | |||||
| 8 | 1 | 3µs | our $VERSION = '1.04'; | ||
| 9 | { | ||||
| 10 | |||||
| 11 | #========================# | ||||
| 12 | # INTERNAL FUNCTIONS # | ||||
| 13 | #========================# | ||||
| 14 | |||||
| 15 | 2 | 9µs | my @OPTIONS = (); | ||
| 16 | |||||
| 17 | # spent 189µs (73+116) within App::Rad::_init which was called:
# once (73µs+116µs) by App::Rad::run at line 358 | ||||
| 18 | 10 | 67µs | my $c = shift; | ||
| 19 | |||||
| 20 | # instantiate references for the first time | ||||
| 21 | $c->{'_ARGV' } = []; | ||||
| 22 | $c->{'_options'} = {}; | ||||
| 23 | $c->{'_stash' } = {}; | ||||
| 24 | $c->{'_config' } = {}; | ||||
| 25 | $c->{'_plugins'} = []; | ||||
| 26 | |||||
| 27 | # this internal variable holds | ||||
| 28 | # references to all special | ||||
| 29 | # pre-defined control functions | ||||
| 30 | $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 | 116µs | App::Rad::Help->load($c); # spent 116µs making 1 call to App::Rad::Help::load | ||
| 41 | 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 | if ($c->{'debug'}) { | ||||
| 62 | $c->debug('initializing: default commands are: ' | ||||
| 63 | . join ( ', ', $c->commands() ) | ||||
| 64 | ); | ||||
| 65 | } | ||||
| 66 | } | ||||
| 67 | |||||
| 68 | # spent 20µs within App::Rad::import which was called:
# once (20µs+0s) by main::BEGIN@9 at line 9 of bin/dpath | ||||
| 69 | 2 | 36µs | my $class = shift; | ||
| 70 | @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 | 510µs | 2 | 156µs | # spent 100µs (44+56) within App::Rad::BEGIN@93 which was called:
# once (44µs+56µs) by main::BEGIN@9 at line 93 # spent 100µs making 1 call to App::Rad::BEGIN@93
# spent 56µ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 | 10 | 5.43ms | my $package = shift || 'main'; | ||
| 117 | $package .= '::'; | ||||
| 118 | |||||
| 119 | my %subs = (); | ||||
| 120 | |||||
| 121 | 2 | 7.62ms | 2 | 109µs | # spent 73µs (37+36) within App::Rad::BEGIN@121 which was called:
# once (37µs+36µs) by main::BEGIN@9 at line 121 # spent 73µs making 1 call to App::Rad::BEGIN@121
# spent 36µs making 1 call to strict::unimport |
| 122 | 1132 | 1.51ms | while (my ($key, $value) = ( each %{*{$package}} )) { | ||
| 123 | local (*SYMBOL) = $value; | ||||
| 124 | if ( defined $value && defined *SYMBOL{CODE} ) { | ||||
| 125 | $subs{$key} = $value; | ||||
| 126 | } | ||||
| 127 | } | ||||
| 128 | return %subs; | ||||
| 129 | } | ||||
| 130 | |||||
| 131 | |||||
| 132 | # overrides our pre-defined control | ||||
| 133 | # functions with any available | ||||
| 134 | # user-defined ones | ||||
| 135 | # spent 3.70ms (145µs+3.56) within App::Rad::_register_functions which was called:
# once (145µs+3.56ms) by App::Rad::run at line 362 | ||||
| 136 | 3 | 74µs | my $c = shift; | ||
| 137 | 1 | 3.54ms | my %subs = _get_subs_from('main'); # spent 3.54ms 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 | foreach ( keys %{$c->{'_functions'}} ) { | ||||
| 142 | 10 | 51µs | if ( defined $subs{$_} ) { | ||
| 143 | 2 | 15µs | $c->debug("overriding $_ with user-defined function."); # spent 15µs making 2 calls to App::Rad::debug, avg 7µs/call | ||
| 144 | $c->{'_functions'}->{$_} = $subs{$_}; | ||||
| 145 | } | ||||
| 146 | } | ||||
| 147 | } | ||||
| 148 | |||||
| 149 | # retrieves command line arguments | ||||
| 150 | # to be executed by the main program | ||||
| 151 | # spent 169µs (92+76) within App::Rad::_get_input which was called:
# once (92µs+76µs) by App::Rad::run at line 370 | ||||
| 152 | 7 | 66µs | my $c = shift; | ||
| 153 | |||||
| 154 | my $cmd = (defined ($ARGV[0]) and substr($ARGV[0], 0, 1) ne '-') | ||||
| 155 | ? shift @ARGV | ||||
| 156 | : '' | ||||
| 157 | ; | ||||
| 158 | |||||
| 159 | 1 | 9µs | @{$c->argv} = @ARGV; # spent 9µs making 1 call to App::Rad::argv | ||
| 160 | $c->{'cmd'} = $cmd; | ||||
| 161 | |||||
| 162 | 1 | 5µs | $c->debug('received command: ' . $c->{'cmd'}); # spent 5µs making 1 call to App::Rad::debug | ||
| 163 | 2 | 11µs | $c->debug('received parameters: ' . join (' ', @{$c->argv} )); # spent 6µs making 1 call to App::Rad::argv
# spent 5µs making 1 call to App::Rad::debug | ||
| 164 | |||||
| 165 | 1 | 52µs | $c->_tinygetopt(); # spent 52µ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 52µs (40+12) within App::Rad::_tinygetopt which was called:
# once (40µs+12µs) by App::Rad::_get_input at line 165 | ||||
| 171 | 4 | 32µs | my $c = shift; | ||
| 172 | |||||
| 173 | my @argv = (); | ||||
| 174 | 1 | 6µs | foreach ( @{$c->argv} ) { # spent 6µs making 1 call to App::Rad::argv | ||
| 175 | |||||
| 176 | # single option (could be grouped) | ||||
| 177 | if ( m/^\-([^\-\=]+)$/o) { | ||||
| 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} = $2 ? $2 | ||||
| 191 | : 1 | ||||
| 192 | ; | ||||
| 193 | } | ||||
| 194 | else { | ||||
| 195 | push @argv, $_; | ||||
| 196 | } | ||||
| 197 | } | ||||
| 198 | 1 | 6µs | @{$c->argv} = @argv; # spent 6µs 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 3.65ms (198µs+3.45) within App::Rad::register_commands which was called:
# once (198µs+3.45ms) by main::setup at line 30 of bin/dpath | ||||
| 214 | 7 | 92µs | my $c = shift; | ||
| 215 | my %help_for_sub = (); | ||||
| 216 | my %rules = (); | ||||
| 217 | |||||
| 218 | # process parameters | ||||
| 219 | foreach my $item (@_) { | ||||
| 220 | 4 | 13µ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 | $help_for_sub{$item} = undef; # no help text | ||||
| 237 | } | ||||
| 238 | } | ||||
| 239 | |||||
| 240 | 1 | 3.36ms | my %subs = _get_subs_from('main'); # spent 3.36ms making 1 call to App::Rad::_get_subs_from | ||
| 241 | |||||
| 242 | 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 | 4 | 17µs | if ( not defined $c->{'_functions'}->{$_} ) { | ||
| 247 | |||||
| 248 | # user want to register a valid (existant) sub | ||||
| 249 | 6 | 51µs | if ( exists $subs{$_} ) { | ||
| 250 | 2 | 48µs | $c->debug("registering $_ as a command."); # spent 48µs making 2 calls to App::Rad::debug, avg 24µs/call | ||
| 251 | $c->{'_commands'}->{$_}->{'code'} = $subs{$_}; | ||||
| 252 | 2 | 34µs | App::Rad::Help->register_help($c, $_, $help_for_sub{$_}); # spent 34µs making 2 calls to App::Rad::Help::register_help, avg 17µ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 | 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 94µs (66+28) within App::Rad::register which was called:
# once (66µs+28µs) by App::Rad::Help::load at line 10 of App/Rad/Help.pm | ||||
| 299 | 7 | 49µs | my ($c, $command_name, $coderef, $helptext) = @_; | ||
| 300 | 1 | 6µs | $c->debug("got: " . ref $coderef); # spent 6µs making 1 call to App::Rad::debug | ||
| 301 | return undef | ||||
| 302 | unless ( (ref $coderef) eq 'CODE' ); | ||||
| 303 | |||||
| 304 | 1 | 6µs | $c->debug("registering $command_name as a command."); # spent 6µs making 1 call to App::Rad::debug | ||
| 305 | $c->{'_commands'}->{$command_name}->{'code'} = $coderef; | ||||
| 306 | 1 | 16µs | App::Rad::Help->register_help($c, $command_name, $helptext); # spent 16µs making 1 call to App::Rad::Help::register_help | ||
| 307 | return $command_name; | ||||
| 308 | } | ||||
| 309 | |||||
| 310 | 1 | 19µs | 1 | 20µs | # spent 38µs (18+20) within App::Rad::unregister_command which was called:
# once (18µs+20µs) by main::setup at line 29 of bin/dpath # spent 20µs making 1 call to App::Rad::unregister |
| 311 | # spent 20µs within App::Rad::unregister which was called:
# once (20µs+0s) by App::Rad::unregister_command at line 310 | ||||
| 312 | 2 | 27µs | my ($c, $command_name) = @_; | ||
| 313 | |||||
| 314 | 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 14µs within App::Rad::is_command which was called:
# once (14µs+0s) by App::Rad::execute at line 405 | ||||
| 340 | 2 | 22µs | my ($c, $cmd) = @_; | ||
| 341 | return (defined $c->{'_commands'}->{$cmd} | ||||
| 342 | ? 1 | ||||
| 343 | : 0 | ||||
| 344 | ); | ||||
| 345 | } | ||||
| 346 | |||||
| 347 | sub command :lvalue { cmd(@_) } | ||||
| 348 | sub cmd :lvalue { | ||||
| 349 | $_[0]->{'cmd'}; | ||||
| 350 | } | ||||
| 351 | |||||
| 352 | |||||
| 353 | # spent 8.86ms (171µs+8.69) within App::Rad::run which was called:
# once (171µs+8.69ms) by main::RUNTIME at line 24 of bin/dpath | ||||
| 354 | 10 | 142µs | my $class = shift; | ||
| 355 | my $c = {}; | ||||
| 356 | bless $c, $class; | ||||
| 357 | |||||
| 358 | 1 | 189µs | $c->_init(); # spent 189µs making 1 call to App::Rad::_init | ||
| 359 | |||||
| 360 | # first we update the control functions | ||||
| 361 | # with any overriden value | ||||
| 362 | 1 | 3.70ms | $c->_register_functions(); # spent 3.70ms making 1 call to App::Rad::_register_functions | ||
| 363 | |||||
| 364 | # then we run the setup to register | ||||
| 365 | # some commands | ||||
| 366 | 1 | 3.72ms | $c->{'_functions'}->{'setup'}->($c); # spent 3.72ms 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 | 169µs | $c->_get_input(); # spent 169µs making 1 call to App::Rad::_get_input | ||
| 371 | |||||
| 372 | # run the specified command | ||||
| 373 | 1 | 899µs | $c->execute(); # spent 899µs making 1 call to App::Rad::execute | ||
| 374 | |||||
| 375 | # that's it. Tear down everything and go home :) | ||||
| 376 | 1 | 5µs | $c->{'_functions'}->{'teardown'}->($c); # spent 5µs making 1 call to App::Rad::teardown | ||
| 377 | |||||
| 378 | 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 899µs (182+717) within App::Rad::execute which was called:
# once (182µs+717µs) by App::Rad::run at line 373 | ||||
| 389 | 10 | 86µs | my ($c, $cmd) = @_; | ||
| 390 | |||||
| 391 | # given command has precedence | ||||
| 392 | 1 | 3µs | if ($cmd) { | ||
| 393 | $c->{'cmd'} = $cmd; | ||||
| 394 | } | ||||
| 395 | else { | ||||
| 396 | $cmd = $c->{'cmd'}; # now $cmd always has the called cmd | ||||
| 397 | } | ||||
| 398 | |||||
| 399 | 1 | 5µs | $c->debug('calling pre_process function...'); # spent 5µs making 1 call to App::Rad::debug | ||
| 400 | 1 | 6µs | $c->{'_functions'}->{'pre_process'}->($c); # spent 6µs making 1 call to App::Rad::pre_process | ||
| 401 | |||||
| 402 | 1 | 5µs | $c->debug("executing '$cmd'..."); # spent 5µs making 1 call to App::Rad::debug | ||
| 403 | |||||
| 404 | # valid command, run it | ||||
| 405 | 2 | 26µs | if ($c->is_command($c->{'cmd'}) ) { # spent 14µs making 1 call to App::Rad::is_command
# spent 12µs making 1 call to main::help | ||
| 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 | 5µs | $c->debug('calling post_process function...'); # spent 5µs making 1 call to App::Rad::debug | ||
| 422 | 1 | 663µs | $c->{'_functions'}->{'post_process'}->($c); # spent 663µs making 1 call to App::Rad::post_process | ||
| 423 | |||||
| 424 | 1 | 6µs | $c->debug('reseting output'); # spent 6µs making 1 call to App::Rad::debug | ||
| 425 | $c->{'output'} = undef; | ||||
| 426 | } | ||||
| 427 | |||||
| 428 | 4 | 54µs | sub argv { return $_[0]->{'_ARGV'} } | ||
| 429 | sub options { return $_[0]->{'_options'} } | ||||
| 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 | sub getopt { | ||||
| 441 | require Getopt::Long; | ||||
| 442 | Carp::croak "Getopt::Long needs to be version 2.36 or above" | ||||
| 443 | unless $Getopt::Long::VERSION >= 2.36; | ||||
| 444 | |||||
| 445 | my ($c, @options) = @_; | ||||
| 446 | |||||
| 447 | # reset values from tinygetopt | ||||
| 448 | $c->{'_options'} = {}; | ||||
| 449 | |||||
| 450 | my $parser = new Getopt::Long::Parser; | ||||
| 451 | $parser->configure( qw(bundling) ); | ||||
| 452 | |||||
| 453 | my @tARGV = @ARGV; # we gotta stick to our API | ||||
| 454 | my $ret = $parser->getoptions($c->{'_options'}, @options); | ||||
| 455 | @{$c->argv} = @ARGV; | ||||
| 456 | @ARGV = @tARGV; | ||||
| 457 | |||||
| 458 | return $ret; | ||||
| 459 | } | ||||
| 460 | |||||
| 461 | # spent 106µs within App::Rad::debug which was called 12 times, avg 9µs/call:
# 2 times (48µs+0s) by App::Rad::register_commands at line 250, avg 24µs/call
# 2 times (15µs+0s) by App::Rad::_register_functions at line 143, avg 7µs/call
# once (6µs+0s) by App::Rad::execute at line 424
# once (6µs+0s) by App::Rad::register at line 300
# once (6µs+0s) by App::Rad::register at line 304
# once (5µs+0s) by App::Rad::execute at line 421
# once (5µs+0s) by App::Rad::execute at line 399
# once (5µs+0s) by App::Rad::_get_input at line 163
# once (5µs+0s) by App::Rad::_get_input at line 162
# once (5µs+0s) by App::Rad::execute at line 402 | ||||
| 462 | 12 | 228µ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 34µs within App::Rad::output which was called 2 times, avg 17µs/call:
# 2 times (34µs+0s) by App::Rad::post_process at line 493, avg 17µs/call | ||||
| 470 | 4 | 9µs | my ($c, @msg) = @_; | ||
| 471 | 2 | 39µs | if (@msg) { | ||
| 472 | $c->{'output'} = join(' ', @msg); | ||||
| 473 | } | ||||
| 474 | else { | ||||
| 475 | return $c->{'output'}; | ||||
| 476 | } | ||||
| 477 | } | ||||
| 478 | |||||
| 479 | |||||
| 480 | #=========================# | ||||
| 481 | # CONTROL FUNCTIONS # | ||||
| 482 | #=========================# | ||||
| 483 | |||||
| 484 | sub setup { $_[0]->register_commands( {-ignore_prefix => '_'} ) } | ||||
| 485 | |||||
| 486 | 1 | 11µs | # spent 5µs within App::Rad::teardown which was called:
# once (5µs+0s) by App::Rad::run at line 376 | ||
| 487 | |||||
| 488 | 1 | 11µs | # spent 6µs within App::Rad::pre_process which was called:
# once (6µs+0s) by App::Rad::execute at line 400 | ||
| 489 | |||||
| 490 | # spent 663µs (61+602) within App::Rad::post_process which was called:
# once (61µs+602µs) by App::Rad::execute at line 422 | ||||
| 491 | 2 | 621µs | my $c = shift; | ||
| 492 | |||||
| 493 | 3 | 602µs | if ($c->output()) { # spent 568µs making 1 call to App::Rad::CORE:print
# spent 34µs making 2 calls to App::Rad::output, avg 17µs/call | ||
| 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 | 1 | 17µs | 42; # ...and thus ends thy module ;) | ||
| 513 | __END__ | ||||
# spent 568µs within App::Rad::CORE:print which was called:
# once (568µs+0s) by App::Rad::post_process at line 493 |