line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Struct::Path; |
2
|
|
|
|
|
|
|
|
3
|
8
|
|
|
8
|
|
506610
|
use 5.006; |
|
8
|
|
|
|
|
99
|
|
4
|
8
|
|
|
8
|
|
40
|
use strict; |
|
8
|
|
|
|
|
15
|
|
|
8
|
|
|
|
|
179
|
|
5
|
8
|
|
|
8
|
|
37
|
use warnings FATAL => 'all'; |
|
8
|
|
|
|
|
11
|
|
|
8
|
|
|
|
|
367
|
|
6
|
8
|
|
|
8
|
|
3295
|
use parent 'Exporter'; |
|
8
|
|
|
|
|
2656
|
|
|
8
|
|
|
|
|
38
|
|
7
|
|
|
|
|
|
|
|
8
|
8
|
|
|
8
|
|
422
|
use Carp 'croak'; |
|
8
|
|
|
|
|
17
|
|
|
8
|
|
|
|
|
14572
|
|
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
our @EXPORT_OK = qw( |
11
|
|
|
|
|
|
|
implicit_step |
12
|
|
|
|
|
|
|
list_paths |
13
|
|
|
|
|
|
|
path |
14
|
|
|
|
|
|
|
path_delta |
15
|
|
|
|
|
|
|
); |
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
=head1 NAME |
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
Struct::Path - Path for nested structures where path is also a structure |
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
=begin html |
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
=end html |
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
=head1 VERSION |
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
Version 0.83 |
32
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
=cut |
34
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
our $VERSION = '0.83'; |
36
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
=head1 SYNOPSIS |
38
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
use Struct::Path qw(list_paths path); |
40
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
$s = [ |
42
|
|
|
|
|
|
|
0, |
43
|
|
|
|
|
|
|
{ |
44
|
|
|
|
|
|
|
two => { |
45
|
|
|
|
|
|
|
three => 3, |
46
|
|
|
|
|
|
|
four => 4 |
47
|
|
|
|
|
|
|
} |
48
|
|
|
|
|
|
|
}, |
49
|
|
|
|
|
|
|
undef |
50
|
|
|
|
|
|
|
]; |
51
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
@list = list_paths($s); # list paths and values |
53
|
|
|
|
|
|
|
# @list == ( |
54
|
|
|
|
|
|
|
# [[0]], \0, |
55
|
|
|
|
|
|
|
# [[1],{K => ['two']},{K => ['four']}], \4, |
56
|
|
|
|
|
|
|
# [[1],{K => ['two']},{K => ['three']}], \3, |
57
|
|
|
|
|
|
|
# [[2]], \undef |
58
|
|
|
|
|
|
|
# ) |
59
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
@r = path($s, [ [1],{K => ['two']} ]); # get refs to values |
61
|
|
|
|
|
|
|
# @r == (\{four => 4,three => 3}) |
62
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
=head1 DESCRIPTION |
64
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
Struct::Path provides functions to access/match/expand/list nested data |
66
|
|
|
|
|
|
|
structures. |
67
|
|
|
|
|
|
|
|
68
|
|
|
|
|
|
|
Why L are not enough? This module has no |
69
|
|
|
|
|
|
|
conflicts for paths like '/a/0/c', where C<0> may be an array index or a key |
70
|
|
|
|
|
|
|
for hash (depends on passed structure). This is vital in some cases, for |
71
|
|
|
|
|
|
|
example, when one need to define exact path in structure, but unable to |
72
|
|
|
|
|
|
|
validate it's schema or when structure itself doesn't yet exist (see |
73
|
|
|
|
|
|
|
option C for L). |
74
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
=head1 EXPORT |
76
|
|
|
|
|
|
|
|
77
|
|
|
|
|
|
|
Nothing is exported by default. |
78
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
=head1 ADDRESSING SCHEME |
80
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
Path is a list of 'steps', each represents nested level in the structure. |
82
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
Arrayref as a step stands for ARRAY and must contain desired items indexes or |
84
|
|
|
|
|
|
|
be empty (means "all items"). Sequence for indexes define result sequence. |
85
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
Hashref represent HASH and may contain key C or be empty. C's value |
87
|
|
|
|
|
|
|
should be a list of desired keys and compiled regular expressions. Empty |
88
|
|
|
|
|
|
|
hash or empty list for C means all keys, sequence in the list define |
89
|
|
|
|
|
|
|
resulting sequence. |
90
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
Coderef step is a hook - subroutine which may filter and/or modify |
92
|
|
|
|
|
|
|
structure. Path as first argument and a stack (arrayref) of refs to traversed |
93
|
|
|
|
|
|
|
substructures as second passed to it when executed, C<$_> set to current |
94
|
|
|
|
|
|
|
substructure, C<$_{opts}> contains passed options. Some true (match) value or |
95
|
|
|
|
|
|
|
false (doesn't match) value expected as output. |
96
|
|
|
|
|
|
|
|
97
|
|
|
|
|
|
|
Sample: |
98
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
$path = [ |
100
|
|
|
|
|
|
|
[1,7], # first spep |
101
|
|
|
|
|
|
|
{R => [qr/foo/,qr/bar/]} # second step |
102
|
|
|
|
|
|
|
sub { exists $_->{bar} } # third step |
103
|
|
|
|
|
|
|
]; |
104
|
|
|
|
|
|
|
|
105
|
|
|
|
|
|
|
Struct::Path designed to be machine-friendly. See L |
106
|
|
|
|
|
|
|
and L for human friendly path definition. |
107
|
|
|
|
|
|
|
|
108
|
|
|
|
|
|
|
=head1 SUBROUTINES |
109
|
|
|
|
|
|
|
|
110
|
|
|
|
|
|
|
=head2 implicit_step |
111
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
$bool = implicit_step($step); |
113
|
|
|
|
|
|
|
|
114
|
|
|
|
|
|
|
Returns true value if step contains hooks or specified 'all' items or regexp |
115
|
|
|
|
|
|
|
match. |
116
|
|
|
|
|
|
|
|
117
|
|
|
|
|
|
|
=cut |
118
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
sub implicit_step { |
120
|
9
|
100
|
|
9
|
1
|
98
|
if (ref $_[0] eq 'ARRAY') { |
|
|
100
|
|
|
|
|
|
121
|
2
|
100
|
|
|
|
3
|
return 1 unless (@{$_[0]}); |
|
2
|
|
|
|
|
8
|
|
122
|
|
|
|
|
|
|
} elsif (ref $_[0] eq 'HASH') { |
123
|
6
|
100
|
100
|
|
|
17
|
return 1 if (exists $_[0]->{R} and @{$_[0]->{R}}); |
|
2
|
|
|
|
|
9
|
|
124
|
5
|
100
|
|
|
|
9
|
return 1 unless (exists $_[0]->{K}); |
125
|
4
|
100
|
|
|
|
5
|
return 1 unless (@{$_[0]->{K}}); |
|
4
|
|
|
|
|
11
|
|
126
|
3
|
|
100
|
|
|
4
|
ref $_ eq 'Regexp' && return 1 for (@{$_[0]->{K}}) |
|
3
|
|
|
|
|
13
|
|
127
|
|
|
|
|
|
|
} else { # hooks |
128
|
1
|
|
|
|
|
21
|
return 1; |
129
|
|
|
|
|
|
|
} |
130
|
|
|
|
|
|
|
|
131
|
3
|
|
|
|
|
10
|
return undef; |
132
|
|
|
|
|
|
|
} |
133
|
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
=head2 list_paths |
135
|
|
|
|
|
|
|
|
136
|
|
|
|
|
|
|
Returns list of paths and references to their values from structure. |
137
|
|
|
|
|
|
|
|
138
|
|
|
|
|
|
|
@list = list_paths($structure, %opts) |
139
|
|
|
|
|
|
|
|
140
|
|
|
|
|
|
|
=head3 Options |
141
|
|
|
|
|
|
|
|
142
|
|
|
|
|
|
|
=over 4 |
143
|
|
|
|
|
|
|
|
144
|
|
|
|
|
|
|
=item depth C<< >> |
145
|
|
|
|
|
|
|
|
146
|
|
|
|
|
|
|
Don't dive into structure deeper than defined level. |
147
|
|
|
|
|
|
|
|
148
|
|
|
|
|
|
|
=back |
149
|
|
|
|
|
|
|
|
150
|
|
|
|
|
|
|
=cut |
151
|
|
|
|
|
|
|
|
152
|
|
|
|
|
|
|
sub list_paths($;@) { |
153
|
7
|
|
|
7
|
1
|
32904
|
my @stack = ([], \shift); # init: (path, ref) |
154
|
7
|
|
|
|
|
22
|
my %opts = @_; |
155
|
|
|
|
|
|
|
|
156
|
7
|
|
|
|
|
43
|
my (@out, $path, $ref); |
157
|
7
|
100
|
|
|
|
27
|
my $depth = defined $opts{depth} ? $opts{depth} : -1; |
158
|
|
|
|
|
|
|
|
159
|
7
|
|
|
|
|
28
|
while (($path, $ref) = splice @stack, 0, 2) { |
160
|
66
|
100
|
100
|
|
|
96
|
if (ref ${$ref} eq 'HASH' and @{$path} != $depth and keys %{${$ref}}) { |
|
66
|
100
|
100
|
|
|
262
|
|
|
24
|
|
100
|
|
|
117
|
|
|
19
|
|
100
|
|
|
27
|
|
|
19
|
|
|
|
|
50
|
|
161
|
38
|
|
|
|
|
50
|
map { unshift @stack, [@{$path}, {K => [$_]}], \${$ref}->{$_} } |
|
38
|
|
|
|
|
86
|
|
|
38
|
|
|
|
|
108
|
|
162
|
18
|
|
|
|
|
22
|
reverse sort keys %{${$ref}}; |
|
18
|
|
|
|
|
23
|
|
|
18
|
|
|
|
|
51
|
|
163
|
48
|
|
|
|
|
107
|
} elsif (ref ${$ref} eq 'ARRAY' and @{$path} != $depth and @{${$ref}}) { |
|
12
|
|
|
|
|
34
|
|
|
11
|
|
|
|
|
18
|
|
|
11
|
|
|
|
|
28
|
|
164
|
21
|
|
|
|
|
31
|
map { unshift @stack, [@{$path}, [$_]], \${$ref}->[$_] } |
|
21
|
|
|
|
|
503
|
|
|
21
|
|
|
|
|
63
|
|
165
|
9
|
|
|
|
|
14
|
reverse 0 .. $#{${$ref}} |
|
9
|
|
|
|
|
13
|
|
|
9
|
|
|
|
|
20
|
|
166
|
|
|
|
|
|
|
} else { |
167
|
39
|
|
|
|
|
96
|
push @out, $path, $ref; |
168
|
|
|
|
|
|
|
} |
169
|
|
|
|
|
|
|
} |
170
|
|
|
|
|
|
|
|
171
|
7
|
|
|
|
|
47
|
return @out; |
172
|
|
|
|
|
|
|
} |
173
|
|
|
|
|
|
|
|
174
|
|
|
|
|
|
|
=head2 path |
175
|
|
|
|
|
|
|
|
176
|
|
|
|
|
|
|
Returns list of references from structure. |
177
|
|
|
|
|
|
|
|
178
|
|
|
|
|
|
|
@found = path($structure, $path, %opts) |
179
|
|
|
|
|
|
|
|
180
|
|
|
|
|
|
|
=head3 Options |
181
|
|
|
|
|
|
|
|
182
|
|
|
|
|
|
|
=over 4 |
183
|
|
|
|
|
|
|
|
184
|
|
|
|
|
|
|
=item assign C<< >> |
185
|
|
|
|
|
|
|
|
186
|
|
|
|
|
|
|
Assign provided value to substructures pointed by path. |
187
|
|
|
|
|
|
|
|
188
|
|
|
|
|
|
|
=item delete C<< >> |
189
|
|
|
|
|
|
|
|
190
|
|
|
|
|
|
|
Delete specified by path items from structure. |
191
|
|
|
|
|
|
|
|
192
|
|
|
|
|
|
|
=item deref C<< >> |
193
|
|
|
|
|
|
|
|
194
|
|
|
|
|
|
|
Dereference result items. |
195
|
|
|
|
|
|
|
|
196
|
|
|
|
|
|
|
=item expand C<< >> |
197
|
|
|
|
|
|
|
|
198
|
|
|
|
|
|
|
Expand structure if specified in path items doesn't exist. All newly created |
199
|
|
|
|
|
|
|
items initialized by C. |
200
|
|
|
|
|
|
|
|
201
|
|
|
|
|
|
|
=item paths C<< >> |
202
|
|
|
|
|
|
|
|
203
|
|
|
|
|
|
|
Return path for each result. |
204
|
|
|
|
|
|
|
|
205
|
|
|
|
|
|
|
=item stack C<< >> |
206
|
|
|
|
|
|
|
|
207
|
|
|
|
|
|
|
Return stack of references to substructures. |
208
|
|
|
|
|
|
|
|
209
|
|
|
|
|
|
|
=item strict C<< >> |
210
|
|
|
|
|
|
|
|
211
|
|
|
|
|
|
|
Croak if at least one element, specified by path, absent in the structure. |
212
|
|
|
|
|
|
|
|
213
|
|
|
|
|
|
|
=back |
214
|
|
|
|
|
|
|
|
215
|
|
|
|
|
|
|
All options are disabled (C) by default. |
216
|
|
|
|
|
|
|
|
217
|
|
|
|
|
|
|
=cut |
218
|
|
|
|
|
|
|
|
219
|
|
|
|
|
|
|
sub path($$;@) { |
220
|
73
|
|
|
73
|
1
|
86381
|
my (undef, $path, %opts) = @_; |
221
|
|
|
|
|
|
|
|
222
|
73
|
100
|
|
|
|
378
|
croak "Arrayref expected for path" unless (ref $path eq 'ARRAY'); |
223
|
|
|
|
|
|
|
croak "Unable to remove passed thing entirely (empty path passed)" |
224
|
72
|
100
|
100
|
|
|
196
|
if ($opts{delete} and not @{$path}); |
|
16
|
|
|
|
|
253
|
|
225
|
|
|
|
|
|
|
|
226
|
71
|
|
|
|
|
164
|
my @level = ([], [\$_[0]]); # alias - to be able to rewrite passed scalar |
227
|
71
|
|
|
|
|
108
|
my $sc = 0; # step counter |
228
|
71
|
|
|
|
|
104
|
my ($items, @next, $steps, $refs, $step_type, @types); |
229
|
|
|
|
|
|
|
|
230
|
71
|
|
|
|
|
111
|
for my $step (@{$path}) { |
|
71
|
|
|
|
|
140
|
|
231
|
143
|
|
|
|
|
356
|
while (($steps, $refs) = splice @level, 0, 2) { |
232
|
165
|
100
|
|
|
|
470
|
croak "Reference expected for refs stack entry, step #$sc" |
233
|
|
|
|
|
|
|
unless (ref $refs->[-1]); |
234
|
|
|
|
|
|
|
|
235
|
164
|
100
|
|
|
|
388
|
if (($step_type = ref $step) eq 'ARRAY') { |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
236
|
72
|
100
|
|
|
|
78
|
if (ref ${$refs->[-1]} ne 'ARRAY') { |
|
72
|
|
|
|
|
163
|
|
237
|
2
|
|
|
|
|
288
|
croak "ARRAY expected on step #$sc, got " . ref ${$refs->[-1]} |
238
|
17
|
100
|
|
|
|
39
|
if ($opts{strict}); |
239
|
15
|
100
|
|
|
|
36
|
next unless ($opts{expand}); |
240
|
7
|
|
|
|
|
11
|
${$refs->[-1]} = []; |
|
7
|
|
|
|
|
10
|
|
241
|
|
|
|
|
|
|
} |
242
|
|
|
|
|
|
|
|
243
|
62
|
100
|
|
|
|
81
|
$items = @{$step} ? $step : [0 .. $#${$refs->[-1]}]; |
|
62
|
|
|
|
|
175
|
|
|
11
|
|
|
|
|
26
|
|
244
|
62
|
|
|
|
|
81
|
for (@{$items}) { |
|
62
|
|
|
|
|
101
|
|
245
|
87
|
100
|
100
|
|
|
163
|
unless ( |
|
|
100
|
|
|
|
|
|
246
|
|
|
|
|
|
|
$opts{expand} or |
247
|
73
|
|
|
|
|
76
|
@{${$refs->[-1]}} > ($_ >= 0 ? $_ : abs($_ + 1)) |
|
73
|
|
|
|
|
239
|
|
248
|
|
|
|
|
|
|
) { |
249
|
7
|
100
|
|
|
|
184
|
croak "[$_] doesn't exist, step #$sc" if ($opts{strict}); |
250
|
5
|
|
|
|
|
9
|
next; |
251
|
|
|
|
|
|
|
} |
252
|
|
|
|
|
|
|
|
253
|
80
|
100
|
|
|
|
149
|
if ($_ < 0) { |
254
|
6
|
100
|
|
|
|
9
|
if (@{${$refs->[-1]}} < abs($_)) { |
|
6
|
|
|
|
|
7
|
|
|
6
|
|
|
|
|
20
|
|
255
|
|
|
|
|
|
|
# expand smoothly for out of range negative indexes |
256
|
3
|
|
|
|
|
5
|
$_ = @{${$refs->[-1]}}; |
|
3
|
|
|
|
|
6
|
|
|
3
|
|
|
|
|
8
|
|
257
|
|
|
|
|
|
|
} else { |
258
|
3
|
|
|
|
|
4
|
$_ += @{${$refs->[-1]}}; |
|
3
|
|
|
|
|
3
|
|
|
3
|
|
|
|
|
5
|
|
259
|
|
|
|
|
|
|
} |
260
|
|
|
|
|
|
|
} |
261
|
|
|
|
|
|
|
|
262
|
80
|
|
|
|
|
95
|
push @next, [@{$steps}, [$_]], [@{$refs}, \${$refs->[-1]}->[$_]]; |
|
80
|
|
|
|
|
144
|
|
|
80
|
|
|
|
|
97
|
|
|
80
|
|
|
|
|
189
|
|
263
|
|
|
|
|
|
|
} |
264
|
|
|
|
|
|
|
|
265
|
60
|
100
|
100
|
|
|
185
|
if ($opts{delete} and $sc == $#{$path}) { |
|
16
|
|
|
|
|
51
|
|
266
|
15
|
100
|
|
|
|
18
|
map { splice(@{${$refs->[-1]}}, $_, 1) if ($_ < @{${$refs->[-1]}}) } |
|
13
|
|
|
|
|
17
|
|
|
13
|
|
|
|
|
54
|
|
|
15
|
|
|
|
|
19
|
|
|
15
|
|
|
|
|
34
|
|
267
|
9
|
|
|
|
|
13
|
reverse sort @{$items}; |
|
9
|
|
|
|
|
29
|
|
268
|
|
|
|
|
|
|
} |
269
|
|
|
|
|
|
|
} elsif ($step_type eq 'HASH') { |
270
|
81
|
100
|
|
|
|
93
|
if (ref ${$refs->[-1]} ne 'HASH') { |
|
81
|
|
|
|
|
195
|
|
271
|
2
|
|
|
|
|
221
|
croak "HASH expected on step #$sc, got " . ref ${$refs->[-1]} |
272
|
9
|
100
|
|
|
|
26
|
if ($opts{strict}); |
273
|
7
|
100
|
|
|
|
21
|
next unless ($opts{expand}); |
274
|
4
|
|
|
|
|
7
|
${$refs->[-1]} = {}; |
|
4
|
|
|
|
|
7
|
|
275
|
|
|
|
|
|
|
} |
276
|
|
|
|
|
|
|
|
277
|
76
|
|
|
|
|
134
|
@types = grep { exists $step->{$_} } qw(K R); |
|
152
|
|
|
|
|
353
|
|
278
|
76
|
100
|
|
|
|
103
|
croak "Unsupported HASH definition, step #$sc" if (@types != keys %{$step}); |
|
76
|
|
|
|
|
299
|
|
279
|
75
|
|
|
|
|
121
|
undef $items; |
280
|
|
|
|
|
|
|
|
281
|
75
|
|
|
|
|
122
|
for my $t (@types) { |
282
|
68
|
100
|
|
|
|
164
|
unless (ref $step->{$t} eq 'ARRAY') { |
283
|
2
|
100
|
|
|
|
4
|
my $type = $t eq 'K' ? "keys" : "regs"; |
284
|
2
|
|
|
|
|
160
|
croak "Unsupported HASH $type definition, step #$sc"; |
285
|
|
|
|
|
|
|
} |
286
|
|
|
|
|
|
|
|
287
|
66
|
100
|
|
|
|
118
|
if ($t eq 'K') { |
288
|
58
|
|
|
|
|
72
|
for my $i (@{$step->{K}}) { |
|
58
|
|
|
|
|
100
|
|
289
|
63
|
100
|
|
|
|
104
|
if (ref $i eq 'Regexp') { |
290
|
4
|
|
|
|
|
6
|
push @{$items}, grep { $_ =~ $i } |
|
12
|
|
|
|
|
45
|
|
291
|
4
|
|
|
|
|
5
|
keys %{${$refs->[-1]}}; |
|
4
|
|
|
|
|
4
|
|
|
4
|
|
|
|
|
9
|
|
292
|
|
|
|
|
|
|
} else { |
293
|
59
|
100
|
100
|
|
|
118
|
unless ($opts{expand} or exists ${$refs->[-1]}->{$i}) { |
|
45
|
|
|
|
|
146
|
|
294
|
6
|
100
|
|
|
|
100
|
croak "{$i} doesn't exist, step #$sc" if $opts{strict}; |
295
|
5
|
|
|
|
|
11
|
next; |
296
|
|
|
|
|
|
|
} |
297
|
53
|
|
|
|
|
73
|
push @{$items}, $i; |
|
53
|
|
|
|
|
134
|
|
298
|
|
|
|
|
|
|
} |
299
|
|
|
|
|
|
|
} |
300
|
|
|
|
|
|
|
} else { |
301
|
8
|
|
|
|
|
12
|
for my $g (@{$step->{R}}) { |
|
8
|
|
|
|
|
13
|
|
302
|
9
|
|
|
|
|
13
|
push @{$items}, grep { $_ =~ $g } keys %{${$refs->[-1]}}; |
|
9
|
|
|
|
|
11
|
|
|
23
|
|
|
|
|
95
|
|
|
9
|
|
|
|
|
11
|
|
|
9
|
|
|
|
|
22
|
|
303
|
|
|
|
|
|
|
} |
304
|
|
|
|
|
|
|
} |
305
|
|
|
|
|
|
|
} |
306
|
|
|
|
|
|
|
|
307
|
72
|
100
|
|
|
|
125
|
for (@types ? @{$items} : keys %{${$refs->[-1]}}) { |
|
64
|
|
|
|
|
109
|
|
|
8
|
|
|
|
|
10
|
|
|
8
|
|
|
|
|
19
|
|
308
|
86
|
|
|
|
|
110
|
push @next, [@{$steps}, {K => [$_]}], [@{$refs}, \${$refs->[-1]}->{$_}]; |
|
86
|
|
|
|
|
201
|
|
|
86
|
|
|
|
|
111
|
|
|
86
|
|
|
|
|
167
|
|
309
|
86
|
100
|
100
|
|
|
289
|
delete ${$refs->[-1]}->{$_} if ($opts{delete} and $sc == $#{$path}); |
|
8
|
|
|
|
|
35
|
|
|
24
|
|
|
|
|
104
|
|
310
|
|
|
|
|
|
|
} |
311
|
|
|
|
|
|
|
} elsif ($step_type eq 'CODE') { |
312
|
10
|
|
|
|
|
11
|
local $_ = ${$refs->[-1]}; |
|
10
|
|
|
|
|
13
|
|
313
|
10
|
|
|
|
|
19
|
local $_{opts} = \%opts; |
314
|
10
|
100
|
|
|
|
17
|
$step->($steps, $refs) and push @next, $steps, $refs; |
315
|
|
|
|
|
|
|
} else { |
316
|
1
|
|
|
|
|
85
|
croak "Unsupported thing in the path, step #$sc"; |
317
|
|
|
|
|
|
|
} |
318
|
|
|
|
|
|
|
} |
319
|
|
|
|
|
|
|
|
320
|
131
|
|
|
|
|
275
|
@level = splice @next; |
321
|
131
|
|
|
|
|
208
|
$sc++; |
322
|
|
|
|
|
|
|
} |
323
|
|
|
|
|
|
|
|
324
|
59
|
|
|
|
|
76
|
my @out; |
325
|
59
|
|
|
|
|
140
|
while (($path, $refs) = splice @level, 0, 2) { |
326
|
79
|
100
|
|
|
|
169
|
${$refs->[-1]} = $opts{assign} if (exists $opts{assign}); |
|
7
|
|
|
|
|
16
|
|
327
|
|
|
|
|
|
|
|
328
|
79
|
100
|
|
|
|
164
|
if ($opts{stack}) { |
329
|
2
|
100
|
|
|
|
6
|
map { $_ = ${$_} } @{$refs} if ($opts{deref}); |
|
4
|
|
|
|
|
5
|
|
|
4
|
|
|
|
|
6
|
|
|
1
|
|
|
|
|
2
|
|
330
|
|
|
|
|
|
|
} else { |
331
|
77
|
100
|
|
|
|
121
|
$refs = $opts{deref} ? ${pop @{$refs}} : pop @{$refs}; |
|
5
|
|
|
|
|
5
|
|
|
5
|
|
|
|
|
9
|
|
|
72
|
|
|
|
|
114
|
|
332
|
|
|
|
|
|
|
} |
333
|
|
|
|
|
|
|
|
334
|
79
|
100
|
|
|
|
256
|
push @out, ($opts{paths} ? ($path, $refs) : $refs); |
335
|
|
|
|
|
|
|
} |
336
|
|
|
|
|
|
|
|
337
|
59
|
|
|
|
|
225
|
return @out; |
338
|
|
|
|
|
|
|
} |
339
|
|
|
|
|
|
|
|
340
|
|
|
|
|
|
|
=head2 path_delta |
341
|
|
|
|
|
|
|
|
342
|
|
|
|
|
|
|
Returns delta for two passed paths. By delta means list of steps from the |
343
|
|
|
|
|
|
|
second path without beginning common steps for both. |
344
|
|
|
|
|
|
|
|
345
|
|
|
|
|
|
|
@delta = path_delta($path1, $path2) |
346
|
|
|
|
|
|
|
|
347
|
|
|
|
|
|
|
=cut |
348
|
|
|
|
|
|
|
|
349
|
|
|
|
|
|
|
sub path_delta($$) { |
350
|
16
|
|
|
16
|
1
|
14205
|
my ($frst, $scnd) = @_; |
351
|
|
|
|
|
|
|
|
352
|
16
|
100
|
|
|
|
169
|
croak "Second path must be an arrayref" unless (ref $scnd eq 'ARRAY'); |
353
|
15
|
100
|
|
|
|
32
|
return @{$scnd} unless (defined $frst); |
|
1
|
|
|
|
|
4
|
|
354
|
14
|
100
|
|
|
|
144
|
croak "First path may be undef or an arrayref" unless (ref $frst eq 'ARRAY'); |
355
|
|
|
|
|
|
|
|
356
|
13
|
|
|
|
|
69
|
require B::Deparse; |
357
|
13
|
|
|
|
|
246
|
my $deparse = B::Deparse->new(); |
358
|
13
|
|
|
|
|
23
|
my $i = 0; |
359
|
|
|
|
|
|
|
|
360
|
|
|
|
|
|
|
MAIN: |
361
|
13
|
|
100
|
|
|
22
|
while ($i < @{$frst} and ref $frst->[$i] eq ref $scnd->[$i]) { |
|
35
|
|
|
|
|
145
|
|
362
|
31
|
100
|
|
|
|
81
|
if (ref $frst->[$i] eq 'ARRAY') { |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
363
|
10
|
100
|
|
|
|
42
|
last unless (@{$frst->[$i]} == @{$scnd->[$i]}); |
|
10
|
|
|
|
|
18
|
|
|
10
|
|
|
|
|
22
|
|
364
|
8
|
|
|
|
|
10
|
for (0 .. $#{$frst->[$i]}) { |
|
8
|
|
|
|
|
35
|
|
365
|
15
|
100
|
|
|
|
35
|
last MAIN unless ($frst->[$i]->[$_] == $scnd->[$i]->[$_]); |
366
|
|
|
|
|
|
|
} |
367
|
|
|
|
|
|
|
} elsif (ref $frst->[$i] eq 'HASH') { |
368
|
18
|
100
|
|
|
|
21
|
last unless (@{$frst->[$i]->{K}} == @{$scnd->[$i]->{K}}); |
|
18
|
|
|
|
|
30
|
|
|
18
|
|
|
|
|
35
|
|
369
|
16
|
|
|
|
|
21
|
for (0 .. $#{$frst->[$i]->{K}}) { |
|
16
|
|
|
|
|
45
|
|
370
|
|
|
|
|
|
|
last MAIN unless ( |
371
|
|
|
|
|
|
|
$frst->[$i]->{K}->[$_] eq |
372
|
21
|
100
|
|
|
|
57
|
$scnd->[$i]->{K}->[$_] |
373
|
|
|
|
|
|
|
); |
374
|
|
|
|
|
|
|
} |
375
|
|
|
|
|
|
|
} elsif (ref $frst->[$i] eq 'CODE') { |
376
|
|
|
|
|
|
|
last unless ( |
377
|
2
|
100
|
|
|
|
2218
|
$deparse->coderef2text($frst->[$i]) eq |
378
|
|
|
|
|
|
|
$deparse->coderef2text($scnd->[$i]) |
379
|
|
|
|
|
|
|
); |
380
|
|
|
|
|
|
|
} else { |
381
|
1
|
|
|
|
|
179
|
croak "Unsupported thing in the path, step #$i"; |
382
|
|
|
|
|
|
|
} |
383
|
|
|
|
|
|
|
|
384
|
22
|
|
|
|
|
34
|
$i++; |
385
|
|
|
|
|
|
|
} |
386
|
|
|
|
|
|
|
|
387
|
12
|
|
|
|
|
27
|
return @{$scnd}[$i .. $#{$scnd}]; |
|
12
|
|
|
|
|
84
|
|
|
12
|
|
|
|
|
19
|
|
388
|
|
|
|
|
|
|
} |
389
|
|
|
|
|
|
|
|
390
|
|
|
|
|
|
|
=head1 LIMITATIONS |
391
|
|
|
|
|
|
|
|
392
|
|
|
|
|
|
|
Struct::Path will fail on structures with loops in references. |
393
|
|
|
|
|
|
|
|
394
|
|
|
|
|
|
|
No object oriented interface provided. |
395
|
|
|
|
|
|
|
|
396
|
|
|
|
|
|
|
=head1 AUTHOR |
397
|
|
|
|
|
|
|
|
398
|
|
|
|
|
|
|
Michael Samoglyadov, C<< >> |
399
|
|
|
|
|
|
|
|
400
|
|
|
|
|
|
|
=head1 BUGS |
401
|
|
|
|
|
|
|
|
402
|
|
|
|
|
|
|
Please report any bugs or feature requests to C, |
403
|
|
|
|
|
|
|
or through the web interface at |
404
|
|
|
|
|
|
|
L. I will be |
405
|
|
|
|
|
|
|
notified, and then you'll automatically be notified of progress on your bug |
406
|
|
|
|
|
|
|
as I make changes. |
407
|
|
|
|
|
|
|
|
408
|
|
|
|
|
|
|
=head1 SUPPORT |
409
|
|
|
|
|
|
|
|
410
|
|
|
|
|
|
|
You can find documentation for this module with the perldoc command. |
411
|
|
|
|
|
|
|
|
412
|
|
|
|
|
|
|
perldoc Struct::Path |
413
|
|
|
|
|
|
|
|
414
|
|
|
|
|
|
|
You can also look for information at: |
415
|
|
|
|
|
|
|
|
416
|
|
|
|
|
|
|
=over 4 |
417
|
|
|
|
|
|
|
|
418
|
|
|
|
|
|
|
=item * RT: CPAN's request tracker (report bugs here) |
419
|
|
|
|
|
|
|
|
420
|
|
|
|
|
|
|
L |
421
|
|
|
|
|
|
|
|
422
|
|
|
|
|
|
|
=item * AnnoCPAN: Annotated CPAN documentation |
423
|
|
|
|
|
|
|
|
424
|
|
|
|
|
|
|
L |
425
|
|
|
|
|
|
|
|
426
|
|
|
|
|
|
|
=item * CPAN Ratings |
427
|
|
|
|
|
|
|
|
428
|
|
|
|
|
|
|
L |
429
|
|
|
|
|
|
|
|
430
|
|
|
|
|
|
|
=item * Search CPAN |
431
|
|
|
|
|
|
|
|
432
|
|
|
|
|
|
|
L |
433
|
|
|
|
|
|
|
|
434
|
|
|
|
|
|
|
=back |
435
|
|
|
|
|
|
|
|
436
|
|
|
|
|
|
|
=head1 SEE ALSO |
437
|
|
|
|
|
|
|
|
438
|
|
|
|
|
|
|
L L L L L |
439
|
|
|
|
|
|
|
L L L L L |
440
|
|
|
|
|
|
|
L L L |
441
|
|
|
|
|
|
|
|
442
|
|
|
|
|
|
|
L L L |
443
|
|
|
|
|
|
|
|
444
|
|
|
|
|
|
|
=head1 LICENSE AND COPYRIGHT |
445
|
|
|
|
|
|
|
|
446
|
|
|
|
|
|
|
Copyright 2016-2018 Michael Samoglyadov. |
447
|
|
|
|
|
|
|
|
448
|
|
|
|
|
|
|
This program is free software; you can redistribute it and/or modify it |
449
|
|
|
|
|
|
|
under the terms of either: the GNU General Public License as published |
450
|
|
|
|
|
|
|
by the Free Software Foundation; or the Artistic License. |
451
|
|
|
|
|
|
|
|
452
|
|
|
|
|
|
|
See L for more information. |
453
|
|
|
|
|
|
|
|
454
|
|
|
|
|
|
|
=cut |
455
|
|
|
|
|
|
|
|
456
|
|
|
|
|
|
|
1; # End of Struct::Path |