Profile of App/Rad.pm

← Index
NYTProf Performance Profile «block view•line view•sub view»
For bin/dpath
Run on Tue Jun 5 15:31:33 2012
Reported on Tue Jun 5 15:31:40 2012

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

Subroutines
Calls | P | F | Exclusive Time | Inclusive Time | Subroutine
--- | --- | --- | --- | --- | ---
2 | 2 | 1 | 6.91ms | 6.91ms | App::Rad::::_get_subs_fromApp::Rad::_get_subs_from
1 | 1 | 1 | 2.50ms | 35.4ms | App::Rad::::BEGIN@3App::Rad::BEGIN@3
1 | 1 | 1 | 568µs | 568µs | App::Rad::::CORE:printApp::Rad::CORE:print (opcode)
1 | 1 | 1 | 198µs | 3.65ms | App::Rad::::register_commandsApp::Rad::register_commands
1 | 1 | 1 | 182µs | 899µs | App::Rad::::executeApp::Rad::execute
1 | 1 | 1 | 171µs | 8.86ms | App::Rad::::runApp::Rad::run
1 | 1 | 1 | 145µs | 3.70ms | App::Rad::::_register_functionsApp::Rad::_register_functions
12 | 10 | 1 | 106µs | 106µs | App::Rad::::debugApp::Rad::debug
1 | 1 | 1 | 92µs | 169µs | App::Rad::::_get_inputApp::Rad::_get_input
1 | 1 | 1 | 89µs | 89µs | App::Rad::::BEGIN@2App::Rad::BEGIN@2
1 | 1 | 1 | 73µs | 189µs | App::Rad::::_initApp::Rad::_init
1 | 1 | 1 | 66µs | 94µs | App::Rad::::registerApp::Rad::register
1 | 1 | 1 | 61µs | 663µs | App::Rad::::post_processApp::Rad::post_process
1 | 1 | 1 | 44µs | 100µs | App::Rad::::BEGIN@93App::Rad::BEGIN@93
1 | 1 | 1 | 40µs | 52µs | App::Rad::::_tinygetoptApp::Rad::_tinygetopt
1 | 1 | 1 | 39µs | 52µs | App::Rad::::BEGIN@6App::Rad::BEGIN@6
1 | 1 | 1 | 37µs | 73µs | App::Rad::::BEGIN@121App::Rad::BEGIN@121
2 | 1 | 1 | 34µs | 34µs | App::Rad::::outputApp::Rad::output
1 | 1 | 1 | 27µs | 57µs | App::Rad::::BEGIN@5App::Rad::BEGIN@5
4 | 4 | 1 | 26µs | 26µs | App::Rad::::argvApp::Rad::argv
1 | 1 | 1 | 21µs | 21µs | App::Rad::::BEGIN@4App::Rad::BEGIN@4
1 | 1 | 1 | 20µs | 20µs | App::Rad::::importApp::Rad::import
1 | 1 | 1 | 20µs | 20µs | App::Rad::::unregisterApp::Rad::unregister
1 | 1 | 1 | 18µs | 38µs | App::Rad::::unregister_commandApp::Rad::unregister_command
1 | 1 | 1 | 14µs | 14µs | App::Rad::::is_commandApp::Rad::is_command
1 | 1 | 1 | 6µs | 6µs | App::Rad::::pre_processApp::Rad::pre_process
1 | 1 | 1 | 5µs | 5µs | App::Rad::::teardownApp::Rad::teardown
0 | 0 | 0 | 0s | 0s | App::Rad::::cmdApp::Rad::cmd
0 | 0 | 0 | 0s | 0s | App::Rad::::commandApp::Rad::command
0 | 0 | 0 | 0s | 0s | App::Rad::::commandsApp::Rad::commands
0 | 0 | 0 | 0s | 0s | App::Rad::::configApp::Rad::config
0 | 0 | 0 | 0s | 0s | App::Rad::::create_command_nameApp::Rad::create_command_name
0 | 0 | 0 | 0s | 0s | App::Rad::::defaultApp::Rad::default
0 | 0 | 0 | 0s | 0s | App::Rad::::getoptApp::Rad::getopt
0 | 0 | 0 | 0s | 0s | App::Rad::::invalidApp::Rad::invalid
0 | 0 | 0 | 0s | 0s | App::Rad::::load_configApp::Rad::load_config
0 | 0 | 0 | 0s | 0s | App::Rad::::load_pluginApp::Rad::load_plugin
0 | 0 | 0 | 0s | 0s | App::Rad::::optionsApp::Rad::options
0 | 0 | 0 | 0s | 0s | App::Rad::::pluginsApp::Rad::plugins
0 | 0 | 0 | 0s | 0s | App::Rad::::register_commandApp::Rad::register_command
0 | 0 | 0 | 0s | 0s | App::Rad::::setupApp::Rad::setup
0 | 0 | 0 | 0s | 0s | App::Rad::::stashApp::Rad::stash

Call graph for these subroutines as a Graphviz dot language file.

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 use 5.006; # 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 use App::Rad::Help; # 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 use Carp (); # 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 use warnings; # 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 use strict; # 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 sub _init {
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 sub import {
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 no strict 'refs'; # 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 |  |  |  |  | # spent 6.91ms within App::Rad::_get_subs_from which was called 2 times, avg 3.45ms/call: # once (3.54ms+0s) by App::Rad::_register_functions at line 137 # once (3.36ms+0s) by App::Rad::register_commands at line 240 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 no strict 'refs'; # 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 sub _register_functions {
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 sub _get_input {
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 sub _tinygetopt {
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 sub register_commands {
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 sub register {
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 sub unregister_command { return unregister(@_) } # 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 sub unregister {
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 sub is_command {
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 sub run {
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 sub execute {
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 |  |  | # spent 26µs within App::Rad::argv which was called 4 times, avg 7µs/call: # once (9µs+0s) by App::Rad::_get_input at line 159 # once (6µs+0s) by App::Rad::_get_input at line 163 # once (6µs+0s) by App::Rad::_tinygetopt at line 174 # once (6µs+0s) by App::Rad::_tinygetopt at line 198 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 sub debug {
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 sub output {
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 sub teardown {}
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 sub pre_process {}
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 sub post_process {
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 sub App::Rad::CORE:print; # opcode