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 | _get_subs_from | App::Rad::
1 | 1 | 1 | 2.50ms | 35.4ms | BEGIN@3 | App::Rad::
1 | 1 | 1 | 568µs | 568µs | CORE:print (opcode) | App::Rad::
1 | 1 | 1 | 198µs | 3.65ms | register_commands | App::Rad::
1 | 1 | 1 | 182µs | 899µs | execute | App::Rad::
1 | 1 | 1 | 171µs | 8.86ms | run | App::Rad::
1 | 1 | 1 | 145µs | 3.70ms | _register_functions | App::Rad::
12 | 10 | 1 | 106µs | 106µs | debug | App::Rad::
1 | 1 | 1 | 92µs | 169µs | _get_input | App::Rad::
1 | 1 | 1 | 89µs | 89µs | BEGIN@2 | App::Rad::
1 | 1 | 1 | 73µs | 189µs | _init | App::Rad::
1 | 1 | 1 | 66µs | 94µs | register | App::Rad::
1 | 1 | 1 | 61µs | 663µs | post_process | App::Rad::
1 | 1 | 1 | 44µs | 100µs | BEGIN@93 | App::Rad::
1 | 1 | 1 | 40µs | 52µs | _tinygetopt | App::Rad::
1 | 1 | 1 | 39µs | 52µs | BEGIN@6 | App::Rad::
1 | 1 | 1 | 37µs | 73µs | BEGIN@121 | App::Rad::
2 | 1 | 1 | 34µs | 34µs | output | App::Rad::
1 | 1 | 1 | 27µs | 57µs | BEGIN@5 | App::Rad::
4 | 4 | 1 | 26µs | 26µs | argv | App::Rad::
1 | 1 | 1 | 21µs | 21µs | BEGIN@4 | App::Rad::
1 | 1 | 1 | 20µs | 20µs | import | App::Rad::
1 | 1 | 1 | 20µs | 20µs | unregister | App::Rad::
1 | 1 | 1 | 18µs | 38µs | unregister_command | App::Rad::
1 | 1 | 1 | 14µs | 14µs | is_command | App::Rad::
1 | 1 | 1 | 6µs | 6µs | pre_process | App::Rad::
1 | 1 | 1 | 5µs | 5µs | teardown | App::Rad::
0 | 0 | 0 | 0s | 0s | cmd | 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 | getopt | 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 | options | 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::
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 |