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 | getopt | App::Rad::
2 | 2 | 1 | 659µs | 659µs | _get_subs_from | App::Rad::
1 | 1 | 1 | 302µs | 6.03ms | BEGIN@3 | App::Rad::
1 | 1 | 1 | 296µs | 53.5s | run | App::Rad::
1 | 1 | 1 | 117µs | 459µs | register_commands | App::Rad::
3 | 3 | 2 | 47µs | 61µs | register | App::Rad::
1 | 1 | 1 | 46µs | 394µs | _register_functions | App::Rad::
1 | 1 | 1 | 40µs | 53.5s | execute | App::Rad::
1 | 1 | 1 | 28µs | 85µs | _init | App::Rad::
1 | 1 | 1 | 26µs | 35µs | _tinygetopt | App::Rad::
26 | 10 | 1 | 23µs | 23µs | debug | App::Rad::
1 | 1 | 1 | 22µs | 61µs | _get_input | App::Rad::
1 | 1 | 1 | 12µs | 12µs | BEGIN@2 | App::Rad::
6 | 6 | 2 | 9µs | 9µs | argv | App::Rad::
1 | 1 | 1 | 8µs | 11µs | post_process | App::Rad::
7 | 7 | 2 | 7µs | 7µs | options | App::Rad::
1 | 1 | 1 | 6µs | 14µs | BEGIN@93 | App::Rad::
4 | 1 | 1 | 5µs | 5µs | CORE:match (opcode) | App::Rad::
1 | 1 | 1 | 5µs | 5µs | unregister | App::Rad::
1 | 1 | 1 | 5µs | 11µs | BEGIN@121 | App::Rad::
2 | 2 | 1 | 5µs | 5µs | cmd | App::Rad::
1 | 1 | 1 | 5µs | 6µs | BEGIN@6 | App::Rad::
1 | 1 | 1 | 4µs | 10µs | unregister_command | App::Rad::
1 | 1 | 1 | 3µs | 7µs | BEGIN@5 | App::Rad::
1 | 1 | 1 | 3µs | 3µs | output | App::Rad::
1 | 1 | 1 | 3µs | 3µs | is_command | App::Rad::
1 | 1 | 1 | 3µs | 3µs | BEGIN@4 | App::Rad::
1 | 1 | 1 | 2µs | 2µs | import | App::Rad::
1 | 1 | 1 | 1µs | 1µs | pre_process | App::Rad::
0 | 0 | 0 | 0s | 0s | command | App::Rad::
0 | 0 | 0 | 0s | 0s | commands | App::Rad::
0 | 0 | 0 | 0s | 0s | config | App::Rad::
0 | 0 | 0 | 0s | 0s | create_command_name | App::Rad::
0 | 0 | 0 | 0s | 0s | default | App::Rad::
0 | 0 | 0 | 0s | 0s | invalid | App::Rad::
0 | 0 | 0 | 0s | 0s | load_config | App::Rad::
0 | 0 | 0 | 0s | 0s | load_plugin | App::Rad::
0 | 0 | 0 | 0s | 0s | plugins | App::Rad::
0 | 0 | 0 | 0s | 0s | register_command | App::Rad::
0 | 0 | 0 | 0s | 0s | setup | App::Rad::
0 | 0 | 0 | 0s | 0s | stash | App::Rad::
0 | 0 | 0 | 0s | 0s | teardown | App::Rad::
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 |