Profile of bin/dpath

← 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:36 2012

Filename | /home/ss5/local/projects/app-dpath/bin/dpath
Statements | Executed 27 statements in 19.8ms

Subroutines
Calls | P | F | Exclusive Time | Inclusive Time | Subroutine
--- | --- | --- | --- | --- | ---
1 | 1 | 1 | 10.5ms | 46.3ms | main::::BEGIN@9 main::BEGIN@9
1 | 1 | 1 | 9.42ms | 9.58ms | main::::BEGIN@7 main::BEGIN@7
1 | 1 | 1 | 4.12ms | 485ms | main::::BEGIN@10 main::BEGIN@10
1 | 1 | 1 | 1.38ms | 1.56ms | main::::BEGIN@6 main::BEGIN@6
1 | 1 | 1 | 198µs | 198µs | main::::BEGIN@5 main::BEGIN@5
22 | 1 | 1 | 82µs | 82µs | Internals::::SvREADONLYInternals::SvREADONLY (xsub)
1 | 1 | 1 | 49µs | 49µs | main::::_getopt main::_getopt
1 | 1 | 1 | 40µs | 3.72ms | main::::setup main::setup
1 | 1 | 1 | 38µs | 166µs | main::::BEGIN@11 main::BEGIN@11
1 | 1 | 1 | 36µs | 51µs | main::::BEGIN@19 main::BEGIN@19
1 | 1 | 1 | 34µs | 825µs | main::::BEGIN@69 main::BEGIN@69
1 | 1 | 1 | 32µs | 32µs | version::::(bool version::(bool (xsub)
3 | 1 | 1 | 24µs | 24µs | mro::::method_changed_in mro::method_changed_in (xsub)
1 | 1 | 1 | 22µs | 71µs | main::::search main::search
1 | 1 | 1 | 20µs | 20µs | version::::(cmp version::(cmp (xsub)
1 | 1 | 1 | 15µs | 15µs | main::::CORE:match main::CORE:match (opcode)
1 | 1 | 1 | 15µs | 86µs | main::::default main::default
1 | 1 | 1 | 12µs | 12µs | main::::help main::help
0 | 0 | 0 | 0s | 0s | main::::RUNTIME main::RUNTIME
0 | 0 | 0 | 0s | 0s | main::::_format_flat main::_format_flat
0 | 0 | 0 | 0s | 0s | main::::_format_flat_inner_array main::_format_flat_inner_array
0 | 0 | 0 | 0s | 0s | main::::_format_flat_inner_hash main::_format_flat_inner_hash
0 | 0 | 0 | 0s | 0s | main::::_format_flat_inner_scalar main::_format_flat_inner_scalar
0 | 0 | 0 | 0s | 0s | main::::_format_flat_outer main::_format_flat_outer
0 | 0 | 0 | 0s | 0s | main::::_match main::_match
0 | 0 | 0 | 0s | 0s | main::::_read_in main::_read_in
0 | 0 | 0 | 0s | 0s | main::::_write_out main::_write_out

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

Line | State ments | Time on line | Calls | Time in subs | Code
--- | --- | --- | --- | --- | ---
0 |  |  | 4 | 1.91ms | Profile data that couldn't be associated with a specific line: # spent 1.81ms making 1 call to Attribute::Handlers::CHECK # spent 48µs making 1 call to Attribute::Handlers::END # spent 43µs making 1 call to Attribute::Handlers::INIT # spent 8µs making 1 call to Class::XSAccessor::END
1 | 1 | 153µs |  |  | #! /usr/bin/perl
2 |  |  |  |  | # PODNAME: dpath
3 |  |  |  |  | # ABSTRACT: cmdline tool around Data::DPath
4 |  |  |  |  |
5 | 2 | 267µs | 1 | 198µs | # spent 198µs within main::BEGIN@5 which was called: # once (198µs+0s) by main::RUNTIME at line 5 use 5.008; # spent 198µs making 1 call to main::BEGIN@5
6 | 2 | 1.33ms | 2 | 1.58ms | # spent 1.56ms (1.38+179µs) within main::BEGIN@6 which was called: # once (1.38ms+179µs) by main::RUNTIME at line 6 use strict; # spent 1.56ms making 1 call to main::BEGIN@6 # spent 22µs making 1 call to strict::import
7 | 2 | 9.03ms | 2 | 9.62ms | # spent 9.58ms (9.42+157µs) within main::BEGIN@7 which was called: # once (9.42ms+157µs) by main::RUNTIME at line 7 use warnings; # spent 9.58ms making 1 call to main::BEGIN@7 # spent 43µs making 1 call to warnings::import
8 |  |  |  |  |
9 | 2 | 488µs | 2 | 46.3ms | # spent 46.3ms (10.5+35.8) within main::BEGIN@9 which was called: # once (10.5ms+35.8ms) by main::RUNTIME at line 9 use App::Rad; # spent 46.3ms making 1 call to main::BEGIN@9 # spent 20µs making 1 call to App::Rad::import
10 | 2 | 530µs | 2 | 486ms | # spent 485ms (4.12+481) within main::BEGIN@10 which was called: # once (4.12ms+481ms) by main::RUNTIME at line 10 use Data::DPath 'dpath'; # spent 485ms making 1 call to main::BEGIN@10 # spent 806µs making 1 call to Sub::Exporter::__ANON__[Sub/Exporter.pm:756]
11 | 2 | 298µs | 2 | 293µs | # spent 166µs (38+128) within main::BEGIN@11 which was called: # once (38µs+128µs) by main::RUNTIME at line 11 use Scalar::Util 'reftype'; # spent 166µs making 1 call to main::BEGIN@11 # spent 128µs making 1 call to Exporter::import
12 |  |  |  |  |
13 |  |  |  |  | ######################################################################
14 |  |  |  |  | #
15 |  |  |  |  | # App::Rad interface
16 |  |  |  |  | #
17 |  |  |  |  | ######################################################################
18 |  |  |  |  |
19 |  |  |  |  | # spent 51µs (36+15) within main::BEGIN@19 which was called: # once (36µs+15µs) by main::RUNTIME at line 22 BEGIN {
20 | 2 | 49µs |  |  | my $default_cmd = "search";
21 |  |  | 1 | 15µs | unshift @ARGV, $default_cmd unless $ARGV[0] =~ /^(search|help)$/; # spent 15µs making 1 call to main::CORE:match
22 | 1 | 657µs | 1 | 51µs | } # spent 51µs making 1 call to main::BEGIN@19
23 |  |  |  |  |
24 | 1 | 16µs | 1 | 8.86ms | App::Rad->run(); # spent 8.86ms making 1 call to App::Rad::run
25 |  |  |  |  |
26 |  |  |  |  | sub setup
27 |  |  |  |  | # spent 3.72ms (40µs+3.68) within main::setup which was called: # once (40µs+3.68ms) by App::Rad::run at line 366 of App/Rad.pm {
28 | 3 | 29µs |  |  | my $c = shift;
29 |  |  | 1 | 38µs | $c->unregister_command("help"); # spent 38µs making 1 call to App::Rad::unregister_command
30 |  |  | 1 | 3.65ms | $c->register_commands("help", "search"); # spent 3.65ms making 1 call to App::Rad::register_commands
31 |  |  |  |  | }
32 |  |  |  |  |
33 |  |  |  |  | sub help
34 |  |  |  |  | # spent 12µs within main::help which was called: # once (12µs+0s) by App::Rad::execute at line 405 of App/Rad.pm {
35 | 2 | 17µs |  |  | my ($c) = @_;
36 |  |  |  |  |
37 |  |  |  |  | return "dpath [-ios] [--fb] [ --fi] <DPath>
38 |  |  |  |  |
39 |  |  |  |  | -o
40 |  |  |  |  | --outtype - output format
41 |  |  |  |  | [yaml(default), json, dumper, xml]
42 |  |  |  |  | -i
43 |  |  |  |  | --intype - input format
44 |  |  |  |  | [yaml(default), json, dumper, xml, tap, ini]
45 |  |  |  |  | -s
46 |  |  |  |  | --separator - sub entry separator for output format 'flat'
47 |  |  |  |  | (default=;)
48 |  |  |  |  | --fb - on output format 'flat' use [brackets] around
49 |  |  |  |  | outer arrays
50 |  |  |  |  | --fi - on output format 'flat' prefix outer array lines
51 |  |  |  |  | with index
52 |  |  |  |  |
53 |  |  |  |  | See 'perldoc Data::DPath' for how to specify a DPath.
54 |  |  |  |  | ";
55 |  |  |  |  | }
56 |  |  |  |  |
57 |  |  |  |  | # spent 71µs (22+49) within main::search which was called: # once (22µs+49µs) by main::default at line 71 sub search :Help(search incoming data by DPath (default commmand))
58 |  |  |  |  | {
59 | 2 | 7µs |  |  | my ($c) = @_;
60 |  |  |  |  |
61 |  |  | 1 | 49µs | _getopt($c); # spent 49µs making 1 call to main::_getopt
62 |  |  |  |  |
63 |  |  |  |  | my $path = $c->argv->[0];
64 |  |  |  |  | my $file = $c->argv->[1] || '-';
65 |  |  |  |  |
66 |  |  |  |  | my $data = _read_in( $c, $file );
67 |  |  |  |  | my $result = _match( $c, $data, $path );
68 |  |  |  |  | return _write_out($c, $result);
69 | 2 | 6.79ms | 2 | 1.62ms | # spent 825µs (34+791) within main::BEGIN@69 which was called: # once (34µs+791µs) by main::RUNTIME at line 69 } # spent 825µs making 1 call to main::BEGIN@69 # spent 791µs making 1 call to attributes::import
70 |  |  |  |  |
71 | 1 | 5µs | 1 | 71µs | # spent 86µs (15+71) within main::default which was called: # once (15µs+71µs) by Attribute::Handlers::_apply_handler_AH_ at line 2 of (eval 47)[Attribute/Handlers.pm:218] sub default { search(@_) } # spent 71µs making 1 call to main::search
72 |  |  |  |  |
73 |  |  |  |  | ######################################################################
74 |  |  |  |  | #
75 |  |  |  |  | # Implementation
76 |  |  |  |  | #
77 |  |  |  |  | ######################################################################
78 |  |  |  |  |
79 |  |  |  |  | sub _read_in
80 |  |  |  |  | {
81 |  |  |  |  | my ($c, $file) = @_;
82 |  |  |  |  |
83 |  |  |  |  | my $opt = $c->options;
84 |  |  |  |  |
85 |  |  |  |  | my $intype = $opt->{intype} || 'yaml';
86 |  |  |  |  | my $data;
87 |  |  |  |  | my $filecontent;
88 |  |  |  |  | {
89 |  |  |  |  | local $/;
90 |  |  |  |  | if ($file eq '-') {
91 |  |  |  |  | $filecontent = <STDIN>;
92 |  |  |  |  | }
93 |  |  |  |  | else
94 |  |  |  |  | {
95 |  |  |  |  | open (my $FH, "<", $file) or die "dpath: cannot open input file $file.\n";
96 |  |  |  |  | $filecontent = <$FH>;
97 |  |  |  |  | close $FH;
98 |  |  |  |  | }
99 |  |  |  |  | }
100 |  |  |  |  |
101 |  |  |  |  | if (not defined $filecontent or $filecontent !~ /[^\s\t\r\n]/ms) {
102 |  |  |  |  | die "dpath: no meaningful input to read.\n";
103 |  |  |  |  | }
104 |  |  |  |  |
105 |  |  |  |  | if ($intype eq "yaml") {
106 |  |  |  |  | require YAML::Any;
107 |  |  |  |  | $data = YAML::Any::Load($filecontent);
108 |  |  |  |  | }
109 |  |  |  |  | elsif ($intype eq "json") {
110 |  |  |  |  | require JSON;
111 |  |  |  |  | $data = JSON::decode_json($filecontent);
112 |  |  |  |  | }
113 |  |  |  |  | elsif ($intype eq "xml")
114 |  |  |  |  | {
115 |  |  |  |  | require XML::Simple;
116 |  |  |  |  | my $xs = new XML::Simple;
117 |  |  |  |  | $data = $xs->XMLin($filecontent, KeepRoot => 1);
118 |  |  |  |  | }
119 |  |  |  |  | elsif ($intype eq "ini") {
120 |  |  |  |  | require Config::INI::Serializer;
121 |  |  |  |  | my $ini = Config::INI::Serializer->new;
122 |  |  |  |  | $data = $ini->deserialize($filecontent);
123 |  |  |  |  | }
124 |  |  |  |  | elsif ($intype eq "cfggeneral") {
125 |  |  |  |  | require Config::General;
126 |  |  |  |  | my %data = Config::General->new(-String => $filecontent,
127 |  |  |  |  | -InterPolateVars => 1,
128 |  |  |  |  | )->getall;
129 |  |  |  |  | $data = \%data;
130 |  |  |  |  | }
131 |  |  |  |  | elsif ($intype eq "dumper") {
132 |  |  |  |  | eval '$data = my '.$filecontent;
133 |  |  |  |  | }
134 |  |  |  |  | elsif ($intype eq "tap") {
135 |  |  |  |  | require TAP::DOM;
136 |  |  |  |  | $data = new TAP::DOM( tap => $filecontent );
137 |  |  |  |  | }
138 |  |  |  |  | else
139 |  |  |  |  | {
140 |  |  |  |  | die "dpath: unrecognized input format: $intype.\n";
141 |  |  |  |  | }
142 |  |  |  |  | return $data;
143 |  |  |  |  | }
144 |  |  |  |  |
145 |  |  |  |  | sub _match
146 |  |  |  |  | {
147 |  |  |  |  | my ($c, $data, $path) = @_;
148 |  |  |  |  |
149 |  |  |  |  | if (not $data) {
150 |  |  |  |  | die "dpath: no input data to match.\n";
151 |  |  |  |  | }
152 |  |  |  |  |
153 |  |  |  |  | my @resultlist = dpath($path)->match($data);
154 |  |  |  |  | return \@resultlist;
155 |  |  |  |  | }
156 |  |  |  |  |
157 |  |  |  |  | sub _format_flat_inner_scalar
158 |  |  |  |  | {
159 |  |  |  |  | my ($c, $result) = @_;
160 |  |  |  |  |
161 |  |  |  |  | return "$result";
162 |  |  |  |  | }
163 |  |  |  |  |
164 |  |  |  |  | sub _format_flat_inner_array
165 |  |  |  |  | {
166 |  |  |  |  | my ($c, $result) = @_;
167 |  |  |  |  |
168 |  |  |  |  | my $opt = $c->options;
169 |  |  |  |  |
170 |  |  |  |  | return
171 |  |  |  |  | join($opt->{separator},
172 |  |  |  |  | map {
173 |  |  |  |  | # only SCALARS allowed (where reftype returns undef)
174 |  |  |  |  | die "dpath: unsupported innermost nesting (".reftype($_).") for 'flat' output.\n" if defined reftype($_);
175 |  |  |  |  | "".$_
176 |  |  |  |  | } @$result);
177 |  |  |  |  | }
178 |  |  |  |  |
179 |  |  |  |  | sub _format_flat_inner_hash
180 |  |  |  |  | {
181 |  |  |  |  | my ($c, $result) = @_;
182 |  |  |  |  |
183 |  |  |  |  | my $opt = $c->options;
184 |  |  |  |  |
185 |  |  |  |  | return
186 |  |  |  |  | join($opt->{separator},
187 |  |  |  |  | map { my $v = $result->{$_};
188 |  |  |  |  | # only SCALARS allowed (where reftype returns undef)
189 |  |  |  |  | die "dpath: unsupported innermost nesting (".reftype($v).") for 'flat' output.\n" if defined reftype($v);
190 |  |  |  |  | "$_=".$v
191 |  |  |  |  | } keys %$result);
192 |  |  |  |  | }
193 |  |  |  |  |
194 |  |  |  |  | sub _format_flat_outer
195 |  |  |  |  | {
196 |  |  |  |  | my ($c, $result) = @_;
197 |  |  |  |  |
198 |  |  |  |  | my $opt = $c->options;
199 |  |  |  |  |
200 |  |  |  |  | my $output = "";
201 |  |  |  |  | die "dpath: can not flatten data structure (undef) - try other output format.\n" unless defined $result;
202 |  |  |  |  |
203 |  |  |  |  | my $A = ""; my $B = ""; if ($opt->{fb}) { $A = "["; $B = "]" }
204 |  |  |  |  | my $fi = $opt->{fi};
205 |  |  |  |  |
206 |  |  |  |  | if (!defined reftype $result) { # SCALAR
207 |  |  |  |  | $output .= $result."\n"; # stringify
208 |  |  |  |  | }
209 |  |  |  |  | elsif (reftype $result eq 'ARRAY') {
210 |  |  |  |  | for (my $i=0; $i<@$result; $i++) {
211 |  |  |  |  | my $entry = $result->[$i];
212 |  |  |  |  | my $prefix = $fi ? "$i:" : "";
213 |  |  |  |  | if (!defined reftype $entry) { # SCALAR
214 |  |  |  |  | $output .= $prefix.$A._format_flat_inner_scalar($c, $entry)."$B\n";
215 |  |  |  |  | }
216 |  |  |  |  | elsif (reftype $entry eq 'ARRAY') {
217 |  |  |  |  | $output .= $prefix.$A._format_flat_inner_array($c, $entry)."$B\n";
218 |  |  |  |  | }
219 |  |  |  |  | elsif (reftype $entry eq 'HASH') {
220 |  |  |  |  | $output .= $prefix.$A._format_flat_inner_hash($c, $entry)."$B\n";
221 |  |  |  |  | }
222 |  |  |  |  | else {
223 |  |  |  |  | die "dpath: can not flatten data structure (".reftype($entry).").\n";
224 |  |  |  |  | }
225 |  |  |  |  | }
226 |  |  |  |  | }
227 |  |  |  |  | elsif (reftype $result eq 'HASH') {
228 |  |  |  |  | my @keys = keys %$result;
229 |  |  |  |  | foreach my $key (@keys) {
230 |  |  |  |  | my $entry = $result->{$key};
231 |  |  |  |  | if (!defined reftype $entry) { # SCALAR
232 |  |  |  |  | $output .= "$key:"._format_flat_inner_scalar($c, $entry)."\n";
233 |  |  |  |  | }
234 |  |  |  |  | elsif (reftype $entry eq 'ARRAY') {
235 |  |  |  |  | $output .= "$key:"._format_flat_inner_array($c, $entry)."\n";
236 |  |  |  |  | }
237 |  |  |  |  | elsif (reftype $entry eq 'HASH') {
238 |  |  |  |  | $output .= "$key:"._format_flat_inner_hash($c, $entry)."\n";
239 |  |  |  |  | }
240 |  |  |  |  | else {
241 |  |  |  |  | die "dpath: can not flatten data structure (".reftype($entry).").\n";
242 |  |  |  |  | }
243 |  |  |  |  | }
244 |  |  |  |  | }
245 |  |  |  |  | else {
246 |  |  |  |  | die "dpath: can not flatten data structure (".reftype($result).") - try other output format.\n";
247 |  |  |  |  | }
248 |  |  |  |  |
249 |  |  |  |  | return $output;
250 |  |  |  |  | }
251 |  |  |  |  |
252 |  |  |  |  | sub _format_flat
253 |  |  |  |  | {
254 |  |  |  |  | my ($c, $resultlist) = @_;
255 |  |  |  |  |
256 |  |  |  |  | my $opt = $c->options;
257 |  |  |  |  |
258 |  |  |  |  | my $output = "";
259 |  |  |  |  | $opt->{separator} = ";" unless defined $opt->{separator};
260 |  |  |  |  | $output .= _format_flat_outer($c, $_) foreach @$resultlist;
261 |  |  |  |  | return $output;
262 |  |  |  |  | }
263 |  |  |  |  |
264 |  |  |  |  | sub _write_out
265 |  |  |  |  | {
266 |  |  |  |  | my ($c, $resultlist) = @_;
267 |  |  |  |  |
268 |  |  |  |  | my $opt = $c->options;
269 |  |  |  |  |
270 |  |  |  |  | my $output = "";
271 |  |  |  |  | my $outtype = $opt->{outtype} || 'yaml';
272 |  |  |  |  | if ($outtype eq "yaml")
273 |  |  |  |  | {
274 |  |  |  |  | require YAML::Any;
275 |  |  |  |  | $output .= YAML::Any::Dump($resultlist);
276 |  |  |  |  | }
277 |  |  |  |  | elsif ($outtype eq "json")
278 |  |  |  |  | {
279 |  |  |  |  | eval "use JSON -convert_blessed_universally";
280 |  |  |  |  | my $json = JSON->new->allow_nonref->pretty->allow_blessed->convert_blessed;
281 |  |  |  |  | $output .= $json->encode($resultlist);
282 |  |  |  |  | }
283 |  |  |  |  | elsif ($outtype eq "ini") {
284 |  |  |  |  | require Config::INI::Serializer;
285 |  |  |  |  | my $ini = Config::INI::Serializer->new;
286 |  |  |  |  | $output .= $ini->serialize($resultlist);
287 |  |  |  |  | }
288 |  |  |  |  | elsif ($outtype eq "dumper")
289 |  |  |  |  | {
290 |  |  |  |  | require Data::Dumper;
291 |  |  |  |  | $output .= Data::Dumper::Dumper($resultlist);
292 |  |  |  |  | }
293 |  |  |  |  | elsif ($outtype eq "xml")
294 |  |  |  |  | {
295 |  |  |  |  | require XML::Simple;
296 |  |  |  |  | my $xs = new XML::Simple;
297 |  |  |  |  | $output .= $xs->XMLout($resultlist, AttrIndent => 1, KeepRoot => 1);
298 |  |  |  |  | }
299 |  |  |  |  | elsif ($outtype eq "flat") {
300 |  |  |  |  | $output .= _format_flat( $c, $resultlist );
301 |  |  |  |  | }
302 |  |  |  |  | else
303 |  |  |  |  | {
304 |  |  |  |  | die "dpath: unrecognized output format: $outtype.";
305 |  |  |  |  | }
306 |  |  |  |  | return $output;
307 |  |  |  |  | }
308 |  |  |  |  |
309 |  |  |  |  | sub _getopt
310 |  |  |  |  | # spent 49µs within main::_getopt which was called: # once (49µs+0s) by main::search at line 61 {
311 | 2 | 113µs |  |  | my ($c) = @_;
312 |  |  |  |  |
313 |  |  |  |  | $c->getopt( "faces|f=i",
314 |  |  |  |  | "times|t=i",
315 |  |  |  |  | "intype|i=s",
316 |  |  |  |  | "outtype|o=s",
317 |  |  |  |  | "separator|s=s",
318 |  |  |  |  | "fb",
319 |  |  |  |  | "fi",
320 |  |  |  |  | )
321 |  |  |  |  | or help() and return undef;
322 |  |  |  |  | if (not $c->argv->[0]) {
323 |  |  |  |  | die "dpath: please specify a dpath.\n";
324 |  |  |  |  | }
325 |  |  |  |  | }
326 |  |  |  |  |
327 |  |  |  |  | __END__
|  |  |  |  | # spent 82µs within Internals::SvREADONLY which was called 22 times, avg 4µs/call: # 22 times (82µs+0s) by constant::import at line 132 of constant.pm, avg 4µs/call sub Internals::SvREADONLY; # xsub
|  |  |  |  | # spent 15µs within main::CORE:match which was called: # once (15µs+0s) by main::BEGIN@19 at line 21 sub main::CORE:match; # opcode
|  |  |  |  | # spent 24µs within mro::method_changed_in which was called 3 times, avg 8µs/call: # 3 times (24µs+0s) by constant::import at line 147 of constant.pm, avg 8µs/call sub mro::method_changed_in; # xsub
|  |  |  |  | # spent 32µs within version::(bool which was called: # once (32µs+0s) by DynaLoader::BEGIN@22 at line 57 of Config.pm sub version::(bool; # xsub
|  |  |  |  | # spent 20µs within version::(cmp which was called: # once (20µs+0s) by DynaLoader::BEGIN@22 at line 60 of Config.pm sub version::(cmp; # xsub