| 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 | main::BEGIN@9 |
| 1 | 1 | 1 | 9.42ms | 9.58ms | main::BEGIN@7 |
| 1 | 1 | 1 | 4.12ms | 485ms | main::BEGIN@10 |
| 1 | 1 | 1 | 1.38ms | 1.56ms | main::BEGIN@6 |
| 1 | 1 | 1 | 198µs | 198µs | main::BEGIN@5 |
| 22 | 1 | 1 | 82µs | 82µs | Internals::SvREADONLY (xsub) |
| 1 | 1 | 1 | 49µs | 49µs | main::_getopt |
| 1 | 1 | 1 | 40µs | 3.72ms | main::setup |
| 1 | 1 | 1 | 38µs | 166µs | main::BEGIN@11 |
| 1 | 1 | 1 | 36µs | 51µs | main::BEGIN@19 |
| 1 | 1 | 1 | 34µs | 825µs | main::BEGIN@69 |
| 1 | 1 | 1 | 32µs | 32µs | version::(bool (xsub) |
| 3 | 1 | 1 | 24µs | 24µs | mro::method_changed_in (xsub) |
| 1 | 1 | 1 | 22µs | 71µs | main::search |
| 1 | 1 | 1 | 20µs | 20µs | version::(cmp (xsub) |
| 1 | 1 | 1 | 15µs | 15µs | main::CORE:match (opcode) |
| 1 | 1 | 1 | 15µs | 86µs | main::default |
| 1 | 1 | 1 | 12µs | 12µs | main::help |
| 0 | 0 | 0 | 0s | 0s | main::RUNTIME |
| 0 | 0 | 0 | 0s | 0s | main::_format_flat |
| 0 | 0 | 0 | 0s | 0s | main::_format_flat_inner_array |
| 0 | 0 | 0 | 0s | 0s | main::_format_flat_inner_hash |
| 0 | 0 | 0 | 0s | 0s | main::_format_flat_inner_scalar |
| 0 | 0 | 0 | 0s | 0s | main::_format_flat_outer |
| 0 | 0 | 0 | 0s | 0s | main::_match |
| 0 | 0 | 0 | 0s | 0s | main::_read_in |
| 0 | 0 | 0 | 0s | 0s | main::_write_out |
| 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 | 1 | 2µs | my $default_cmd = "search"; | ||
| 21 | 1 | 47µs | 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 | 1 | 2µs | my $c = shift; | ||
| 29 | 1 | 7µs | 1 | 38µs | $c->unregister_command("help"); # spent 38µs making 1 call to App::Rad::unregister_command |
| 30 | 1 | 21µs | 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 | 1 | 3µs | my ($c) = @_; | ||
| 36 | |||||
| 37 | 1 | 15µs | 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 | 1 | 3µs | my ($c) = @_; | ||
| 60 | |||||
| 61 | 1 | 4µs | 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 | 1 | 2µs | my ($c) = @_; | ||
| 312 | |||||
| 313 | 1 | 110µs | $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 |