| line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
|
1
|
|
|
|
|
|
|
package Data::Edit::Struct; |
|
2
|
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
# ABSTRACT: Edit a Perl structure addressed with a Data::DPath path |
|
4
|
|
|
|
|
|
|
|
|
5
|
11
|
|
|
11
|
|
2295500
|
use strict; |
|
|
11
|
|
|
|
|
74
|
|
|
|
11
|
|
|
|
|
314
|
|
|
6
|
11
|
|
|
11
|
|
57
|
use warnings; |
|
|
11
|
|
|
|
|
22
|
|
|
|
11
|
|
|
|
|
285
|
|
|
7
|
|
|
|
|
|
|
|
|
8
|
11
|
|
|
11
|
|
53
|
use Exporter 'import'; |
|
|
11
|
|
|
|
|
22
|
|
|
|
11
|
|
|
|
|
486
|
|
|
9
|
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
our $VERSION = '0.07'; |
|
11
|
|
|
|
|
|
|
|
|
12
|
11
|
|
|
|
|
1022
|
use Ref::Util qw[ |
|
13
|
|
|
|
|
|
|
is_plain_arrayref is_arrayref |
|
14
|
|
|
|
|
|
|
is_plain_hashref is_hashref |
|
15
|
|
|
|
|
|
|
is_scalarref is_ref is_coderef |
|
16
|
11
|
|
|
11
|
|
4522
|
]; |
|
|
11
|
|
|
|
|
15720
|
|
|
17
|
|
|
|
|
|
|
|
|
18
|
11
|
|
|
11
|
|
5859
|
use Types::Standard -types; |
|
|
11
|
|
|
|
|
787312
|
|
|
|
11
|
|
|
|
|
113
|
|
|
19
|
11
|
|
|
11
|
|
56130
|
use Data::Edit::Struct::Types -types; |
|
|
11
|
|
|
|
|
41
|
|
|
|
11
|
|
|
|
|
96
|
|
|
20
|
|
|
|
|
|
|
|
|
21
|
11
|
|
|
|
|
115
|
use custom::failures 'Data::Edit::Struct::failure' => [ qw{ |
|
22
|
|
|
|
|
|
|
input::dest |
|
23
|
|
|
|
|
|
|
input::src |
|
24
|
|
|
|
|
|
|
input::param |
|
25
|
|
|
|
|
|
|
internal |
|
26
|
11
|
|
|
11
|
|
12492
|
} ]; |
|
|
11
|
|
|
|
|
54442
|
|
|
27
|
|
|
|
|
|
|
|
|
28
|
11
|
|
|
11
|
|
4342
|
use List::Util qw[ pairmap ]; |
|
|
11
|
|
|
|
|
29
|
|
|
|
11
|
|
|
|
|
735
|
|
|
29
|
11
|
|
|
11
|
|
72
|
use Scalar::Util qw[ refaddr ]; |
|
|
11
|
|
|
|
|
24
|
|
|
|
11
|
|
|
|
|
485
|
|
|
30
|
11
|
|
|
11
|
|
4953
|
use Params::ValidationCompiler qw[ validation_for ]; |
|
|
11
|
|
|
|
|
116777
|
|
|
|
11
|
|
|
|
|
660
|
|
|
31
|
11
|
|
|
11
|
|
4837
|
use Safe::Isa; |
|
|
11
|
|
|
|
|
5040
|
|
|
|
11
|
|
|
|
|
1485
|
|
|
32
|
|
|
|
|
|
|
|
|
33
|
11
|
|
|
11
|
|
88
|
use Data::DPath qw[ dpath dpathr dpathi ]; |
|
|
11
|
|
|
|
|
155
|
|
|
|
11
|
|
|
|
|
104
|
|
|
34
|
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
## no critic(ProhibitSubroutinePrototypes) |
|
36
|
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
# uncomment to run coverage tests, as Safe compartment makes |
|
38
|
|
|
|
|
|
|
# Devel::Cover whimper |
|
39
|
|
|
|
|
|
|
# |
|
40
|
|
|
|
|
|
|
# $Data::DPath::USE_SAFE = 0; |
|
41
|
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
our @EXPORT_OK = qw[ edit ]; |
|
43
|
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
#--------------------------------------------------------------------- |
|
45
|
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
# Params::ValidationCompiler is used to validate the arguments passed |
|
47
|
|
|
|
|
|
|
# to the edit subroutine. These hashes are used to codify validation |
|
48
|
|
|
|
|
|
|
# specifications which are used multiple times. |
|
49
|
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
my %dest = ( |
|
51
|
|
|
|
|
|
|
dest => { type => Context }, |
|
52
|
|
|
|
|
|
|
dpath => { type => Str, default => '/' }, |
|
53
|
|
|
|
|
|
|
); |
|
54
|
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
my %dtype = ( dtype => { type => UseDataAs, default => 'auto' }, ); |
|
56
|
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
my %source = ( |
|
58
|
|
|
|
|
|
|
src => { type => Any, optional => 1 }, |
|
59
|
|
|
|
|
|
|
spath => { type => Str, optional => 1 }, |
|
60
|
|
|
|
|
|
|
stype => { type => UseDataAs, default => 'auto' }, |
|
61
|
|
|
|
|
|
|
sxfrm => { |
|
62
|
|
|
|
|
|
|
# ( Enum [] ) | CoderRef rather than Enum[] | CodeRef for |
|
63
|
|
|
|
|
|
|
# Perl < 5.14 |
|
64
|
|
|
|
|
|
|
type => ( Enum [ 'iterate', 'array', 'hash', 'error' ] ) | CodeRef, |
|
65
|
|
|
|
|
|
|
default => 'error' |
|
66
|
|
|
|
|
|
|
}, |
|
67
|
|
|
|
|
|
|
sxfrm_args => { |
|
68
|
|
|
|
|
|
|
type => HashRef, |
|
69
|
|
|
|
|
|
|
default => sub { {} }, |
|
70
|
|
|
|
|
|
|
}, |
|
71
|
|
|
|
|
|
|
clone => { |
|
72
|
|
|
|
|
|
|
type => Bool | CodeRef, |
|
73
|
|
|
|
|
|
|
default => 0 |
|
74
|
|
|
|
|
|
|
}, |
|
75
|
|
|
|
|
|
|
); |
|
76
|
|
|
|
|
|
|
|
|
77
|
|
|
|
|
|
|
my %length = ( length => { type => Int, default => 1 } ); |
|
78
|
|
|
|
|
|
|
my %offset = ( |
|
79
|
|
|
|
|
|
|
offset => { |
|
80
|
|
|
|
|
|
|
type => Int, |
|
81
|
|
|
|
|
|
|
default => 0, |
|
82
|
|
|
|
|
|
|
} ); |
|
83
|
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
# %Validation is a dispatch table for validation specifications for |
|
85
|
|
|
|
|
|
|
# the available edit actions. It is used below to create separate |
|
86
|
|
|
|
|
|
|
# validation routines for them. |
|
87
|
|
|
|
|
|
|
my %Validation = ( |
|
88
|
|
|
|
|
|
|
pop => { %dest, %length }, |
|
89
|
|
|
|
|
|
|
shift => { %dest, %length }, |
|
90
|
|
|
|
|
|
|
splice => { %dest, %length, %offset, %source, %dtype }, |
|
91
|
|
|
|
|
|
|
insert => { |
|
92
|
|
|
|
|
|
|
%dest, %length, %offset, %source, %dtype, |
|
93
|
|
|
|
|
|
|
insert => { |
|
94
|
|
|
|
|
|
|
type => Enum [ 'before', 'after' ], |
|
95
|
|
|
|
|
|
|
default => 'before', |
|
96
|
|
|
|
|
|
|
}, |
|
97
|
|
|
|
|
|
|
anchor => |
|
98
|
|
|
|
|
|
|
{ type => Enum [ 'first', 'last', 'index' ], default => 'first' }, |
|
99
|
|
|
|
|
|
|
pad => { type => Any, default => undef }, |
|
100
|
|
|
|
|
|
|
}, |
|
101
|
|
|
|
|
|
|
delete => { %dest, %length }, |
|
102
|
|
|
|
|
|
|
replace => { |
|
103
|
|
|
|
|
|
|
%dest, %source, |
|
104
|
|
|
|
|
|
|
replace => { |
|
105
|
|
|
|
|
|
|
type => Enum [ 'value', 'key', 'auto' ], |
|
106
|
|
|
|
|
|
|
default => 'auto', |
|
107
|
|
|
|
|
|
|
}, |
|
108
|
|
|
|
|
|
|
}, |
|
109
|
|
|
|
|
|
|
transform => { |
|
110
|
|
|
|
|
|
|
%dest, |
|
111
|
|
|
|
|
|
|
callback => { |
|
112
|
|
|
|
|
|
|
type => CodeRef |
|
113
|
|
|
|
|
|
|
}, |
|
114
|
|
|
|
|
|
|
callback_data => { type => Any, default => undef } |
|
115
|
|
|
|
|
|
|
}, |
|
116
|
|
|
|
|
|
|
); |
|
117
|
|
|
|
|
|
|
|
|
118
|
|
|
|
|
|
|
# %Validator contains the validation routines, keyed off of the edit actions. |
|
119
|
|
|
|
|
|
|
my %Validator = map { |
|
120
|
|
|
|
|
|
|
$_ => validation_for( |
|
121
|
|
|
|
|
|
|
params => $Validation{$_}, |
|
122
|
|
|
|
|
|
|
name => $_, |
|
123
|
|
|
|
|
|
|
name_is_optional => 1, |
|
124
|
|
|
|
|
|
|
) |
|
125
|
|
|
|
|
|
|
} |
|
126
|
|
|
|
|
|
|
keys %Validation; |
|
127
|
|
|
|
|
|
|
|
|
128
|
|
|
|
|
|
|
#--------------------------------------------------------------------- |
|
129
|
|
|
|
|
|
|
|
|
130
|
|
|
|
|
|
|
# the primary entry point. |
|
131
|
|
|
|
|
|
|
sub edit { |
|
132
|
|
|
|
|
|
|
|
|
133
|
139
|
|
|
139
|
1
|
321516
|
my ( $action, $params ) = @_; |
|
134
|
|
|
|
|
|
|
|
|
135
|
139
|
100
|
|
|
|
439
|
Data::Edit::Struct::failure::input::param->throw( "no action specified\n" ) |
|
136
|
|
|
|
|
|
|
unless defined $action; |
|
137
|
|
|
|
|
|
|
|
|
138
|
138
|
100
|
|
|
|
393
|
defined( my $validator = $Validator{$action} ) |
|
139
|
|
|
|
|
|
|
or Data::Edit::Struct::failure::input::param->throw( |
|
140
|
|
|
|
|
|
|
"unknown acton: $action\n" ); |
|
141
|
|
|
|
|
|
|
|
|
142
|
137
|
|
|
|
|
3760
|
my %arg = $validator->( %$params ); |
|
143
|
|
|
|
|
|
|
|
|
144
|
137
|
|
|
|
|
36660
|
my $src = _sxfrm( @arg{qw[ src spath sxfrm sxfrm_args ]} ); |
|
145
|
|
|
|
|
|
|
|
|
146
|
|
|
|
|
|
|
my $points |
|
147
|
135
|
|
|
|
|
1016
|
= _dup_context( $arg{dest} )->_search( dpathr( $arg{dpath} ) ) |
|
148
|
|
|
|
|
|
|
->current_points; |
|
149
|
|
|
|
|
|
|
|
|
150
|
135
|
100
|
|
|
|
30215
|
if ( $action eq 'pop' ) { |
|
|
|
100
|
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
151
|
4
|
|
|
|
|
13
|
_pop( $points, $arg{length} ); |
|
152
|
|
|
|
|
|
|
} |
|
153
|
|
|
|
|
|
|
|
|
154
|
|
|
|
|
|
|
elsif ( $action eq 'shift' ) { |
|
155
|
4
|
|
|
|
|
13
|
_shift( $points, $arg{length} ); |
|
156
|
|
|
|
|
|
|
} |
|
157
|
|
|
|
|
|
|
|
|
158
|
|
|
|
|
|
|
elsif ( $action eq 'splice' ) { |
|
159
|
|
|
|
|
|
|
|
|
160
|
28
|
100
|
|
|
|
84
|
$src = [ \[] ] if !defined $src; |
|
161
|
|
|
|
|
|
|
|
|
162
|
|
|
|
|
|
|
_splice( $arg{dtype}, $points, $arg{offset}, $arg{length}, |
|
163
|
|
|
|
|
|
|
_deref( $_, $arg{stype}, $arg{clone} ) ) |
|
164
|
28
|
|
|
|
|
107
|
foreach @$src; |
|
165
|
|
|
|
|
|
|
} |
|
166
|
|
|
|
|
|
|
|
|
167
|
|
|
|
|
|
|
elsif ( $action eq 'insert' ) { |
|
168
|
82
|
100
|
|
|
|
229
|
Data::Edit::Struct::failure::input::src->throw( |
|
169
|
|
|
|
|
|
|
"source was not specified" ) |
|
170
|
|
|
|
|
|
|
if !defined $src; |
|
171
|
|
|
|
|
|
|
|
|
172
|
|
|
|
|
|
|
_insert( $arg{dtype}, $points, $arg{insert}, $arg{anchor}, |
|
173
|
|
|
|
|
|
|
$arg{pad}, $arg{offset}, _deref( $_, $arg{stype}, $arg{clone} ) ) |
|
174
|
81
|
|
|
|
|
330
|
foreach @$src; |
|
175
|
|
|
|
|
|
|
} |
|
176
|
|
|
|
|
|
|
|
|
177
|
|
|
|
|
|
|
elsif ( $action eq 'delete' ) { |
|
178
|
4
|
|
|
|
|
14
|
_delete( $points, $arg{length} ); |
|
179
|
|
|
|
|
|
|
} |
|
180
|
|
|
|
|
|
|
|
|
181
|
|
|
|
|
|
|
elsif ( $action eq 'transform' ) { |
|
182
|
3
|
|
|
|
|
8
|
_transform( $points, $arg{callback}, $arg{callback_data} ); |
|
183
|
|
|
|
|
|
|
} |
|
184
|
|
|
|
|
|
|
|
|
185
|
|
|
|
|
|
|
elsif ( $action eq 'replace' ) { |
|
186
|
|
|
|
|
|
|
|
|
187
|
10
|
100
|
|
|
|
62
|
Data::Edit::Struct::failure::input::src->throw( |
|
188
|
|
|
|
|
|
|
"source was not specified" ) |
|
189
|
|
|
|
|
|
|
if !defined $src; |
|
190
|
|
|
|
|
|
|
|
|
191
|
9
|
100
|
|
|
|
43
|
Data::Edit::Struct::failure::input::src->throw( |
|
192
|
|
|
|
|
|
|
"source path may not have multiple resolutions" ) |
|
193
|
|
|
|
|
|
|
if @$src > 1; |
|
194
|
|
|
|
|
|
|
|
|
195
|
8
|
|
|
|
|
29
|
_replace( $points, $arg{replace}, $src->[0] ); |
|
196
|
|
|
|
|
|
|
} |
|
197
|
|
|
|
|
|
|
|
|
198
|
|
|
|
|
|
|
else { |
|
199
|
0
|
|
|
|
|
0
|
Data::Edit::Struct::failure::internal->throw( |
|
200
|
|
|
|
|
|
|
"unexpected action: $action" ); |
|
201
|
|
|
|
|
|
|
} |
|
202
|
|
|
|
|
|
|
} |
|
203
|
|
|
|
|
|
|
|
|
204
|
|
|
|
|
|
|
#--------------------------------------------------------------------- |
|
205
|
|
|
|
|
|
|
|
|
206
|
|
|
|
|
|
|
# Searching a Data::DPath::Context object changes it, rather than |
|
207
|
|
|
|
|
|
|
# returning a new context as documented. Thus, we need to create |
|
208
|
|
|
|
|
|
|
# a new object for each search. |
|
209
|
|
|
|
|
|
|
# |
|
210
|
|
|
|
|
|
|
# See https://rt.cpan.org/Public/Bug/Display.html?id=120594 |
|
211
|
|
|
|
|
|
|
|
|
212
|
|
|
|
|
|
|
sub _dup_context { |
|
213
|
|
|
|
|
|
|
|
|
214
|
135
|
|
|
135
|
|
254
|
my ( $context ) = @_; |
|
215
|
|
|
|
|
|
|
|
|
216
|
135
|
|
|
|
|
750
|
Data::DPath::Context->new( give_references => 1 ) |
|
217
|
|
|
|
|
|
|
->current_points( $context->current_points ); |
|
218
|
|
|
|
|
|
|
} |
|
219
|
|
|
|
|
|
|
|
|
220
|
|
|
|
|
|
|
#--------------------------------------------------------------------- |
|
221
|
|
|
|
|
|
|
|
|
222
|
|
|
|
|
|
|
# extract source data from the source structure given a Data::Dpath |
|
223
|
|
|
|
|
|
|
# path or context and apply any user specified transforms to it. |
|
224
|
|
|
|
|
|
|
sub _sxfrm { |
|
225
|
|
|
|
|
|
|
|
|
226
|
137
|
|
|
137
|
|
379
|
my ( $src, $spath, $sxfrm, $args ) = @_; |
|
227
|
|
|
|
|
|
|
|
|
228
|
137
|
100
|
|
|
|
382
|
return unless defined $src; |
|
229
|
|
|
|
|
|
|
|
|
230
|
106
|
|
|
|
|
166
|
my $ctx; |
|
231
|
|
|
|
|
|
|
|
|
232
|
106
|
50
|
|
|
|
330
|
if ( $src->$_isa( 'Data::DPath::Context' ) ) { |
|
233
|
0
|
|
|
|
|
0
|
$ctx = _dup_context( $src ); |
|
234
|
|
|
|
|
|
|
} |
|
235
|
|
|
|
|
|
|
else { |
|
236
|
106
|
100
|
|
|
|
1091
|
if ( !defined $spath ) { |
|
237
|
|
|
|
|
|
|
|
|
238
|
92
|
100
|
100
|
|
|
269
|
if ( is_plain_arrayref( $src ) |
|
239
|
|
|
|
|
|
|
|| is_plain_hashref( $src ) ) |
|
240
|
|
|
|
|
|
|
{ |
|
241
|
86
|
|
|
|
|
146
|
$spath = '/'; |
|
242
|
|
|
|
|
|
|
} |
|
243
|
|
|
|
|
|
|
|
|
244
|
|
|
|
|
|
|
else { |
|
245
|
6
|
|
|
|
|
14
|
$src = [$src]; |
|
246
|
6
|
|
|
|
|
14
|
$spath = '/*[0]'; |
|
247
|
|
|
|
|
|
|
} |
|
248
|
|
|
|
|
|
|
} |
|
249
|
|
|
|
|
|
|
|
|
250
|
106
|
|
|
|
|
260
|
$ctx = dpathi( $src ); |
|
251
|
106
|
|
|
|
|
213560
|
$ctx->give_references( 1 ); |
|
252
|
|
|
|
|
|
|
} |
|
253
|
|
|
|
|
|
|
|
|
254
|
106
|
|
|
|
|
2466
|
$spath = dpath( $spath ); |
|
255
|
|
|
|
|
|
|
|
|
256
|
106
|
100
|
|
|
|
15107
|
if ( is_coderef( $sxfrm ) ) { |
|
|
|
100
|
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
257
|
1
|
|
|
|
|
4
|
return $sxfrm->( $ctx, $spath, $args ); |
|
258
|
|
|
|
|
|
|
} |
|
259
|
|
|
|
|
|
|
|
|
260
|
|
|
|
|
|
|
elsif ( $sxfrm eq 'array' ) { |
|
261
|
3
|
|
|
|
|
10
|
$ctx->give_references( 0 ); |
|
262
|
3
|
|
|
|
|
11
|
return [ \$ctx->matchr( $spath ) ]; |
|
263
|
|
|
|
|
|
|
} |
|
264
|
|
|
|
|
|
|
|
|
265
|
|
|
|
|
|
|
elsif ( $sxfrm eq 'hash' ) { |
|
266
|
|
|
|
|
|
|
|
|
267
|
5
|
|
|
|
|
10
|
my %src; |
|
268
|
|
|
|
|
|
|
|
|
269
|
5
|
100
|
|
|
|
13
|
if ( exists $args->{key} ) { |
|
270
|
|
|
|
|
|
|
|
|
271
|
1
|
|
|
|
|
4
|
my $src = $ctx->matchr( $spath ); |
|
272
|
1
|
50
|
|
|
|
128
|
Data::Edit::Struct::failure::input::src->throw( |
|
273
|
|
|
|
|
|
|
"source path may not have multiple resolutions\n" ) |
|
274
|
|
|
|
|
|
|
if @$src > 1; |
|
275
|
1
|
|
|
|
|
4
|
$src{ $args->{key} } = ${ $src->[0] }; |
|
|
1
|
|
|
|
|
6
|
|
|
276
|
|
|
|
|
|
|
} |
|
277
|
|
|
|
|
|
|
|
|
278
|
|
|
|
|
|
|
else { |
|
279
|
|
|
|
|
|
|
|
|
280
|
4
|
|
|
|
|
11
|
$ctx->give_references( 0 ); |
|
281
|
4
|
|
|
|
|
8
|
for my $point ( @{ $ctx->_search( $spath )->current_points } ) { |
|
|
4
|
|
|
|
|
13
|
|
|
282
|
|
|
|
|
|
|
|
|
283
|
7
|
|
|
|
|
6119
|
my $attrs = $point->attrs; |
|
284
|
|
|
|
|
|
|
defined( |
|
285
|
|
|
|
|
|
|
my $key |
|
286
|
|
|
|
|
|
|
= defined $attrs->{key} |
|
287
|
|
|
|
|
|
|
? $attrs->{key} |
|
288
|
|
|
|
|
|
|
: $attrs->{idx} ) |
|
289
|
7
|
100
|
|
|
|
37
|
or Data::Edit::Struct::failure::input::src->throw( |
|
|
|
100
|
|
|
|
|
|
|
290
|
|
|
|
|
|
|
"source path returned multiple values; unable to convert into hash as element has no `key' or `idx' attribute\n" |
|
291
|
|
|
|
|
|
|
); |
|
292
|
6
|
|
|
|
|
9
|
$src{$key} = ${ $point->ref }; |
|
|
6
|
|
|
|
|
20
|
|
|
293
|
|
|
|
|
|
|
} |
|
294
|
|
|
|
|
|
|
} |
|
295
|
|
|
|
|
|
|
|
|
296
|
4
|
|
|
|
|
41
|
return [ \\%src ]; |
|
297
|
|
|
|
|
|
|
} |
|
298
|
|
|
|
|
|
|
|
|
299
|
|
|
|
|
|
|
elsif ( $sxfrm eq 'iterate' ) { |
|
300
|
|
|
|
|
|
|
|
|
301
|
1
|
|
|
|
|
4
|
return $ctx->matchr( $spath ); |
|
302
|
|
|
|
|
|
|
|
|
303
|
|
|
|
|
|
|
} |
|
304
|
|
|
|
|
|
|
|
|
305
|
|
|
|
|
|
|
else { |
|
306
|
|
|
|
|
|
|
|
|
307
|
96
|
|
|
|
|
310
|
my $src = $ctx->matchr( $spath ); |
|
308
|
96
|
100
|
|
|
|
5653
|
Data::Edit::Struct::failure::input::src->throw( |
|
309
|
|
|
|
|
|
|
"source path may not have multiple resolutions\n" ) |
|
310
|
|
|
|
|
|
|
if @$src > 1; |
|
311
|
|
|
|
|
|
|
|
|
312
|
95
|
|
|
|
|
448
|
return $src; |
|
313
|
|
|
|
|
|
|
} |
|
314
|
|
|
|
|
|
|
} |
|
315
|
|
|
|
|
|
|
|
|
316
|
|
|
|
|
|
|
#--------------------------------------------------------------------- |
|
317
|
|
|
|
|
|
|
|
|
318
|
|
|
|
|
|
|
# The default cloning algorithm |
|
319
|
|
|
|
|
|
|
sub _clone { |
|
320
|
|
|
|
|
|
|
|
|
321
|
1
|
|
|
1
|
|
3
|
my ( $ref ) = @_; |
|
322
|
|
|
|
|
|
|
|
|
323
|
1
|
|
|
|
|
7
|
require Storable; |
|
324
|
1
|
|
|
|
|
98
|
return Storable::dclone( $ref ); |
|
325
|
|
|
|
|
|
|
} |
|
326
|
|
|
|
|
|
|
|
|
327
|
|
|
|
|
|
|
#--------------------------------------------------------------------- |
|
328
|
|
|
|
|
|
|
|
|
329
|
|
|
|
|
|
|
# given a reference to the extracted source data, massage |
|
330
|
|
|
|
|
|
|
# it into the final form (e.g., container, element, cloned ) |
|
331
|
|
|
|
|
|
|
# to be applied to the destination. |
|
332
|
|
|
|
|
|
|
|
|
333
|
|
|
|
|
|
|
sub _deref { |
|
334
|
|
|
|
|
|
|
|
|
335
|
109
|
|
|
109
|
|
255
|
my ( $ref, $stype, $clone ) = @_; |
|
336
|
|
|
|
|
|
|
|
|
337
|
109
|
100
|
100
|
|
|
404
|
$stype = is_plain_arrayref( $$ref ) |
|
|
|
100
|
|
|
|
|
|
|
338
|
|
|
|
|
|
|
|| is_plain_hashref( $$ref ) ? 'container' : 'element' |
|
339
|
|
|
|
|
|
|
if $stype eq 'auto'; |
|
340
|
|
|
|
|
|
|
|
|
341
|
109
|
|
|
|
|
172
|
my $struct; |
|
342
|
109
|
100
|
|
|
|
248
|
if ( $stype eq 'element' ) { |
|
|
|
50
|
|
|
|
|
|
|
343
|
12
|
|
|
|
|
31
|
$struct = [$$ref]; |
|
344
|
|
|
|
|
|
|
} |
|
345
|
|
|
|
|
|
|
|
|
346
|
|
|
|
|
|
|
elsif ( $stype eq 'container' ) { |
|
347
|
|
|
|
|
|
|
|
|
348
|
97
|
50
|
|
|
|
218
|
$struct |
|
|
|
100
|
|
|
|
|
|
|
349
|
|
|
|
|
|
|
= is_arrayref( $$ref ) ? $$ref |
|
350
|
|
|
|
|
|
|
: is_hashref( $$ref ) ? [%$$ref] |
|
351
|
|
|
|
|
|
|
: Data::Edit::Struct::failure::input::src->throw( |
|
352
|
|
|
|
|
|
|
"\$value is not an array or hash reference" ); |
|
353
|
|
|
|
|
|
|
} |
|
354
|
|
|
|
|
|
|
|
|
355
|
|
|
|
|
|
|
else { |
|
356
|
0
|
|
|
|
|
0
|
Data::Edit::Struct::failure::internal->throw( |
|
357
|
|
|
|
|
|
|
"internal error: unknown mode to use source in: $_" ); |
|
358
|
|
|
|
|
|
|
} |
|
359
|
|
|
|
|
|
|
|
|
360
|
109
|
100
|
66
|
|
|
463
|
$clone = \&_clone unless is_coderef( $clone ) || !$clone; |
|
361
|
|
|
|
|
|
|
|
|
362
|
|
|
|
|
|
|
return |
|
363
|
109
|
50
|
|
|
|
357
|
is_coderef( $clone ) ? $clone->( $struct ) |
|
|
|
100
|
|
|
|
|
|
|
364
|
|
|
|
|
|
|
: $clone ? _clone( $struct ) |
|
365
|
|
|
|
|
|
|
: $struct; |
|
366
|
|
|
|
|
|
|
} |
|
367
|
|
|
|
|
|
|
|
|
368
|
|
|
|
|
|
|
#--------------------------------------------------------------------- |
|
369
|
|
|
|
|
|
|
|
|
370
|
|
|
|
|
|
|
sub _pop { |
|
371
|
|
|
|
|
|
|
|
|
372
|
4
|
|
|
4
|
|
8
|
my ( $points, $length ) = @_; |
|
373
|
|
|
|
|
|
|
|
|
374
|
4
|
|
|
|
|
9
|
for my $point ( @$points ) { |
|
375
|
|
|
|
|
|
|
|
|
376
|
4
|
|
|
|
|
6
|
my $dest = ${ $point->ref }; |
|
|
4
|
|
|
|
|
9
|
|
|
377
|
4
|
100
|
|
|
|
40
|
Data::Edit::Struct::failure::input::dest->throw( |
|
378
|
|
|
|
|
|
|
"destination is not an array" ) |
|
379
|
|
|
|
|
|
|
unless is_arrayref( $dest ); |
|
380
|
|
|
|
|
|
|
|
|
381
|
3
|
100
|
|
|
|
9
|
$length = @$dest if $length > @$dest; |
|
382
|
3
|
|
|
|
|
25
|
splice( @$dest, -$length, $length ); |
|
383
|
|
|
|
|
|
|
|
|
384
|
|
|
|
|
|
|
} |
|
385
|
|
|
|
|
|
|
} |
|
386
|
|
|
|
|
|
|
|
|
387
|
|
|
|
|
|
|
#--------------------------------------------------------------------- |
|
388
|
|
|
|
|
|
|
|
|
389
|
|
|
|
|
|
|
sub _shift { |
|
390
|
|
|
|
|
|
|
|
|
391
|
4
|
|
|
4
|
|
9
|
my ( $points, $length ) = @_; |
|
392
|
|
|
|
|
|
|
|
|
393
|
4
|
|
|
|
|
9
|
for my $point ( @$points ) { |
|
394
|
4
|
|
|
|
|
5
|
my $dest = ${ $point->ref }; |
|
|
4
|
|
|
|
|
9
|
|
|
395
|
4
|
100
|
|
|
|
36
|
Data::Edit::Struct::failure::input::dest->throw( |
|
396
|
|
|
|
|
|
|
"destination is not an array" ) |
|
397
|
|
|
|
|
|
|
unless is_arrayref( $dest ); |
|
398
|
3
|
|
|
|
|
25
|
splice( @$dest, 0, $length ); |
|
399
|
|
|
|
|
|
|
} |
|
400
|
|
|
|
|
|
|
} |
|
401
|
|
|
|
|
|
|
|
|
402
|
|
|
|
|
|
|
#--------------------------------------------------------------------- |
|
403
|
|
|
|
|
|
|
|
|
404
|
|
|
|
|
|
|
sub _splice { |
|
405
|
|
|
|
|
|
|
|
|
406
|
28
|
|
|
28
|
|
65
|
my ( $dtype, $points, $offset, $length, $replace ) = @_; |
|
407
|
|
|
|
|
|
|
|
|
408
|
28
|
|
|
|
|
54
|
for my $point ( @$points ) { |
|
409
|
|
|
|
|
|
|
|
|
410
|
28
|
|
|
|
|
41
|
my $ref; |
|
411
|
|
|
|
|
|
|
|
|
412
|
28
|
|
|
|
|
104
|
my $attrs = $point->can( 'attrs' ); |
|
413
|
|
|
|
|
|
|
|
|
414
|
|
|
|
|
|
|
my $idx |
|
415
|
|
|
|
|
|
|
= ( ( defined( $attrs ) && $point->$attrs ) ? $point->$attrs : {} ) |
|
416
|
28
|
100
|
66
|
|
|
141
|
->{idx}; |
|
417
|
|
|
|
|
|
|
|
|
418
|
28
|
|
|
|
|
52
|
my $use = $dtype; |
|
419
|
|
|
|
|
|
|
|
|
420
|
28
|
100
|
|
|
|
67
|
if ( $use eq 'auto' ) { |
|
421
|
|
|
|
|
|
|
|
|
422
|
9
|
|
|
|
|
18
|
$ref = $point->ref; |
|
423
|
|
|
|
|
|
|
|
|
424
|
9
|
100
|
|
|
|
51
|
$use |
|
|
|
100
|
|
|
|
|
|
|
425
|
|
|
|
|
|
|
= is_plain_arrayref( $$ref ) ? 'container' |
|
426
|
|
|
|
|
|
|
: defined $idx ? 'element' |
|
427
|
|
|
|
|
|
|
: Data::Edit::Struct::failure::input::dest->throw( |
|
428
|
|
|
|
|
|
|
"point is neither an array element nor an array ref" ); |
|
429
|
|
|
|
|
|
|
} |
|
430
|
|
|
|
|
|
|
|
|
431
|
27
|
100
|
|
|
|
60
|
if ( $use eq 'container' ) { |
|
|
|
50
|
|
|
|
|
|
|
432
|
13
|
100
|
|
|
|
34
|
$ref = $point->ref if !defined $ref; |
|
433
|
13
|
100
|
|
|
|
48
|
Data::Edit::Struct::failure::input::dest->throw( |
|
434
|
|
|
|
|
|
|
"point is not an array reference" ) |
|
435
|
|
|
|
|
|
|
unless is_arrayref( $$ref ); |
|
436
|
|
|
|
|
|
|
|
|
437
|
10
|
|
|
|
|
14
|
splice( @{$$ref}, $offset, $length, @$replace ); |
|
|
10
|
|
|
|
|
78
|
|
|
438
|
|
|
|
|
|
|
} |
|
439
|
|
|
|
|
|
|
|
|
440
|
|
|
|
|
|
|
elsif ( $use eq 'element' ) { |
|
441
|
|
|
|
|
|
|
|
|
442
|
14
|
|
|
|
|
27
|
my $rparent = $point->parent; |
|
443
|
14
|
100
|
|
|
|
34
|
my $parent |
|
444
|
|
|
|
|
|
|
= defined( $rparent ) |
|
445
|
|
|
|
|
|
|
? $rparent->ref |
|
446
|
|
|
|
|
|
|
: undef; |
|
447
|
|
|
|
|
|
|
|
|
448
|
14
|
100
|
100
|
|
|
61
|
Data::Edit::Struct::failure::input::dest->throw( |
|
449
|
|
|
|
|
|
|
"point is not an array element" ) |
|
450
|
|
|
|
|
|
|
unless defined $$parent && is_arrayref( $$parent ); |
|
451
|
|
|
|
|
|
|
|
|
452
|
12
|
|
|
|
|
101
|
splice( @$$parent, $idx + $offset, $length, @$replace ); |
|
453
|
|
|
|
|
|
|
} |
|
454
|
|
|
|
|
|
|
|
|
455
|
|
|
|
|
|
|
else { |
|
456
|
0
|
|
|
|
|
0
|
Data::Edit::Struct::failure::internal->throw( |
|
457
|
|
|
|
|
|
|
"_splice: unknown use: $use" ); |
|
458
|
|
|
|
|
|
|
} |
|
459
|
|
|
|
|
|
|
} |
|
460
|
|
|
|
|
|
|
} |
|
461
|
|
|
|
|
|
|
|
|
462
|
|
|
|
|
|
|
#--------------------------------------------------------------------- |
|
463
|
|
|
|
|
|
|
|
|
464
|
|
|
|
|
|
|
sub _insert { |
|
465
|
|
|
|
|
|
|
|
|
466
|
81
|
|
|
81
|
|
212
|
my ( $dtype, $points, $insert, $anchor, $pad, $offset, $src ) = @_; |
|
467
|
|
|
|
|
|
|
|
|
468
|
81
|
|
|
|
|
143
|
for my $point ( @$points ) { |
|
469
|
|
|
|
|
|
|
|
|
470
|
81
|
|
|
|
|
200
|
my $ref; |
|
471
|
|
|
|
|
|
|
my $idx; |
|
472
|
81
|
|
|
|
|
0
|
my $attrs; |
|
473
|
|
|
|
|
|
|
|
|
474
|
81
|
|
|
|
|
119
|
my $use = $dtype; |
|
475
|
81
|
100
|
|
|
|
176
|
if ( $dtype eq 'auto' ) { |
|
476
|
|
|
|
|
|
|
|
|
477
|
14
|
|
|
|
|
38
|
$ref = $point->ref; |
|
478
|
|
|
|
|
|
|
|
|
479
|
|
|
|
|
|
|
$use |
|
480
|
|
|
|
|
|
|
= is_plain_arrayref( $$ref ) |
|
481
|
|
|
|
|
|
|
|| is_plain_hashref( $$ref ) ? 'container' |
|
482
|
|
|
|
|
|
|
: defined( $attrs = $point->can( 'attrs' ) ) |
|
483
|
14
|
50
|
100
|
|
|
112
|
&& defined( $idx = $point->attrs->{idx} ) ? 'element' |
|
|
|
100
|
33
|
|
|
|
|
|
484
|
|
|
|
|
|
|
: Data::Edit::Struct::failure::input::dest->throw( |
|
485
|
|
|
|
|
|
|
"point is neither an array element nor an array ref" ); |
|
486
|
|
|
|
|
|
|
} |
|
487
|
|
|
|
|
|
|
|
|
488
|
81
|
100
|
|
|
|
209
|
if ( $use eq 'container' ) { |
|
|
|
50
|
|
|
|
|
|
|
489
|
|
|
|
|
|
|
|
|
490
|
36
|
100
|
|
|
|
99
|
$ref = $point->ref if !defined $ref; |
|
491
|
|
|
|
|
|
|
|
|
492
|
36
|
100
|
|
|
|
87
|
if ( is_hashref( $$ref ) ) { |
|
|
|
100
|
|
|
|
|
|
|
493
|
|
|
|
|
|
|
|
|
494
|
4
|
100
|
|
|
|
29
|
Data::Edit::Struct::failure::input::src->throw( |
|
495
|
|
|
|
|
|
|
"insertion into a hash requires an even number of elements\n" |
|
496
|
|
|
|
|
|
|
) if @$src % 2; |
|
497
|
|
|
|
|
|
|
|
|
498
|
3
|
|
|
3
|
|
33
|
pairmap { ; $$ref->{$a} = $b } @$src; |
|
|
3
|
|
|
|
|
41
|
|
|
499
|
|
|
|
|
|
|
} |
|
500
|
|
|
|
|
|
|
|
|
501
|
|
|
|
|
|
|
elsif ( is_arrayref( $$ref ) ) { |
|
502
|
31
|
|
|
|
|
78
|
_insert_via_splice( $insert, $anchor, $pad, $ref, 0, |
|
503
|
|
|
|
|
|
|
$offset, $src ); |
|
504
|
|
|
|
|
|
|
} |
|
505
|
|
|
|
|
|
|
|
|
506
|
|
|
|
|
|
|
else { |
|
507
|
1
|
|
|
|
|
9
|
Data::Edit::Struct::failure::input::dest->throw( |
|
508
|
1
|
|
|
|
|
16
|
"can't insert into a reference of type @{[ ref $$ref]}" ); |
|
509
|
|
|
|
|
|
|
} |
|
510
|
|
|
|
|
|
|
} |
|
511
|
|
|
|
|
|
|
|
|
512
|
|
|
|
|
|
|
elsif ( $use eq 'element' ) { |
|
513
|
45
|
|
|
|
|
89
|
my $rparent = $point->parent; |
|
514
|
45
|
100
|
|
|
|
106
|
my $parent |
|
515
|
|
|
|
|
|
|
= defined( $rparent ) |
|
516
|
|
|
|
|
|
|
? $rparent->ref |
|
517
|
|
|
|
|
|
|
: undef; |
|
518
|
|
|
|
|
|
|
|
|
519
|
45
|
100
|
100
|
|
|
180
|
Data::Edit::Struct::failure::input::dest->throw( |
|
520
|
|
|
|
|
|
|
"point is not an array element" ) |
|
521
|
|
|
|
|
|
|
unless defined $parent && is_arrayref( $$parent ); |
|
522
|
|
|
|
|
|
|
|
|
523
|
|
|
|
|
|
|
$idx = ( defined $attrs ? $attrs : $point->attrs )->{idx} |
|
524
|
43
|
50
|
|
|
|
140
|
if !defined $idx; |
|
|
|
100
|
|
|
|
|
|
|
525
|
|
|
|
|
|
|
|
|
526
|
43
|
|
|
|
|
100
|
_insert_via_splice( $insert, 'index', $pad, $parent, $idx, |
|
527
|
|
|
|
|
|
|
$offset, $src ); |
|
528
|
|
|
|
|
|
|
} |
|
529
|
|
|
|
|
|
|
|
|
530
|
|
|
|
|
|
|
else { |
|
531
|
0
|
|
|
|
|
0
|
Data::Edit::Struct::failure::internal->throw( |
|
532
|
|
|
|
|
|
|
"_insert: unknown use: $use" ); |
|
533
|
|
|
|
|
|
|
} |
|
534
|
|
|
|
|
|
|
} |
|
535
|
|
|
|
|
|
|
} |
|
536
|
|
|
|
|
|
|
|
|
537
|
|
|
|
|
|
|
#--------------------------------------------------------------------- |
|
538
|
|
|
|
|
|
|
|
|
539
|
|
|
|
|
|
|
sub _insert_via_splice { |
|
540
|
|
|
|
|
|
|
|
|
541
|
74
|
|
|
74
|
|
165
|
my ( $insert, $anchor, $pad, $rdest, $idx, $offset, $src ) = @_; |
|
542
|
|
|
|
|
|
|
|
|
543
|
74
|
|
|
|
|
101
|
my $fididx; |
|
544
|
|
|
|
|
|
|
|
|
545
|
74
|
100
|
|
|
|
199
|
if ( $anchor eq 'first' ) { |
|
|
|
100
|
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
546
|
20
|
|
|
|
|
36
|
$fididx = 0; |
|
547
|
|
|
|
|
|
|
} |
|
548
|
|
|
|
|
|
|
elsif ( $anchor eq 'last' ) { |
|
549
|
11
|
|
|
|
|
18
|
$fididx = $#{$$rdest}; |
|
|
11
|
|
|
|
|
20
|
|
|
550
|
|
|
|
|
|
|
} |
|
551
|
|
|
|
|
|
|
elsif ( $anchor eq 'index' ) { |
|
552
|
43
|
|
|
|
|
72
|
$fididx = $idx; |
|
553
|
|
|
|
|
|
|
} |
|
554
|
|
|
|
|
|
|
|
|
555
|
|
|
|
|
|
|
else { |
|
556
|
0
|
|
|
|
|
0
|
Data::Edit::Struct::failure::internal->throw( |
|
557
|
|
|
|
|
|
|
"unknown insert anchor: $anchor" ); |
|
558
|
|
|
|
|
|
|
} |
|
559
|
|
|
|
|
|
|
|
|
560
|
|
|
|
|
|
|
# turn relative index into positive index |
|
561
|
74
|
|
|
|
|
104
|
$idx = $offset + $fididx; |
|
562
|
|
|
|
|
|
|
|
|
563
|
|
|
|
|
|
|
# make sure there's enough room. |
|
564
|
74
|
|
|
|
|
106
|
my $maxidx = $#{$$rdest}; |
|
|
74
|
|
|
|
|
143
|
|
|
565
|
|
|
|
|
|
|
|
|
566
|
74
|
100
|
|
|
|
176
|
if ( $insert eq 'before' ) { |
|
|
|
50
|
|
|
|
|
|
|
567
|
|
|
|
|
|
|
|
|
568
|
42
|
100
|
|
|
|
131
|
if ( $idx < 0 ) { |
|
|
|
100
|
|
|
|
|
|
|
569
|
4
|
|
|
|
|
7
|
unshift @{$$rdest}, ( $pad ) x ( -$idx ); |
|
|
4
|
|
|
|
|
17
|
|
|
570
|
4
|
|
|
|
|
11
|
$idx = 0; |
|
571
|
|
|
|
|
|
|
} |
|
572
|
|
|
|
|
|
|
|
|
573
|
|
|
|
|
|
|
elsif ( $idx > $maxidx + 1 ) { |
|
574
|
5
|
|
|
|
|
8
|
push @{$$rdest}, ( $pad ) x ( $idx - $maxidx - 1 ); |
|
|
5
|
|
|
|
|
16
|
|
|
575
|
|
|
|
|
|
|
} |
|
576
|
|
|
|
|
|
|
} |
|
577
|
|
|
|
|
|
|
|
|
578
|
|
|
|
|
|
|
elsif ( $insert eq 'after' ) { |
|
579
|
|
|
|
|
|
|
|
|
580
|
32
|
100
|
|
|
|
81
|
if ( $idx < 0 ) { |
|
|
|
100
|
|
|
|
|
|
|
581
|
10
|
100
|
|
|
|
23
|
unshift @{$$rdest}, ( $pad ) x ( -$idx - 1 ) if $idx < -1; |
|
|
5
|
|
|
|
|
20
|
|
|
582
|
10
|
|
|
|
|
17
|
$idx = 0; |
|
583
|
|
|
|
|
|
|
} |
|
584
|
|
|
|
|
|
|
|
|
585
|
|
|
|
|
|
|
elsif ( $idx > $maxidx ) { |
|
586
|
5
|
|
|
|
|
9
|
push @{$$rdest}, ( $pad ) x ( $idx - $maxidx ); |
|
|
5
|
|
|
|
|
15
|
|
|
587
|
5
|
|
|
|
|
10
|
++$idx; |
|
588
|
|
|
|
|
|
|
} |
|
589
|
|
|
|
|
|
|
|
|
590
|
|
|
|
|
|
|
else { |
|
591
|
17
|
|
|
|
|
27
|
++$idx; |
|
592
|
|
|
|
|
|
|
} |
|
593
|
|
|
|
|
|
|
|
|
594
|
|
|
|
|
|
|
} |
|
595
|
|
|
|
|
|
|
else { |
|
596
|
0
|
|
|
|
|
0
|
Data::Edit::Struct::failure::internal->throw( |
|
597
|
|
|
|
|
|
|
"_insert_via_splice: unknown insert point: $insert" ); |
|
598
|
|
|
|
|
|
|
} |
|
599
|
|
|
|
|
|
|
|
|
600
|
74
|
|
|
|
|
704
|
splice( @$$rdest, $idx, 0, @$src ); |
|
601
|
|
|
|
|
|
|
} |
|
602
|
|
|
|
|
|
|
|
|
603
|
|
|
|
|
|
|
#--------------------------------------------------------------------- |
|
604
|
|
|
|
|
|
|
|
|
605
|
|
|
|
|
|
|
sub _delete { |
|
606
|
|
|
|
|
|
|
|
|
607
|
4
|
|
|
4
|
|
12
|
my ( $points, $length ) = @_; |
|
608
|
|
|
|
|
|
|
|
|
609
|
4
|
|
|
|
|
11
|
for my $point ( @$points ) { |
|
610
|
|
|
|
|
|
|
|
|
611
|
4
|
|
|
|
|
19
|
my $rparent = $point->parent; |
|
612
|
4
|
100
|
|
|
|
27
|
my $parent |
|
613
|
|
|
|
|
|
|
= defined( $rparent ) |
|
614
|
|
|
|
|
|
|
? $rparent->ref |
|
615
|
|
|
|
|
|
|
: undef; |
|
616
|
|
|
|
|
|
|
|
|
617
|
4
|
100
|
|
|
|
29
|
Data::Edit::Struct::failure::input::dest->throw( |
|
618
|
|
|
|
|
|
|
"point is not an element in a container" ) |
|
619
|
|
|
|
|
|
|
unless defined $parent; |
|
620
|
|
|
|
|
|
|
|
|
621
|
3
|
|
|
|
|
8
|
my $attr = $point->attrs; |
|
622
|
|
|
|
|
|
|
|
|
623
|
3
|
100
|
|
|
|
16
|
if ( defined( my $key = $attr->{key} ) ) { |
|
|
|
50
|
|
|
|
|
|
|
624
|
1
|
|
|
|
|
15
|
delete $$parent->{$key}; |
|
625
|
|
|
|
|
|
|
} |
|
626
|
|
|
|
|
|
|
elsif ( exists $attr->{idx} ) { |
|
627
|
|
|
|
|
|
|
|
|
628
|
2
|
|
|
|
|
19
|
splice( @$$parent, $attr->{idx}, $length ); |
|
629
|
|
|
|
|
|
|
|
|
630
|
|
|
|
|
|
|
} |
|
631
|
|
|
|
|
|
|
else { |
|
632
|
0
|
|
|
|
|
0
|
Data::Edit::Struct::failure::internal->throw( |
|
633
|
|
|
|
|
|
|
"point has neither idx nor key attribute" ); |
|
634
|
|
|
|
|
|
|
} |
|
635
|
|
|
|
|
|
|
|
|
636
|
|
|
|
|
|
|
} |
|
637
|
|
|
|
|
|
|
|
|
638
|
|
|
|
|
|
|
} |
|
639
|
|
|
|
|
|
|
|
|
640
|
|
|
|
|
|
|
#--------------------------------------------------------------------- |
|
641
|
|
|
|
|
|
|
|
|
642
|
|
|
|
|
|
|
sub _replace { |
|
643
|
|
|
|
|
|
|
|
|
644
|
8
|
|
|
8
|
|
21
|
my ( $points, $replace, $src ) = @_; |
|
645
|
|
|
|
|
|
|
|
|
646
|
8
|
|
|
|
|
19
|
for my $point ( @$points ) { |
|
647
|
|
|
|
|
|
|
|
|
648
|
8
|
100
|
|
|
|
21
|
$replace = 'value' |
|
649
|
|
|
|
|
|
|
if $replace eq 'auto'; |
|
650
|
|
|
|
|
|
|
|
|
651
|
8
|
100
|
|
|
|
22
|
if ( $replace eq 'value' ) { |
|
|
|
50
|
|
|
|
|
|
|
652
|
4
|
|
|
|
|
7
|
${ $point->ref } = ${$src}; |
|
|
4
|
|
|
|
|
36
|
|
|
|
4
|
|
|
|
|
10
|
|
|
653
|
|
|
|
|
|
|
} |
|
654
|
|
|
|
|
|
|
|
|
655
|
|
|
|
|
|
|
elsif ( $replace eq 'key' ) { |
|
656
|
|
|
|
|
|
|
|
|
657
|
4
|
|
|
|
|
11
|
my $rparent = $point->parent; |
|
658
|
4
|
100
|
|
|
|
12
|
my $parent |
|
659
|
|
|
|
|
|
|
= defined( $rparent ) |
|
660
|
|
|
|
|
|
|
? $rparent->ref |
|
661
|
|
|
|
|
|
|
: undef; |
|
662
|
|
|
|
|
|
|
|
|
663
|
4
|
100
|
|
|
|
29
|
Data::Edit::Struct::failure::input::dest->throw( |
|
664
|
|
|
|
|
|
|
"key replacement requires a hash element\n" ) |
|
665
|
|
|
|
|
|
|
unless is_hashref( $$parent ); |
|
666
|
|
|
|
|
|
|
|
|
667
|
2
|
|
|
|
|
11
|
my $old_key = $point->attrs->{key}; |
|
668
|
|
|
|
|
|
|
|
|
669
|
2
|
100
|
|
|
|
10
|
my $new_key = is_ref( $$src ) ? refaddr( $$src ) : $$src; |
|
670
|
|
|
|
|
|
|
|
|
671
|
2
|
|
|
|
|
18
|
$$parent->{$new_key} = delete $$parent->{$old_key}; |
|
672
|
|
|
|
|
|
|
} |
|
673
|
|
|
|
|
|
|
else { |
|
674
|
0
|
|
|
|
|
0
|
Data::Edit::Struct::failure::internal->throw( |
|
675
|
|
|
|
|
|
|
"_replace: unknown replace type: $replace" ); |
|
676
|
|
|
|
|
|
|
} |
|
677
|
|
|
|
|
|
|
} |
|
678
|
|
|
|
|
|
|
} |
|
679
|
|
|
|
|
|
|
|
|
680
|
|
|
|
|
|
|
#--------------------------------------------------------------------- |
|
681
|
|
|
|
|
|
|
|
|
682
|
|
|
|
|
|
|
sub _transform { |
|
683
|
|
|
|
|
|
|
|
|
684
|
3
|
|
|
3
|
|
6
|
my ( $points, $cb, $cb_data ) = @_; |
|
685
|
|
|
|
|
|
|
|
|
686
|
3
|
|
|
|
|
7
|
for my $point ( @$points ) { |
|
687
|
6
|
|
|
|
|
36
|
$cb->( $point, $cb_data ); |
|
688
|
|
|
|
|
|
|
} |
|
689
|
|
|
|
|
|
|
} |
|
690
|
|
|
|
|
|
|
|
|
691
|
|
|
|
|
|
|
|
|
692
|
|
|
|
|
|
|
1; |
|
693
|
|
|
|
|
|
|
|
|
694
|
|
|
|
|
|
|
# |
|
695
|
|
|
|
|
|
|
# This file is part of Data-Edit-Struct |
|
696
|
|
|
|
|
|
|
# |
|
697
|
|
|
|
|
|
|
# This software is Copyright (c) 2017 by Smithsonian Astrophysical Observatory. |
|
698
|
|
|
|
|
|
|
# |
|
699
|
|
|
|
|
|
|
# This is free software, licensed under: |
|
700
|
|
|
|
|
|
|
# |
|
701
|
|
|
|
|
|
|
# The GNU General Public License, Version 3, June 2007 |
|
702
|
|
|
|
|
|
|
# |
|
703
|
|
|
|
|
|
|
|
|
704
|
|
|
|
|
|
|
__END__ |
|
705
|
|
|
|
|
|
|
|
|
706
|
|
|
|
|
|
|
=pod |
|
707
|
|
|
|
|
|
|
|
|
708
|
|
|
|
|
|
|
=head1 NAME |
|
709
|
|
|
|
|
|
|
|
|
710
|
|
|
|
|
|
|
Data::Edit::Struct - Edit a Perl structure addressed with a Data::DPath path |
|
711
|
|
|
|
|
|
|
|
|
712
|
|
|
|
|
|
|
=head1 VERSION |
|
713
|
|
|
|
|
|
|
|
|
714
|
|
|
|
|
|
|
version 0.07 |
|
715
|
|
|
|
|
|
|
|
|
716
|
|
|
|
|
|
|
=head1 SYNOPSIS |
|
717
|
|
|
|
|
|
|
|
|
718
|
|
|
|
|
|
|
use Data::Edit::Struct qw[ edit ]; |
|
719
|
|
|
|
|
|
|
|
|
720
|
|
|
|
|
|
|
|
|
721
|
|
|
|
|
|
|
my $src = { foo => 9, bar => 2 }; |
|
722
|
|
|
|
|
|
|
my $dest = { foo => 1, bar => [22] }; |
|
723
|
|
|
|
|
|
|
|
|
724
|
|
|
|
|
|
|
edit( |
|
725
|
|
|
|
|
|
|
replace => { |
|
726
|
|
|
|
|
|
|
src => $src, |
|
727
|
|
|
|
|
|
|
spath => '/foo', |
|
728
|
|
|
|
|
|
|
dest => $dest, |
|
729
|
|
|
|
|
|
|
dpath => '/foo' |
|
730
|
|
|
|
|
|
|
} ); |
|
731
|
|
|
|
|
|
|
|
|
732
|
|
|
|
|
|
|
edit( |
|
733
|
|
|
|
|
|
|
insert => { |
|
734
|
|
|
|
|
|
|
src => $src, |
|
735
|
|
|
|
|
|
|
spath => '/bar', |
|
736
|
|
|
|
|
|
|
dest => $dest, |
|
737
|
|
|
|
|
|
|
dpath => '/bar' |
|
738
|
|
|
|
|
|
|
} ); |
|
739
|
|
|
|
|
|
|
|
|
740
|
|
|
|
|
|
|
# $dest = { foo => 9, bar => [ 2, 22 ] } |
|
741
|
|
|
|
|
|
|
|
|
742
|
|
|
|
|
|
|
=head1 DESCRIPTION |
|
743
|
|
|
|
|
|
|
|
|
744
|
|
|
|
|
|
|
B<Data::Edit::Struct> provides a high-level interface for editing data |
|
745
|
|
|
|
|
|
|
within complex data structures. Edit and source points are specified |
|
746
|
|
|
|
|
|
|
via L<Data::DPath> paths. |
|
747
|
|
|
|
|
|
|
|
|
748
|
|
|
|
|
|
|
The I<destination> structure is the structure to be edited. If data |
|
749
|
|
|
|
|
|
|
are to be inserted into the structure, they are extracted from the |
|
750
|
|
|
|
|
|
|
I<source> structure. See L</Data Copying> for the copying policy. |
|
751
|
|
|
|
|
|
|
|
|
752
|
|
|
|
|
|
|
The following actions may be performed on the destination structure: |
|
753
|
|
|
|
|
|
|
|
|
754
|
|
|
|
|
|
|
=over |
|
755
|
|
|
|
|
|
|
|
|
756
|
|
|
|
|
|
|
=item * C<shift> - remove one or more elements from the front of an array |
|
757
|
|
|
|
|
|
|
|
|
758
|
|
|
|
|
|
|
=item * C<pop> - remove one or more elements from the end of an array |
|
759
|
|
|
|
|
|
|
|
|
760
|
|
|
|
|
|
|
=item * C<splice> - invoke C<splice> on an array |
|
761
|
|
|
|
|
|
|
|
|
762
|
|
|
|
|
|
|
=item * C<insert> - insert elements into an array or a hash |
|
763
|
|
|
|
|
|
|
|
|
764
|
|
|
|
|
|
|
=item * C<delete> - delete array or hash elements |
|
765
|
|
|
|
|
|
|
|
|
766
|
|
|
|
|
|
|
=item * C<replace> - replace array or hash elements (and in the latter case keys) |
|
767
|
|
|
|
|
|
|
|
|
768
|
|
|
|
|
|
|
=item * C<transform> - transform elements |
|
769
|
|
|
|
|
|
|
|
|
770
|
|
|
|
|
|
|
=back |
|
771
|
|
|
|
|
|
|
|
|
772
|
|
|
|
|
|
|
=head2 Elements I<vs.> Containers |
|
773
|
|
|
|
|
|
|
|
|
774
|
|
|
|
|
|
|
B<Data::Edit::Struct> operates on elements in the destination |
|
775
|
|
|
|
|
|
|
structure by following a L<Data::DPath> path. For example, if |
|
776
|
|
|
|
|
|
|
|
|
777
|
|
|
|
|
|
|
$src = { dogs => 'rule' }; |
|
778
|
|
|
|
|
|
|
$dest = { bar => [ 2, { cats => 'rule' }, 4 ] }; |
|
779
|
|
|
|
|
|
|
|
|
780
|
|
|
|
|
|
|
then a data path of |
|
781
|
|
|
|
|
|
|
|
|
782
|
|
|
|
|
|
|
/bar/*[0] |
|
783
|
|
|
|
|
|
|
|
|
784
|
|
|
|
|
|
|
identifies the first element in the C<bar> array. That element may be |
|
785
|
|
|
|
|
|
|
treated either as a I<container> or as an I<element> (this is |
|
786
|
|
|
|
|
|
|
specified by the L</dtype> option). |
|
787
|
|
|
|
|
|
|
|
|
788
|
|
|
|
|
|
|
In the above example, C<< $dest->{bar}[0] >> resolves to a scalar, so |
|
789
|
|
|
|
|
|
|
by default it is treated as an element. However C<< $dest->{bar[1]} |
|
790
|
|
|
|
|
|
|
>> resolves to a hashref. When operating on it, should it be treated |
|
791
|
|
|
|
|
|
|
as an opaque object, or as container? For example, |
|
792
|
|
|
|
|
|
|
|
|
793
|
|
|
|
|
|
|
edit( |
|
794
|
|
|
|
|
|
|
insert => { |
|
795
|
|
|
|
|
|
|
src => $src, |
|
796
|
|
|
|
|
|
|
dest => $dest, |
|
797
|
|
|
|
|
|
|
dpath => '/bar/*[1]', |
|
798
|
|
|
|
|
|
|
} ); |
|
799
|
|
|
|
|
|
|
|
|
800
|
|
|
|
|
|
|
Should C<$src> be inserted I<into> element 2, as in |
|
801
|
|
|
|
|
|
|
|
|
802
|
|
|
|
|
|
|
$dest = { bar => [2, { cats => "rule", dogs => "rule" }, 4] }; |
|
803
|
|
|
|
|
|
|
|
|
804
|
|
|
|
|
|
|
or should it be inserted I<before> element 2 in C<bar>, as in? |
|
805
|
|
|
|
|
|
|
|
|
806
|
|
|
|
|
|
|
$dest = { bar => [2, "dogs", "rule", { cats => "rule" }, 4] }; |
|
807
|
|
|
|
|
|
|
|
|
808
|
|
|
|
|
|
|
The first behavior treats it as a I<container>, the second as an |
|
809
|
|
|
|
|
|
|
I<element>. By default destination paths which resolve to hash or |
|
810
|
|
|
|
|
|
|
array references are treated as B<containers>, so the above code |
|
811
|
|
|
|
|
|
|
generates the first behavior. To explicitly indicate how a path |
|
812
|
|
|
|
|
|
|
should be treated, use the C<< dtype >> option. For example, |
|
813
|
|
|
|
|
|
|
|
|
814
|
|
|
|
|
|
|
edit( |
|
815
|
|
|
|
|
|
|
insert => { |
|
816
|
|
|
|
|
|
|
src => $src, |
|
817
|
|
|
|
|
|
|
dest => $dest, |
|
818
|
|
|
|
|
|
|
dpath => '/bar/*[1]', |
|
819
|
|
|
|
|
|
|
dtype => 'element', |
|
820
|
|
|
|
|
|
|
} ); |
|
821
|
|
|
|
|
|
|
|
|
822
|
|
|
|
|
|
|
results in |
|
823
|
|
|
|
|
|
|
|
|
824
|
|
|
|
|
|
|
$dest = { bar => [2, "dogs", "rule", { cats => "rule" }, 4] }; |
|
825
|
|
|
|
|
|
|
|
|
826
|
|
|
|
|
|
|
Source structures may have the same ambiguity. In the above example, |
|
827
|
|
|
|
|
|
|
note that the I<contents> of the hash in the source path are inserted, |
|
828
|
|
|
|
|
|
|
not the reference itself. This is because non-blessed references in |
|
829
|
|
|
|
|
|
|
sources are by default considered to be containers, and their contents |
|
830
|
|
|
|
|
|
|
are copied. To treat a source reference as an opaque element, use the |
|
831
|
|
|
|
|
|
|
L</stype> option to specify it as such: |
|
832
|
|
|
|
|
|
|
|
|
833
|
|
|
|
|
|
|
edit( |
|
834
|
|
|
|
|
|
|
insert => { |
|
835
|
|
|
|
|
|
|
src => $src, |
|
836
|
|
|
|
|
|
|
stype => 'element', |
|
837
|
|
|
|
|
|
|
dest => $dest, |
|
838
|
|
|
|
|
|
|
dpath => '/bar/*[1]', |
|
839
|
|
|
|
|
|
|
dtype => 'element', |
|
840
|
|
|
|
|
|
|
} ); |
|
841
|
|
|
|
|
|
|
|
|
842
|
|
|
|
|
|
|
which results in |
|
843
|
|
|
|
|
|
|
|
|
844
|
|
|
|
|
|
|
$dest = { bar => [2, { dogs => "rule" }, { cats => "rule" }, 4] }; |
|
845
|
|
|
|
|
|
|
|
|
846
|
|
|
|
|
|
|
Note that C<dpath> was set to I<element>, otherwise C<edit> would have |
|
847
|
|
|
|
|
|
|
attempted to insert the source hashref (not its contents) into the |
|
848
|
|
|
|
|
|
|
destination hash, which would have failed, as insertion into a hash |
|
849
|
|
|
|
|
|
|
requires a multiple of two elements (i.e., C<< $key, $value >>). |
|
850
|
|
|
|
|
|
|
|
|
851
|
|
|
|
|
|
|
=head2 Source Transformations |
|
852
|
|
|
|
|
|
|
|
|
853
|
|
|
|
|
|
|
Data extracted from the source structure may undergo transformations |
|
854
|
|
|
|
|
|
|
prior to being inserted into the destination structure. There are |
|
855
|
|
|
|
|
|
|
several predefined transformations and the caller may specify a |
|
856
|
|
|
|
|
|
|
callback to perform their own. |
|
857
|
|
|
|
|
|
|
|
|
858
|
|
|
|
|
|
|
Most of the transformations have to do with multiple values being |
|
859
|
|
|
|
|
|
|
returned by the source path. For example, |
|
860
|
|
|
|
|
|
|
|
|
861
|
|
|
|
|
|
|
$src = { foo => [1], bar => [5], baz => [5] }; |
|
862
|
|
|
|
|
|
|
$spath = '/*/*[value == 5]'; |
|
863
|
|
|
|
|
|
|
|
|
864
|
|
|
|
|
|
|
would result in multiple extracted values: |
|
865
|
|
|
|
|
|
|
|
|
866
|
|
|
|
|
|
|
(5, 5) |
|
867
|
|
|
|
|
|
|
|
|
868
|
|
|
|
|
|
|
|
|
869
|
|
|
|
|
|
|
By default multiple values are not allowed, but a source |
|
870
|
|
|
|
|
|
|
transformation (specified by the C<sxfrm> option ) may be used to |
|
871
|
|
|
|
|
|
|
change that behavior. The provided transforms are: |
|
872
|
|
|
|
|
|
|
|
|
873
|
|
|
|
|
|
|
=over |
|
874
|
|
|
|
|
|
|
|
|
875
|
|
|
|
|
|
|
=item C<array> |
|
876
|
|
|
|
|
|
|
|
|
877
|
|
|
|
|
|
|
The values are assembled into an array. The C<stype> |
|
878
|
|
|
|
|
|
|
parameter is used to determine whether that array is treated as a |
|
879
|
|
|
|
|
|
|
container or an element. |
|
880
|
|
|
|
|
|
|
|
|
881
|
|
|
|
|
|
|
=item C<hash> |
|
882
|
|
|
|
|
|
|
|
|
883
|
|
|
|
|
|
|
The items are assembled into a hash. The C<stype> parameter is used |
|
884
|
|
|
|
|
|
|
to determine whether that hash is treated as a container or an |
|
885
|
|
|
|
|
|
|
element. Keys are derived from the data: |
|
886
|
|
|
|
|
|
|
|
|
887
|
|
|
|
|
|
|
=over |
|
888
|
|
|
|
|
|
|
|
|
889
|
|
|
|
|
|
|
=item * Keys for hash values will be their hash keys |
|
890
|
|
|
|
|
|
|
|
|
891
|
|
|
|
|
|
|
=item * Keys for array values will be their array indices |
|
892
|
|
|
|
|
|
|
|
|
893
|
|
|
|
|
|
|
=back |
|
894
|
|
|
|
|
|
|
|
|
895
|
|
|
|
|
|
|
If there is a I<single> value, a hash key may be specified via the |
|
896
|
|
|
|
|
|
|
C<key> option to the C<sxfrm_args> option. |
|
897
|
|
|
|
|
|
|
|
|
898
|
|
|
|
|
|
|
=item C<iterate> |
|
899
|
|
|
|
|
|
|
|
|
900
|
|
|
|
|
|
|
The edit action is applied independently to each source value in turn. |
|
901
|
|
|
|
|
|
|
|
|
902
|
|
|
|
|
|
|
=item I<coderef> |
|
903
|
|
|
|
|
|
|
|
|
904
|
|
|
|
|
|
|
If C<sxfrm> is a code reference, it will be called to generate the |
|
905
|
|
|
|
|
|
|
source values. See L</Source Callbacks> for more information. |
|
906
|
|
|
|
|
|
|
|
|
907
|
|
|
|
|
|
|
=back |
|
908
|
|
|
|
|
|
|
|
|
909
|
|
|
|
|
|
|
=head2 Source Callbacks |
|
910
|
|
|
|
|
|
|
|
|
911
|
|
|
|
|
|
|
If the C<sxfrm> option is a code reference, it is called to generate |
|
912
|
|
|
|
|
|
|
the source values. It must return an array which contains I<references> |
|
913
|
|
|
|
|
|
|
to the values (even if they are already references). For example, |
|
914
|
|
|
|
|
|
|
to return a hash: |
|
915
|
|
|
|
|
|
|
|
|
916
|
|
|
|
|
|
|
my %src = ( foo => 1 ); |
|
917
|
|
|
|
|
|
|
return [ \\%hash ]; |
|
918
|
|
|
|
|
|
|
|
|
919
|
|
|
|
|
|
|
It is called with the arguments |
|
920
|
|
|
|
|
|
|
|
|
921
|
|
|
|
|
|
|
=over |
|
922
|
|
|
|
|
|
|
|
|
923
|
|
|
|
|
|
|
=item C<$ctx> |
|
924
|
|
|
|
|
|
|
|
|
925
|
|
|
|
|
|
|
A L</Data::DPath::Context> object representing the source structure. |
|
926
|
|
|
|
|
|
|
|
|
927
|
|
|
|
|
|
|
=item C<$spath> |
|
928
|
|
|
|
|
|
|
|
|
929
|
|
|
|
|
|
|
The source path. Unless otherwise specified, this defaults to C</>, |
|
930
|
|
|
|
|
|
|
I<except> when the source is not a plain array or plain |
|
931
|
|
|
|
|
|
|
hash, in which case the source is embedded in an array, and C<spath> is set to C</*[0]>. |
|
932
|
|
|
|
|
|
|
|
|
933
|
|
|
|
|
|
|
This is because L</Data::DPath> requires a container to be at the root |
|
934
|
|
|
|
|
|
|
of the source structure, and anything other than a plain array or hash |
|
935
|
|
|
|
|
|
|
is most likely a blessed object or a scalar, both of which should be |
|
936
|
|
|
|
|
|
|
treated as elements. |
|
937
|
|
|
|
|
|
|
|
|
938
|
|
|
|
|
|
|
=item C<$args> |
|
939
|
|
|
|
|
|
|
|
|
940
|
|
|
|
|
|
|
The value of the C<sxfrm_args> option. |
|
941
|
|
|
|
|
|
|
|
|
942
|
|
|
|
|
|
|
=back |
|
943
|
|
|
|
|
|
|
|
|
944
|
|
|
|
|
|
|
=head2 Data Copying |
|
945
|
|
|
|
|
|
|
|
|
946
|
|
|
|
|
|
|
By default, copying of data from the source structure is done |
|
947
|
|
|
|
|
|
|
I<shallowly>, e.g. references to arrays or hashes are not copied |
|
948
|
|
|
|
|
|
|
recursively. This may cause problems if further modifications are |
|
949
|
|
|
|
|
|
|
made to the destination structure which may, through references, |
|
950
|
|
|
|
|
|
|
alter the source structure. |
|
951
|
|
|
|
|
|
|
|
|
952
|
|
|
|
|
|
|
For example, given the following input structures: |
|
953
|
|
|
|
|
|
|
|
|
954
|
|
|
|
|
|
|
$src = { dogs => { say => 'bark' } }; |
|
955
|
|
|
|
|
|
|
$dest = { cats => { say => 'meow' } }; |
|
956
|
|
|
|
|
|
|
|
|
957
|
|
|
|
|
|
|
and this edit operation: |
|
958
|
|
|
|
|
|
|
|
|
959
|
|
|
|
|
|
|
edit( |
|
960
|
|
|
|
|
|
|
insert => { |
|
961
|
|
|
|
|
|
|
src => $src, |
|
962
|
|
|
|
|
|
|
dest => $dest, |
|
963
|
|
|
|
|
|
|
} ); |
|
964
|
|
|
|
|
|
|
|
|
965
|
|
|
|
|
|
|
We get a destination structure that looks like this: |
|
966
|
|
|
|
|
|
|
|
|
967
|
|
|
|
|
|
|
$dest = { cats => { say => "meow" }, dogs => { say => "bark" } }; |
|
968
|
|
|
|
|
|
|
|
|
969
|
|
|
|
|
|
|
But if later we change C<$dest>, |
|
970
|
|
|
|
|
|
|
|
|
971
|
|
|
|
|
|
|
# dogs are more excited now |
|
972
|
|
|
|
|
|
|
$dest->{dogs}{say} = 'howl'; |
|
973
|
|
|
|
|
|
|
|
|
974
|
|
|
|
|
|
|
the source structure is also changed: |
|
975
|
|
|
|
|
|
|
|
|
976
|
|
|
|
|
|
|
$src = { dogs => { say => "howl" } }; |
|
977
|
|
|
|
|
|
|
|
|
978
|
|
|
|
|
|
|
To avoid this possible problem, C<Data::Edit::Struct> can be passed |
|
979
|
|
|
|
|
|
|
the L<< C<clone>|/clone >> option, which will instruct it how to |
|
980
|
|
|
|
|
|
|
copy data. |
|
981
|
|
|
|
|
|
|
|
|
982
|
|
|
|
|
|
|
=head1 SUBROUTINES |
|
983
|
|
|
|
|
|
|
|
|
984
|
|
|
|
|
|
|
=head2 edit ( $action, $params ) |
|
985
|
|
|
|
|
|
|
|
|
986
|
|
|
|
|
|
|
Edit a data structure. The available actions are discussed below. |
|
987
|
|
|
|
|
|
|
|
|
988
|
|
|
|
|
|
|
=head3 Parameters |
|
989
|
|
|
|
|
|
|
|
|
990
|
|
|
|
|
|
|
Destination structure parameters are: |
|
991
|
|
|
|
|
|
|
|
|
992
|
|
|
|
|
|
|
=over |
|
993
|
|
|
|
|
|
|
|
|
994
|
|
|
|
|
|
|
=item C<dest> |
|
995
|
|
|
|
|
|
|
|
|
996
|
|
|
|
|
|
|
A reference to a structure or a L<< Data::DPath::Context >> object. |
|
997
|
|
|
|
|
|
|
|
|
998
|
|
|
|
|
|
|
=item C<dpath> |
|
999
|
|
|
|
|
|
|
|
|
1000
|
|
|
|
|
|
|
A string representing the data path. This may result in multiple |
|
1001
|
|
|
|
|
|
|
extracted values from the structure; the action will be applied to |
|
1002
|
|
|
|
|
|
|
each in turn. |
|
1003
|
|
|
|
|
|
|
|
|
1004
|
|
|
|
|
|
|
=item C<dtype> |
|
1005
|
|
|
|
|
|
|
|
|
1006
|
|
|
|
|
|
|
May be C<auto>, C<element> or C<container>, to treat the extracted |
|
1007
|
|
|
|
|
|
|
values either as elements or containers. If C<auto>, non-blessed |
|
1008
|
|
|
|
|
|
|
arrays and hashes are treated as containers. |
|
1009
|
|
|
|
|
|
|
|
|
1010
|
|
|
|
|
|
|
=back |
|
1011
|
|
|
|
|
|
|
|
|
1012
|
|
|
|
|
|
|
Some actions require a source structure; parameters related |
|
1013
|
|
|
|
|
|
|
to that are: |
|
1014
|
|
|
|
|
|
|
|
|
1015
|
|
|
|
|
|
|
=over |
|
1016
|
|
|
|
|
|
|
|
|
1017
|
|
|
|
|
|
|
=item C<src> |
|
1018
|
|
|
|
|
|
|
|
|
1019
|
|
|
|
|
|
|
A reference to a structure or a L<Data::DPath::Context> object. |
|
1020
|
|
|
|
|
|
|
|
|
1021
|
|
|
|
|
|
|
=item C<spath> |
|
1022
|
|
|
|
|
|
|
|
|
1023
|
|
|
|
|
|
|
A string representing the source path. This may result in multiple |
|
1024
|
|
|
|
|
|
|
extracted values from the structure; the C<sxfrm> option provides |
|
1025
|
|
|
|
|
|
|
the context for how to interpret these values. |
|
1026
|
|
|
|
|
|
|
|
|
1027
|
|
|
|
|
|
|
=item C<stype> |
|
1028
|
|
|
|
|
|
|
|
|
1029
|
|
|
|
|
|
|
May be C<auto>, C<element> or C<container>, to treat the extracted |
|
1030
|
|
|
|
|
|
|
values either as elements or containers. If C<auto>, non-blessed |
|
1031
|
|
|
|
|
|
|
arrays and hashes are treated as containers. |
|
1032
|
|
|
|
|
|
|
|
|
1033
|
|
|
|
|
|
|
=item C<sxfrm> |
|
1034
|
|
|
|
|
|
|
|
|
1035
|
|
|
|
|
|
|
A transformation to be applied to the data extracted from the |
|
1036
|
|
|
|
|
|
|
source. The available values are |
|
1037
|
|
|
|
|
|
|
|
|
1038
|
|
|
|
|
|
|
=over |
|
1039
|
|
|
|
|
|
|
|
|
1040
|
|
|
|
|
|
|
=item C<array> |
|
1041
|
|
|
|
|
|
|
|
|
1042
|
|
|
|
|
|
|
=item C<hash> |
|
1043
|
|
|
|
|
|
|
|
|
1044
|
|
|
|
|
|
|
=item C<iterate> |
|
1045
|
|
|
|
|
|
|
|
|
1046
|
|
|
|
|
|
|
=item I<coderef> |
|
1047
|
|
|
|
|
|
|
|
|
1048
|
|
|
|
|
|
|
=back |
|
1049
|
|
|
|
|
|
|
|
|
1050
|
|
|
|
|
|
|
See L</Source Transformations> for more information. |
|
1051
|
|
|
|
|
|
|
|
|
1052
|
|
|
|
|
|
|
=item C<clone> |
|
1053
|
|
|
|
|
|
|
|
|
1054
|
|
|
|
|
|
|
This may be a boolean or a code reference. If a boolean, and true, |
|
1055
|
|
|
|
|
|
|
L<Storable/dclone> is used to clone the source structure. If set to a |
|
1056
|
|
|
|
|
|
|
code reference, it is called with a I<reference> to the structure to |
|
1057
|
|
|
|
|
|
|
be cloned. It should return a I<reference> to the cloned structure. |
|
1058
|
|
|
|
|
|
|
|
|
1059
|
|
|
|
|
|
|
=back |
|
1060
|
|
|
|
|
|
|
|
|
1061
|
|
|
|
|
|
|
=head3 Actions |
|
1062
|
|
|
|
|
|
|
|
|
1063
|
|
|
|
|
|
|
Actions may have additional parameters |
|
1064
|
|
|
|
|
|
|
|
|
1065
|
|
|
|
|
|
|
=head4 C<pop> |
|
1066
|
|
|
|
|
|
|
|
|
1067
|
|
|
|
|
|
|
Remove one or more elements from the end of an array. The destination |
|
1068
|
|
|
|
|
|
|
structure must be an array. Additional parameters are: |
|
1069
|
|
|
|
|
|
|
|
|
1070
|
|
|
|
|
|
|
=over |
|
1071
|
|
|
|
|
|
|
|
|
1072
|
|
|
|
|
|
|
=item C<length> |
|
1073
|
|
|
|
|
|
|
|
|
1074
|
|
|
|
|
|
|
The number of elements to remove. Defaults to C<1>. |
|
1075
|
|
|
|
|
|
|
|
|
1076
|
|
|
|
|
|
|
=back |
|
1077
|
|
|
|
|
|
|
|
|
1078
|
|
|
|
|
|
|
=head4 C<shift> |
|
1079
|
|
|
|
|
|
|
|
|
1080
|
|
|
|
|
|
|
Remove one or more elements from the front of an array. The |
|
1081
|
|
|
|
|
|
|
destination structure must be an array. Additional parameters are: |
|
1082
|
|
|
|
|
|
|
|
|
1083
|
|
|
|
|
|
|
=over |
|
1084
|
|
|
|
|
|
|
|
|
1085
|
|
|
|
|
|
|
=item C<length> |
|
1086
|
|
|
|
|
|
|
|
|
1087
|
|
|
|
|
|
|
The number of elements to remove. Defaults to C<1>. |
|
1088
|
|
|
|
|
|
|
|
|
1089
|
|
|
|
|
|
|
=back |
|
1090
|
|
|
|
|
|
|
|
|
1091
|
|
|
|
|
|
|
=head4 C<splice> |
|
1092
|
|
|
|
|
|
|
|
|
1093
|
|
|
|
|
|
|
Perform a L<splice|perlfunc/splice> operation on an array, e.g. |
|
1094
|
|
|
|
|
|
|
|
|
1095
|
|
|
|
|
|
|
splice( @$dest, $offset, $length, @$src ); |
|
1096
|
|
|
|
|
|
|
|
|
1097
|
|
|
|
|
|
|
The C<$offset> and C<$length> parameters are provided by the C<offset> |
|
1098
|
|
|
|
|
|
|
and C<length> options. |
|
1099
|
|
|
|
|
|
|
|
|
1100
|
|
|
|
|
|
|
The destination structure may be an array or an array element. In the |
|
1101
|
|
|
|
|
|
|
latter case, the actual offset passed to splice is the sum of the |
|
1102
|
|
|
|
|
|
|
index of the array element and the value provided by the C<offset> |
|
1103
|
|
|
|
|
|
|
option. |
|
1104
|
|
|
|
|
|
|
|
|
1105
|
|
|
|
|
|
|
A source structure is optional, and may be an array or a hash. |
|
1106
|
|
|
|
|
|
|
|
|
1107
|
|
|
|
|
|
|
=head4 C<insert> |
|
1108
|
|
|
|
|
|
|
|
|
1109
|
|
|
|
|
|
|
Insert a source structure into the destination structure. The result |
|
1110
|
|
|
|
|
|
|
depends upon whether the point at which to insert is to be treated as |
|
1111
|
|
|
|
|
|
|
a container or an element. |
|
1112
|
|
|
|
|
|
|
|
|
1113
|
|
|
|
|
|
|
=over |
|
1114
|
|
|
|
|
|
|
|
|
1115
|
|
|
|
|
|
|
=item container |
|
1116
|
|
|
|
|
|
|
|
|
1117
|
|
|
|
|
|
|
=over |
|
1118
|
|
|
|
|
|
|
|
|
1119
|
|
|
|
|
|
|
=item Hash |
|
1120
|
|
|
|
|
|
|
|
|
1121
|
|
|
|
|
|
|
If the container is a hash, the source must be a container (either |
|
1122
|
|
|
|
|
|
|
array or hash), and must contain an even number of elements. Each |
|
1123
|
|
|
|
|
|
|
sequential pair of values is treated as a key, value pair. |
|
1124
|
|
|
|
|
|
|
|
|
1125
|
|
|
|
|
|
|
=item Array |
|
1126
|
|
|
|
|
|
|
|
|
1127
|
|
|
|
|
|
|
If the container is an array, the source may be either a container or |
|
1128
|
|
|
|
|
|
|
an element. The following options are available: |
|
1129
|
|
|
|
|
|
|
|
|
1130
|
|
|
|
|
|
|
=over |
|
1131
|
|
|
|
|
|
|
|
|
1132
|
|
|
|
|
|
|
=item C<offset> |
|
1133
|
|
|
|
|
|
|
|
|
1134
|
|
|
|
|
|
|
The offset into the array of the insertion point. Defaults to C<0>. |
|
1135
|
|
|
|
|
|
|
See L</anchor>. |
|
1136
|
|
|
|
|
|
|
|
|
1137
|
|
|
|
|
|
|
=item C<anchor> |
|
1138
|
|
|
|
|
|
|
|
|
1139
|
|
|
|
|
|
|
Indicates which end of the array the C<offset> parameter is relative to. |
|
1140
|
|
|
|
|
|
|
May be C<first> or C<last>. It defaults to C<first>. |
|
1141
|
|
|
|
|
|
|
|
|
1142
|
|
|
|
|
|
|
=item C<pad> |
|
1143
|
|
|
|
|
|
|
|
|
1144
|
|
|
|
|
|
|
If the array must be enlarged to accommodate the specified insertion point, fill the new |
|
1145
|
|
|
|
|
|
|
values with this value. Defaults to C<undef>. |
|
1146
|
|
|
|
|
|
|
|
|
1147
|
|
|
|
|
|
|
=item C<insert> |
|
1148
|
|
|
|
|
|
|
|
|
1149
|
|
|
|
|
|
|
Indicates which side of the insertion point data will be inserted. May |
|
1150
|
|
|
|
|
|
|
be either C<before> or C<after>. It defaults to C<before>. |
|
1151
|
|
|
|
|
|
|
|
|
1152
|
|
|
|
|
|
|
=back |
|
1153
|
|
|
|
|
|
|
|
|
1154
|
|
|
|
|
|
|
=back |
|
1155
|
|
|
|
|
|
|
|
|
1156
|
|
|
|
|
|
|
=item element |
|
1157
|
|
|
|
|
|
|
|
|
1158
|
|
|
|
|
|
|
The insertion point must be an array value. The source may be either a |
|
1159
|
|
|
|
|
|
|
container or an element. The following options are available: |
|
1160
|
|
|
|
|
|
|
|
|
1161
|
|
|
|
|
|
|
=over |
|
1162
|
|
|
|
|
|
|
|
|
1163
|
|
|
|
|
|
|
=item C<offset> |
|
1164
|
|
|
|
|
|
|
|
|
1165
|
|
|
|
|
|
|
Move the insertion point by this value. |
|
1166
|
|
|
|
|
|
|
|
|
1167
|
|
|
|
|
|
|
=item C<pad> |
|
1168
|
|
|
|
|
|
|
|
|
1169
|
|
|
|
|
|
|
If the array must be enlarged to accommodate the specified insertion point, fill the new |
|
1170
|
|
|
|
|
|
|
values with this value. Defaults to C<undef>. |
|
1171
|
|
|
|
|
|
|
|
|
1172
|
|
|
|
|
|
|
=item C<insert> |
|
1173
|
|
|
|
|
|
|
|
|
1174
|
|
|
|
|
|
|
Indicates which side of the insertion point data will be inserted. May |
|
1175
|
|
|
|
|
|
|
be either C<before> or C<after>. It defaults to C<before>. |
|
1176
|
|
|
|
|
|
|
|
|
1177
|
|
|
|
|
|
|
=back |
|
1178
|
|
|
|
|
|
|
|
|
1179
|
|
|
|
|
|
|
=back |
|
1180
|
|
|
|
|
|
|
|
|
1181
|
|
|
|
|
|
|
=head4 C<delete> |
|
1182
|
|
|
|
|
|
|
|
|
1183
|
|
|
|
|
|
|
Remove an array or hash value. If an array, the C<length> option |
|
1184
|
|
|
|
|
|
|
specifies the number of elements to remove, starting at that element. |
|
1185
|
|
|
|
|
|
|
it defaults to C<1>. |
|
1186
|
|
|
|
|
|
|
|
|
1187
|
|
|
|
|
|
|
=head4 C<replace> |
|
1188
|
|
|
|
|
|
|
|
|
1189
|
|
|
|
|
|
|
Replace an array or hash element, or a hash key. The source data is |
|
1190
|
|
|
|
|
|
|
always treated as an element. It takes the following options: |
|
1191
|
|
|
|
|
|
|
|
|
1192
|
|
|
|
|
|
|
=over |
|
1193
|
|
|
|
|
|
|
|
|
1194
|
|
|
|
|
|
|
=item C<replace> |
|
1195
|
|
|
|
|
|
|
|
|
1196
|
|
|
|
|
|
|
Indicates which part of a hash element to replace, either C<key> or |
|
1197
|
|
|
|
|
|
|
C<value>. Defaults to C<value>. If replacing the key and the source |
|
1198
|
|
|
|
|
|
|
value is a reference, the value returned by |
|
1199
|
|
|
|
|
|
|
L<Scalar::Util::refaddr|Scalar::Util/reffadr> will be used. |
|
1200
|
|
|
|
|
|
|
|
|
1201
|
|
|
|
|
|
|
=back |
|
1202
|
|
|
|
|
|
|
|
|
1203
|
|
|
|
|
|
|
=head4 C<transform> |
|
1204
|
|
|
|
|
|
|
|
|
1205
|
|
|
|
|
|
|
Transform an element via a user provided subroutine. It takes the |
|
1206
|
|
|
|
|
|
|
following options: |
|
1207
|
|
|
|
|
|
|
|
|
1208
|
|
|
|
|
|
|
=over |
|
1209
|
|
|
|
|
|
|
|
|
1210
|
|
|
|
|
|
|
=item C<callback_data> |
|
1211
|
|
|
|
|
|
|
|
|
1212
|
|
|
|
|
|
|
Arbitrary data to be passed to the callback. |
|
1213
|
|
|
|
|
|
|
|
|
1214
|
|
|
|
|
|
|
=item C<callback> |
|
1215
|
|
|
|
|
|
|
|
|
1216
|
|
|
|
|
|
|
A code reference which will be called for each element. It is invoked as |
|
1217
|
|
|
|
|
|
|
|
|
1218
|
|
|
|
|
|
|
$callback->( $point, $callback_data ); |
|
1219
|
|
|
|
|
|
|
|
|
1220
|
|
|
|
|
|
|
where C<$point> is the L<Data::DPath::Point> object representing the element, |
|
1221
|
|
|
|
|
|
|
and C<$data> is the value of the C<callback_data> option. |
|
1222
|
|
|
|
|
|
|
|
|
1223
|
|
|
|
|
|
|
Here's a silly example showing how to use the element object's |
|
1224
|
|
|
|
|
|
|
attributes for a hash element: |
|
1225
|
|
|
|
|
|
|
|
|
1226
|
|
|
|
|
|
|
$dest = { a => '1', 'b' => 2 }; |
|
1227
|
|
|
|
|
|
|
|
|
1228
|
|
|
|
|
|
|
edit( |
|
1229
|
|
|
|
|
|
|
transform => { |
|
1230
|
|
|
|
|
|
|
dest => $dest, |
|
1231
|
|
|
|
|
|
|
dpath => '/*', |
|
1232
|
|
|
|
|
|
|
callback => sub { |
|
1233
|
|
|
|
|
|
|
my ( $point, $data ) = @_; |
|
1234
|
|
|
|
|
|
|
${ $point->ref } .= $point->attrs->key; |
|
1235
|
|
|
|
|
|
|
}, |
|
1236
|
|
|
|
|
|
|
}, |
|
1237
|
|
|
|
|
|
|
); |
|
1238
|
|
|
|
|
|
|
|
|
1239
|
|
|
|
|
|
|
With the result: |
|
1240
|
|
|
|
|
|
|
|
|
1241
|
|
|
|
|
|
|
$dest = { a => "1a", b => "2b" }; |
|
1242
|
|
|
|
|
|
|
|
|
1243
|
|
|
|
|
|
|
=back |
|
1244
|
|
|
|
|
|
|
|
|
1245
|
|
|
|
|
|
|
=head1 AUTHOR |
|
1246
|
|
|
|
|
|
|
|
|
1247
|
|
|
|
|
|
|
Diab Jerius <djerius@cpan.org> |
|
1248
|
|
|
|
|
|
|
|
|
1249
|
|
|
|
|
|
|
=head1 COPYRIGHT AND LICENSE |
|
1250
|
|
|
|
|
|
|
|
|
1251
|
|
|
|
|
|
|
This software is Copyright (c) 2017 by Smithsonian Astrophysical Observatory. |
|
1252
|
|
|
|
|
|
|
|
|
1253
|
|
|
|
|
|
|
This is free software, licensed under: |
|
1254
|
|
|
|
|
|
|
|
|
1255
|
|
|
|
|
|
|
The GNU General Public License, Version 3, June 2007 |
|
1256
|
|
|
|
|
|
|
|
|
1257
|
|
|
|
|
|
|
=cut |