Filename | /home/ss5/local/projects/app-dpath/bin/dpath |
Statements | Executed 27 statements in 19.8ms |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
1 | 1 | 1 | 10.5ms | 46.3ms | BEGIN@9 | main::
1 | 1 | 1 | 9.42ms | 9.58ms | BEGIN@7 | main::
1 | 1 | 1 | 4.12ms | 485ms | BEGIN@10 | main::
1 | 1 | 1 | 1.38ms | 1.56ms | BEGIN@6 | main::
1 | 1 | 1 | 198µs | 198µs | BEGIN@5 | main::
22 | 1 | 1 | 82µs | 82µs | SvREADONLY (xsub) | Internals::
1 | 1 | 1 | 49µs | 49µs | _getopt | main::
1 | 1 | 1 | 40µs | 3.72ms | setup | main::
1 | 1 | 1 | 38µs | 166µs | BEGIN@11 | main::
1 | 1 | 1 | 36µs | 51µs | BEGIN@19 | main::
1 | 1 | 1 | 34µs | 825µs | BEGIN@69 | main::
1 | 1 | 1 | 32µs | 32µs | (bool (xsub) | version::
3 | 1 | 1 | 24µs | 24µs | method_changed_in (xsub) | mro::
1 | 1 | 1 | 22µs | 71µs | search | main::
1 | 1 | 1 | 20µs | 20µs | (cmp (xsub) | version::
1 | 1 | 1 | 15µs | 15µs | CORE:match (opcode) | main::
1 | 1 | 1 | 15µs | 86µs | default | main::
1 | 1 | 1 | 12µs | 12µs | help | main::
0 | 0 | 0 | 0s | 0s | RUNTIME | main::
0 | 0 | 0 | 0s | 0s | _format_flat | main::
0 | 0 | 0 | 0s | 0s | _format_flat_inner_array | main::
0 | 0 | 0 | 0s | 0s | _format_flat_inner_hash | main::
0 | 0 | 0 | 0s | 0s | _format_flat_inner_scalar | main::
0 | 0 | 0 | 0s | 0s | _format_flat_outer | main::
0 | 0 | 0 | 0s | 0s | _match | main::
0 | 0 | 0 | 0s | 0s | _read_in | main::
0 | 0 | 0 | 0s | 0s | _write_out | main::
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 # 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 # 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 # 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 # 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 # 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 # 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 | ||||
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 | ||||
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] # 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 | |||||
# spent 15µs within main::CORE:match which was called:
# once (15µs+0s) by main::BEGIN@19 at line 21 | |||||
# 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 | |||||
# spent 32µs within version::(bool which was called:
# once (32µs+0s) by DynaLoader::BEGIN@22 at line 57 of Config.pm | |||||
# spent 20µs within version::(cmp which was called:
# once (20µs+0s) by DynaLoader::BEGIN@22 at line 60 of Config.pm |