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

Filename/home/ss5/perl5/perlbrew/perls/perl-5.14.1/lib/site_perl/5.14.1/Data/DPath/Context.pm
StatementsExecuted 60 statements in 15.3ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
11110.9ms181msData::DPath::Context::::BEGIN@23Data::DPath::Context::BEGIN@23
1117.18ms59.7msData::DPath::Context::::BEGIN@19Data::DPath::Context::BEGIN@19
1112.91ms9.16msData::DPath::Context::::BEGIN@18Data::DPath::Context::BEGIN@18
1112.77ms48.6msData::DPath::Context::::BEGIN@22Data::DPath::Context::BEGIN@22
1112.58ms15.3msData::DPath::Context::::BEGIN@16Data::DPath::Context::BEGIN@16
1112.33ms3.68msData::DPath::Context::::BEGIN@17Data::DPath::Context::BEGIN@17
11165µs3.40msData::DPath::Context::::BEGIN@29Data::DPath::Context::BEGIN@29
11161µs256µsData::DPath::Context::::BEGIN@20Data::DPath::Context::BEGIN@20
11156µs796µsData::DPath::Context::::BEGIN@64Data::DPath::Context::BEGIN@64
11148µs82µsData::DPath::Context::::BEGIN@223Data::DPath::Context::BEGIN@223
11146µs580µsData::DPath::Context::::BEGIN@57Data::DPath::Context::BEGIN@57
11144µs104µsData::DPath::Context::::BEGIN@102Data::DPath::Context::BEGIN@102
11143µs108µsData::DPath::Context::::BEGIN@424Data::DPath::Context::BEGIN@424
11137µs37µsData::DPath::Context::::BEGIN@2Data::DPath::Context::BEGIN@2
11136µs90µsData::DPath::Context::::BEGIN@158Data::DPath::Context::BEGIN@158
11136µs81µsData::DPath::Context::::BEGIN@281Data::DPath::Context::BEGIN@281
11135µs80µsData::DPath::Filters::::BEGIN@204Data::DPath::Filters::BEGIN@204
11131µs81µsData::DPath::Context::::BEGIN@425Data::DPath::Context::BEGIN@425
11131µs72µsData::DPath::Context::::BEGIN@159Data::DPath::Context::BEGIN@159
11130µs64µsData::DPath::Context::::BEGIN@305Data::DPath::Context::BEGIN@305
11129µs71µsData::DPath::Context::::BEGIN@222Data::DPath::Context::BEGIN@222
11129µs162µsData::DPath::Context::::BEGIN@13Data::DPath::Context::BEGIN@13
11128µs43µsData::DPath::Context::::BEGIN@10Data::DPath::Context::BEGIN@10
11127µs56µsData::DPath::Context::::BEGIN@11Data::DPath::Context::BEGIN@11
11127µs27µsData::DPath::Filters::::BEGIN@33Data::DPath::Filters::BEGIN@33
11127µs390µsData::DPath::Context::::BEGIN@14Data::DPath::Context::BEGIN@14
11127µs2.05msData::DPath::Context::::BEGIN@15Data::DPath::Context::BEGIN@15
0000s0sData::DPath::Context::::__ANON__[:411]Data::DPath::Context::__ANON__[:411]
0000s0sData::DPath::Context::::_allData::DPath::Context::_all
0000s0sData::DPath::Context::::_anyData::DPath::Context::_any
0000s0sData::DPath::Context::::_filter_pointsData::DPath::Context::_filter_points
0000s0sData::DPath::Context::::_filter_points_evalData::DPath::Context::_filter_points_eval
0000s0sData::DPath::Context::::_filter_points_indexData::DPath::Context::_filter_points_index
0000s0sData::DPath::Context::::_iterData::DPath::Context::_iter
0000s0sData::DPath::Context::::_searchData::DPath::Context::_search
0000s0sData::DPath::Context::::_select_ancestorData::DPath::Context::_select_ancestor
0000s0sData::DPath::Context::::_select_ancestor_or_selfData::DPath::Context::_select_ancestor_or_self
0000s0sData::DPath::Context::::_select_anystepData::DPath::Context::_select_anystep
0000s0sData::DPath::Context::::_select_anywhereData::DPath::Context::_select_anywhere
0000s0sData::DPath::Context::::_select_keyData::DPath::Context::_select_key
0000s0sData::DPath::Context::::_select_nostepData::DPath::Context::_select_nostep
0000s0sData::DPath::Context::::_select_parentData::DPath::Context::_select_parent
0000s0sData::DPath::Context::::_select_rootData::DPath::Context::_select_root
0000s0sData::DPath::Context::::_splice_threadsData::DPath::Context::_splice_threads
0000s0sData::DPath::Context::::all_pointsData::DPath::Context::all_points
0000s0sData::DPath::Context::::derefData::DPath::Context::deref
0000s0sData::DPath::Context::::first_pointData::DPath::Context::first_point
0000s0sData::DPath::Context::::isearchData::DPath::Context::isearch
0000s0sData::DPath::Context::::matchData::DPath::Context::match
0000s0sData::DPath::Context::::refData::DPath::Context::ref
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments
Time
on line
Calls Time
in subs
Code
1package Data::DPath::Context;
2
# spent 37µs within Data::DPath::Context::BEGIN@2 which was called: # once (37µs+0s) by Data::DPath::Path::BEGIN@1.2 at line 4
BEGIN {
3120µs $Data::DPath::Context::AUTHORITY = 'cpan:SCHWIGON';
41124µs137µs}
# spent 37µs making 1 call to Data::DPath::Context::BEGIN@2
5{
626µs $Data::DPath::Context::VERSION = '0.48';
7}
8# ABSTRACT: Abstraction for a current context that enables incremental searches
9
10289µs258µs
# spent 43µs (28+15) within Data::DPath::Context::BEGIN@10 which was called: # once (28µs+15µs) by Data::DPath::Path::BEGIN@1.2 at line 10
use strict;
# spent 43µs making 1 call to Data::DPath::Context::BEGIN@10 # spent 15µs making 1 call to strict::import
11293µs285µs
# spent 56µs (27+29) within Data::DPath::Context::BEGIN@11 which was called: # once (27µs+29µs) by Data::DPath::Path::BEGIN@1.2 at line 11
use warnings;
# spent 56µs making 1 call to Data::DPath::Context::BEGIN@11 # spent 29µs making 1 call to warnings::import
12
132103µs2295µs
# spent 162µs (29+133) within Data::DPath::Context::BEGIN@13 which was called: # once (29µs+133µs) by Data::DPath::Path::BEGIN@1.2 at line 13
use Data::Dumper;
# spent 162µs making 1 call to Data::DPath::Context::BEGIN@13 # spent 133µs making 1 call to Exporter::import
142109µs2390µs
# spent 390µs (27+363) within Data::DPath::Context::BEGIN@14 which was called: # once (27µs+363µs) by Data::DPath::Path::BEGIN@1.2 at line 14
use aliased 'Data::DPath::Point';
# spent 390µs making 1 call to Data::DPath::Context::BEGIN@14 # spent 363µs making 1 call to aliased::import, recursion: max depth 1, sum of overlapping time 363µs
152135µs22.05ms
# spent 2.05ms (27µs+2.03) within Data::DPath::Context::BEGIN@15 which was called: # once (27µs+2.03ms) by Data::DPath::Path::BEGIN@1.2 at line 15
use aliased 'Data::DPath::Attrs';
# spent 2.05ms making 1 call to Data::DPath::Context::BEGIN@15 # spent 2.03ms making 1 call to aliased::import, recursion: max depth 1, sum of overlapping time 2.03ms
162466µs215.8ms
# spent 15.3ms (2.58+12.7) within Data::DPath::Context::BEGIN@16 which was called: # once (2.58ms+12.7ms) by Data::DPath::Path::BEGIN@1.2 at line 16
use List::MoreUtils 'uniq';
# spent 15.3ms making 1 call to Data::DPath::Context::BEGIN@16 # spent 452µs making 1 call to Exporter::import
172482µs23.96ms
# spent 3.68ms (2.33+1.35) within Data::DPath::Context::BEGIN@17 which was called: # once (2.33ms+1.35ms) by Data::DPath::Path::BEGIN@1.2 at line 17
use Scalar::Util 'reftype';
# spent 3.68ms making 1 call to Data::DPath::Context::BEGIN@17 # spent 278µs making 1 call to Exporter::import
182490µs19.16ms
# spent 9.16ms (2.91+6.25) within Data::DPath::Context::BEGIN@18 which was called: # once (2.91ms+6.25ms) by Data::DPath::Path::BEGIN@1.2 at line 18
use Data::DPath::Filters;
# spent 9.16ms making 1 call to Data::DPath::Context::BEGIN@18
192475µs260.1ms
# spent 59.7ms (7.18+52.5) within Data::DPath::Context::BEGIN@19 which was called: # once (7.18ms+52.5ms) by Data::DPath::Path::BEGIN@1.2 at line 19
use Iterator::Util;
# spent 59.7ms making 1 call to Data::DPath::Context::BEGIN@19 # spent 354µs making 1 call to Exporter::import
202137µs2450µs
# spent 256µs (61+195) within Data::DPath::Context::BEGIN@20 which was called: # once (61µs+195µs) by Data::DPath::Path::BEGIN@1.2 at line 20
use List::Util 'min';
# spent 256µs making 1 call to Data::DPath::Context::BEGIN@20 # spent 195µs making 1 call to Exporter::import
21#use Sys::CPU;
222530µs274.4ms
# spent 48.6ms (2.77+45.8) within Data::DPath::Context::BEGIN@22 which was called: # once (2.77ms+45.8ms) by Data::DPath::Path::BEGIN@1.2 at line 22
use POSIX;
# spent 48.6ms making 1 call to Data::DPath::Context::BEGIN@22 # spent 25.8ms making 1 call to POSIX::import
232732µs1181ms
# spent 181ms (10.9+170) within Data::DPath::Context::BEGIN@23 which was called: # once (10.9ms+170ms) by Data::DPath::Path::BEGIN@1.2 at line 23
use Safe;
# spent 181ms making 1 call to Data::DPath::Context::BEGIN@23
24
25# run filter expressions in own Safe.pm compartment
261600nsour $COMPARTMENT;
271500nsour $THREADCOUNT;
28
29
# spent 3.40ms (65µs+3.33) within Data::DPath::Context::BEGIN@29 which was called: # once (65µs+3.33ms) by Data::DPath::Path::BEGIN@1.2 at line 51
BEGIN {
30 #$THREADCOUNT = $Data::DPath::PARALLELIZE ? Sys::CPU::cpu_count : 1;
31 #print "THREADCOUNT: $THREADCOUNT\n";
32 package Data::DPath::Filters;
33
# spent 27µs within Data::DPath::Filters::BEGIN@33 which was called: # once (27µs+0s) by Data::DPath::Path::BEGIN@1.2 at line 35
BEGIN {
34118µs $Data::DPath::Filters::AUTHORITY = 'cpan:SCHWIGON';
351286µs127µs}
# spent 27µs making 1 call to Data::DPath::Filters::BEGIN@33
36{
37545µs $Data::DPath::Filters::VERSION = '0.48';
38}
3912.87ms $COMPARTMENT = Safe->new;
# spent 2.87ms making 1 call to Safe::new
40144µs $COMPARTMENT->permit(qw":base_core");
# spent 44µs making 1 call to Safe::permit
41 # map DPath filter functions into new namespace
421418µs $COMPARTMENT->share(qw(affe
# spent 418µs making 1 call to Safe::share
43 idx
44 size
45 key
46 value
47 isa
48 reftype
49 is_reftype
50 ));
511209µs13.40ms}
# spent 3.40ms making 1 call to Data::DPath::Context::BEGIN@29
52
53# print "use $]\n" if $] >= 5.010; # allow new-school Perl inside filter expressions
54# eval "use $]" if $] >= 5.010; # allow new-school Perl inside filter expressions
55
56use Class::XSAccessor::Array
571534µs
# spent 580µs (46+534) within Data::DPath::Context::BEGIN@57 which was called: # once (46µs+534µs) by Data::DPath::Path::BEGIN@1.2 at line 62
chained => 1,
# spent 534µs making 1 call to Class::XSAccessor::Array::import
58 constructor => 'new',
59 accessors => {
60 current_points => 0,
61 give_references => 1,
622346µs1580µs };
# spent 580µs making 1 call to Data::DPath::Context::BEGIN@57
63
641740µs
# spent 796µs (56+740) within Data::DPath::Context::BEGIN@64 which was called: # once (56µs+740µs) by Data::DPath::Path::BEGIN@1.2 at line 75
use constant { HASH => 'HASH',
# spent 740µs making 1 call to constant::import
65 ARRAY => 'ARRAY',
66 SCALAR => 'SCALAR',
67 ROOT => 'ROOT',
68 ANYWHERE => 'ANYWHERE',
69 KEY => 'KEY',
70 ANYSTEP => 'ANYSTEP',
71 NOSTEP => 'NOSTEP',
72 PARENT => 'PARENT',
73 ANCESTOR => 'ANCESTOR',
74 ANCESTOR_OR_SELF => 'ANCESTOR_OR_SELF',
752697µs1796µs };
# spent 796µs making 1 call to Data::DPath::Context::BEGIN@64
76
77sub _splice_threads {
78 my ($cargo) = @_;
79
80 my $nr_cargo = @$cargo;
81
82 return [[]] unless $nr_cargo;
83
84 my $threadcount = $THREADCOUNT || 1;
85 my $blocksize = ceil ($nr_cargo / $threadcount);
86
87 my @result = map {
88 my $first = $_ * $blocksize;
89 my $last = min(($_+1) * $blocksize - 1, $nr_cargo-1);
90 ($first <= $last) ? [ @$cargo[$first .. $last]] : ();
91 } 0 .. $threadcount-1;
92
93 return \@result;
94}
95
96# only finds "inner" values; if you need the outer start value
97# then just wrap it into one more level of array brackets.
98sub _any
99{
100 my ($out, $in, $lookahead_key) = @_;
101
10221.48ms2165µs
# spent 104µs (44+60) within Data::DPath::Context::BEGIN@102 which was called: # once (44µs+60µs) by Data::DPath::Path::BEGIN@1.2 at line 102
no warnings 'uninitialized';
# spent 104µs making 1 call to Data::DPath::Context::BEGIN@102 # spent 60µs making 1 call to warnings::unimport
103
104 $in = defined $in ? $in : [];
105 return @$out unless @$in;
106
107 my @newin;
108 my @newout;
109 my $tmp_ref;
110 my $tmp_deref;
111 my $tmp_reftype;
112
113 foreach my $point (@$in) {
114 my @values;
115 next unless defined $point;
116 my $ref = $point->ref;
117
118 # speed optimization: first try faster ref, then reftype
119 if (ref($$ref) eq HASH or reftype($$ref) eq HASH) {
120 @values =
121 map { { val_ref => \($$ref->{$_}), key => $_ } }
122 grep {
123 # speed optimization: only consider a key if lookahead looks promising
124 not defined $lookahead_key
125 or $_ eq $lookahead_key
126 or ($tmp_ref = ref($tmp_deref =$$ref->{$_})) eq HASH
127 or $tmp_ref eq ARRAY
128 or ($tmp_reftype = reftype($tmp_deref)) eq HASH
129 or $tmp_reftype eq ARRAY
130 # or HASH_or_ARRAY(\($$ref->{$_}))
131 }
132 keys %{$$ref};
133 }
134 elsif (ref($$ref) eq ARRAY or reftype($$ref) eq ARRAY) {
135 @values = map { { val_ref => \$_ } } @{$$ref}
136 }
137 else {
138 next
139 }
140
141 foreach (@values)
142 {
143 my $key = $_->{key};
144 my $val_ref = $_->{val_ref};
145 my $newpoint = Point->new->ref($val_ref)->parent($point);
146 $newpoint->attrs( Attrs->new(key => $key)) if $key;
147 push @newout, $newpoint;
148 push @newin, $newpoint;
149 }
150 }
151 push @$out, @newout;
152 return _any ($out, \@newin, $lookahead_key);
153}
154
155sub _all {
156 my ($self) = @_;
157
1582106µs2144µs
# spent 90µs (36+54) within Data::DPath::Context::BEGIN@158 which was called: # once (36µs+54µs) by Data::DPath::Path::BEGIN@1.2 at line 158
no strict 'refs';
# spent 90µs making 1 call to Data::DPath::Context::BEGIN@158 # spent 54µs making 1 call to strict::unimport
1592915µs2114µs
# spent 72µs (31+42) within Data::DPath::Context::BEGIN@159 which was called: # once (31µs+42µs) by Data::DPath::Path::BEGIN@1.2 at line 159
no warnings 'uninitialized';
# spent 72µs making 1 call to Data::DPath::Context::BEGIN@159 # spent 42µs making 1 call to warnings::unimport
160
161 return
162 map { $self->give_references ? $_ : $$_ }
163 uniq
164 map { defined $_ ? $_->ref : () }
165 @{$self->current_points};
166}
167
168# filter current results by array index
169sub _filter_points_index {
170 my ($self, $index, $points) = @_;
171
172 return $points ? [$points->[$index]] : [];
173}
174
175# filter current results by condition
176sub _filter_points_eval
177{
178 my ($self, $filter, $points) = @_;
179
180 return [] unless @$points;
181 return $points unless defined $filter;
182
183 my $new_points;
184 my $res;
185 {
186 package Data::DPath::Filters;
187
188 local our $idx = 0;
189 $new_points = [
190 grep {
191 local our $p = $_;
192 local $_;
193 my $pref = $p->ref;
194 if ( defined $pref ) {
195 $_ = $$pref;
196 if ($Data::DPath::USE_SAFE) {
197 # 'uninitialized' values are the norm
198 # but "no warnings 'uninitialized'" does
199 # not work in this restrictive Safe.pm config, so
200 # we deactivate warnings completely by localizing $^W
201 $res = $COMPARTMENT->reval('local $^W;'.$filter);
202 } else {
203 # 'uninitialized' values are the norm
2042465µs2124µs
# spent 80µs (35+45) within Data::DPath::Filters::BEGIN@204 which was called: # once (35µs+45µs) by Data::DPath::Path::BEGIN@1.2 at line 204
no warnings 'uninitialized';
# spent 80µs making 1 call to Data::DPath::Filters::BEGIN@204 # spent 45µs making 1 call to warnings::unimport
205 $res = eval($filter);
206 }
207 print STDERR ($@, "\n") if $@;
208 } else {
209 $res = 0;
210 }
211 $idx++;
212 $res;
213 } @$points
214 ];
215 }
216 return $new_points;
217}
218
219sub _filter_points {
220 my ($self, $step, $points) = @_;
221
2222103µs2113µs
# spent 71µs (29+42) within Data::DPath::Context::BEGIN@222 which was called: # once (29µs+42µs) by Data::DPath::Path::BEGIN@1.2 at line 222
no strict 'refs';
# spent 71µs making 1 call to Data::DPath::Context::BEGIN@222 # spent 42µs making 1 call to strict::unimport
22321.20ms2116µs
# spent 82µs (48+34) within Data::DPath::Context::BEGIN@223 which was called: # once (48µs+34µs) by Data::DPath::Path::BEGIN@1.2 at line 223
no warnings 'uninitialized';
# spent 82µs making 1 call to Data::DPath::Context::BEGIN@223 # spent 34µs making 1 call to warnings::unimport
224
225 return [] unless @$points;
226
227 my $filter = $step->filter;
228 return $points unless defined $filter;
229
230 $filter =~ s/^\[\s*(.*?)\s*\]$/$1/; # strip brackets and whitespace
231
232 if ($filter =~ /^-?\d+$/)
233 {
234 return $self->_filter_points_index($filter, $points); # simple array index
235 }
236 elsif ($filter =~ /\S/)
237 {
238 return $self->_filter_points_eval($filter, $points); # full condition
239 }
240 else
241 {
242 return $points;
243 }
244}
245
246# the root node
247# (only makes sense at first step, but currently not asserted)
248sub _select_root {
249 my ($self, $step, $current_points, $new_points) = @_;
250
251 my $step_points = $self->_filter_points($step, $current_points);
252 push @$new_points, @$step_points;
253}
254
255
256# //
257# anywhere in the tree
258sub _select_anywhere {
259 my ($self, $step, $current_points, $lookahead, $new_points) = @_;
260
261 # speed optimization: only useful points added
262 my $lookahead_key;
263 if (defined $lookahead and $lookahead->kind eq KEY) {
264 $lookahead_key = $lookahead->part;
265 }
266
267 # '//'
268 # all hash/array nodes of a data structure
269 foreach my $point (@$current_points) {
270 my $step_points = [_any([], [ $point ], $lookahead_key), $point];
271 push @$new_points, @{$self->_filter_points($step, $step_points)};
272 }
273}
274
275# /key
276# the value of a key
277sub _select_key {
278 my ($self, $step, $current_points, $new_points) = @_;
279
280 foreach my $point (@$current_points) {
2812648µs2126µs
# spent 81µs (36+45) within Data::DPath::Context::BEGIN@281 which was called: # once (36µs+45µs) by Data::DPath::Path::BEGIN@1.2 at line 281
no warnings 'uninitialized';
# spent 81µs making 1 call to Data::DPath::Context::BEGIN@281 # spent 45µs making 1 call to warnings::unimport
282 next unless defined $point;
283 my $pref = $point->ref;
284 next unless (
285 # speed optimization:
286 # first try faster ref, then reftype
287 ref($$pref) eq HASH or
288 reftype($$pref) eq HASH
289 );
290 # take point as hash, skip undefs
291 my $attrs = Attrs->new(key => $step->part);
292 my $step_points = [];
293 if (exists $$pref->{$step->part}) {
294 $step_points = [ Point->new->ref(\($$pref->{$step->part}))->parent($point)->attrs($attrs) ];
295 }
296 push @$new_points, @{$self->_filter_points($step, $step_points)};
297 }
298}
299
300# '*'
301# all leaves of a data tree
302sub _select_anystep {
303 my ($self, $step, $current_points, $new_points) = @_;
304
30522.98ms298µs
# spent 64µs (30+34) within Data::DPath::Context::BEGIN@305 which was called: # once (30µs+34µs) by Data::DPath::Path::BEGIN@1.2 at line 305
no warnings 'uninitialized';
# spent 64µs making 1 call to Data::DPath::Context::BEGIN@305 # spent 34µs making 1 call to warnings::unimport
306 foreach my $point (@$current_points) {
307 # take point as array
308 my $pref = $point->ref;
309 my $ref = $$pref;
310 my $step_points = [];
311 # speed optimization: first try faster ref, then reftype
312 if (ref($ref) eq HASH or reftype($ref) eq HASH) {
313 $step_points = [ map {
314 my $v_ref = \($ref->{$_});
315 my $attrs = Attrs->new(key => $_);
316 Point->new->ref($v_ref)->parent($point)->attrs($attrs)
317 } keys %$ref ];
318 } elsif (ref($ref) eq ARRAY or reftype($ref) eq ARRAY) {
319 $step_points = [ map {
320 Point->new->ref(\$_)->parent($point)
321 } @$ref ];
322 } else {
323 if (ref($pref) eq SCALAR or reftype($pref) eq SCALAR) {
324 # TODO: without map, it's just one value
325 $step_points = [ #map {
326 Point->new->ref($pref)->parent($point) # XXX? why $_? What happens to $pref?
327 ]; # } $ref ];
328 }
329 }
330 push @$new_points, @{ $self->_filter_points($step, $step_points) };
331 }
332}
333
334# '.'
335# no step (neither up nor down), just allow filtering
336sub _select_nostep {
337 my ($self, $step, $current_points, $new_points) = @_;
338
339 foreach my $point (@{$current_points}) {
340 my $step_points = [$point];
341 push @$new_points, @{ $self->_filter_points($step, $step_points) };
342 }
343}
344
345# '..'
346# the parent
347sub _select_parent {
348 my ($self, $step, $current_points, $new_points) = @_;
349
350 foreach my $point (@{$current_points}) {
351 next unless defined $point;
352 my $step_points = [$point->parent];
353 push @$new_points, @{ $self->_filter_points($step, $step_points) };
354 }
355}
356
357# '::ancestor'
358# all ancestors (parent, grandparent, etc.) of the current node
359sub _select_ancestor {
360 my ($self, $step, $current_points, $new_points) = @_;
361
362 foreach my $point (@{$current_points}) {
363 my $step_points = [];
364 my $parent = $point;
365 while ($parent = $parent->parent) {
366 push @$step_points, $parent; # order matters
367 }
368 push @$new_points, @{ $self->_filter_points($step, $step_points) };
369 }
370}
371
372# '::ancestor-or-self'
373# all ancestors (parent, grandparent, etc.) of the current node and the current node itself
374sub _select_ancestor_or_self {
375 my ($self, $step, $current_points, $new_points) = @_;
376
377 foreach my $point (@{$current_points}) {
378 my $step_points = [$point];
379 my $parent = $point;
380 while ($parent = $parent->parent) {
381 push @$step_points, $parent; # order matters
382 }
383 push @$new_points, @{ $self->_filter_points($step, $step_points) };
384 }
385}
386
387sub ref {
388 my ($self) = @_;
389 $self->first_point->{ref};
390}
391
392sub deref {
393 my ($self) = @_;
394 ${$self->ref};
395}
396
397sub first_point {
398 my ($self) = @_;
399 $self->current_points->[0];
400}
401
402sub all_points {
403 my ($self) = @_;
404 iarray $self->current_points;
405}
406
407sub _iter {
408 my ($self) = @_;
409
410 my $iter = iarray $self->current_points;
411 return imap { __PACKAGE__->new->current_points([ $_ ]) } $iter;
412}
413
414sub isearch
415{
416 my ($self, $path_str) = @_;
417 $self->_search(Data::DPath::Path->new(path => $path_str))->_iter;
418}
419
420sub _search
421{
422 my ($self, $dpath) = @_;
423
4242109µs2172µs
# spent 108µs (43+65) within Data::DPath::Context::BEGIN@424 which was called: # once (43µs+65µs) by Data::DPath::Path::BEGIN@1.2 at line 424
no strict 'refs';
# spent 108µs making 1 call to Data::DPath::Context::BEGIN@424 # spent 65µs making 1 call to strict::unimport
42521.65ms2130µs
# spent 81µs (31+50) within Data::DPath::Context::BEGIN@425 which was called: # once (31µs+50µs) by Data::DPath::Path::BEGIN@1.2 at line 425
no warnings 'uninitialized';
# spent 81µs making 1 call to Data::DPath::Context::BEGIN@425 # spent 50µs making 1 call to warnings::unimport
426
427 my $current_points = $self->current_points;
428 my $steps = $dpath->_steps;
429 for (my $i = 0; $i < @$steps; $i++) {
430 my $step = $steps->[$i];
431 my $lookahead = $steps->[$i+1];
432 my $new_points = [];
433
434 if ($step->kind eq ROOT)
435 {
436 $self->_select_root($step, $current_points, $new_points);
437 }
438 elsif ($step->kind eq ANYWHERE)
439 {
440 $self->_select_anywhere($step, $current_points, $lookahead, $new_points);
441 }
442 elsif ($step->kind eq KEY)
443 {
444 $self->_select_key($step, $current_points, $new_points);
445 }
446 elsif ($step->kind eq ANYSTEP)
447 {
448 $self->_select_anystep($step, $current_points, $new_points);
449 }
450 elsif ($step->kind eq NOSTEP)
451 {
452 $self->_select_nostep($step, $current_points, $new_points);
453 }
454 elsif ($step->kind eq PARENT)
455 {
456 $self->_select_parent($step, $current_points, $new_points);
457 }
458 elsif ($step->kind eq ANCESTOR)
459 {
460 $self->_select_ancestor($step, $current_points, $new_points);
461 }
462 elsif ($step->kind eq ANCESTOR_OR_SELF)
463 {
464 $self->_select_ancestor_or_self($step, $current_points, $new_points);
465 }
466 $current_points = $new_points;
467 }
468 $self->current_points( $current_points );
469 return $self;
470}
471
472sub match {
473 my ($self, $dpath) = @_;
474
475 $self->_search($dpath)->_all;
476}
477
478116µs1;
479
- -
482=pod
483
484=encoding utf-8
485
486=head1 NAME
487
488Data::DPath::Context - Abstraction for a current context that enables incremental searches
489
490=head1 API METHODS
491
492=head2 new ( %args )
493
494Constructor; creates instance.
495
496Args:
497
498=over 4
499
500=item give_references
501
502Default 0. If set to true value then results are references to the
503matched points in the data structure.
504
505=back
506
507=head2 match( $dpath )
508
509Return all data that match the given DPath.
510
511=head2 isearch( $path_str )
512
513Searches a path relative to current context and returns an iterator.
514See L<Iterator style|Data::DPath/"Iterator style"> for usage.
515
516=head2 ref()
517
518It returns the reference to the actual data from the current context's
519first element. This mostly makes sense on contexts returned by
520iterators as there is only one point there.
521
522(Having the reference theoretically allows you to even change the data
523on this point. It's not yet clear what impact this has to currently
524active iterators, which B<should> still return the original data but
525that's not yet tested. So don't rely on that behaviour.)
526
527=head2 deref()
528
529This is one dereference step on top of F<ref()>. It gives you the
530actual data found. Most of the time you want this.
531
532=head2 first_point
533
534On a current context consisting on a set of points it returns the
535first point. This makes most sense with Iterator style API when the
536current iterator contains exactly one point.
537
538=head2 all_points
539
540On a current context consisting on a set of points it returns all
541those. This method is a functional complement to F<first_point>.
542
543=head1 UTILITY SUBS/METHODS
544
545=head2 _all
546
547Returns all values covered by current context.
548
549If C<give_references> is set to true value then results are references
550to the matched points in the data structure.
551
552=head2 _search( $dpath )
553
554Return new context for a DPath relative to current context.
555
556=head2 _filter_points
557
558Evaluates the filter condition in brackets. It differenciates between
559simple integers, which are taken as array index, and all other
560conditions, which are taken as evaled perl expression in a grep like
561expression onto the set of points found by current step.
562
563=head2 current_points
564
565Attribute / accessor.
566
567=head2 give_references
568
569Attribute / accessor.
570
571=head1 aliased classes
572
573That's just to make Pod::Coverage happy which does not handle aliased
574modules.
575
576=head2 Context
577
578=head2 Point
579
580=head2 Step
581
582=head1 AUTHOR
583
584Steffen Schwigon <ss5@renormalist.net>
585
586=head1 COPYRIGHT AND LICENSE
587
588This software is copyright (c) 2012 by Steffen Schwigon.
589
590This is free software; you can redistribute it and/or modify it under
591the same terms as the Perl 5 programming language system itself.
592
593=cut
594
595
596__END__