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

Filename/home/ss5/local/projects/app-dpath/bin/dpath
StatementsExecuted 27 statements in 19.8ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
11110.5ms46.3msmain::::BEGIN@9 main::BEGIN@9
1119.42ms9.58msmain::::BEGIN@7 main::BEGIN@7
1114.12ms485msmain::::BEGIN@10 main::BEGIN@10
1111.38ms1.56msmain::::BEGIN@6 main::BEGIN@6
111198µs198µsmain::::BEGIN@5 main::BEGIN@5
221182µs82µsInternals::::SvREADONLYInternals::SvREADONLY (xsub)
11149µs49µsmain::::_getopt main::_getopt
11140µs3.72msmain::::setup main::setup
11138µs166µsmain::::BEGIN@11 main::BEGIN@11
11136µs51µsmain::::BEGIN@19 main::BEGIN@19
11134µs825µsmain::::BEGIN@69 main::BEGIN@69
11132µs32µsversion::::(bool version::(bool (xsub)
31124µs24µsmro::::method_changed_in mro::method_changed_in (xsub)
11122µs71µsmain::::search main::search
11120µs20µsversion::::(cmp version::(cmp (xsub)
11115µs15µsmain::::CORE:match main::CORE:match (opcode)
11115µs86µsmain::::default main::default
11112µs12µsmain::::help main::help
0000s0smain::::RUNTIME main::RUNTIME
0000s0smain::::_format_flat main::_format_flat
0000s0smain::::_format_flat_inner_array main::_format_flat_inner_array
0000s0smain::::_format_flat_inner_hash main::_format_flat_inner_hash
0000s0smain::::_format_flat_inner_scalar main::_format_flat_inner_scalar
0000s0smain::::_format_flat_outer main::_format_flat_outer
0000s0smain::::_match main::_match
0000s0smain::::_read_in main::_read_in
0000s0smain::::_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
041.91msProfile 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
11153µs#! /usr/bin/perl
2# PODNAME: dpath
3# ABSTRACT: cmdline tool around Data::DPath
4
52267µs1198µ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
621.33ms21.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
729.03ms29.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
92488µs246.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
102530µs2486ms
# 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]
112298µs2293µ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 {
20249µs my $default_cmd = "search";
21115µs unshift @ARGV, $default_cmd unless $ARGV[0] =~ /^(search|help)$/;
# spent 15µs making 1 call to main::CORE:match
221657µs151µs}
# spent 51µs making 1 call to main::BEGIN@19
23
24116µs18.86msApp::Rad->run();
# spent 8.86ms making 1 call to App::Rad::run
25
26sub 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
{
28329µs my $c = shift;
29138µs $c->unregister_command("help");
# spent 38µs making 1 call to App::Rad::unregister_command
3013.65ms $c->register_commands("help", "search");
# spent 3.65ms making 1 call to App::Rad::register_commands
31}
32
33sub 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
{
35217µ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{
5927µs my ($c) = @_;
60
61149µ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);
6926.79ms21.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
7115µs171µ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
79sub _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
145sub _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
157sub _format_flat_inner_scalar
158{
159 my ($c, $result) = @_;
160
161 return "$result";
162}
163
164sub _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
179sub _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
194sub _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
252sub _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
264sub _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
309sub _getopt
310
# spent 49µs within main::_getopt which was called: # once (49µs+0s) by main::search at line 61
{
3112113µ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