line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
|
2
|
|
|
|
|
|
|
use Catmandu::Sane; |
3
|
147
|
|
|
147
|
|
1089663
|
|
|
147
|
|
|
|
|
273
|
|
|
147
|
|
|
|
|
783
|
|
4
|
|
|
|
|
|
|
our $VERSION = '1.2018'; |
5
|
|
|
|
|
|
|
|
6
|
|
|
|
|
|
|
use Moo; |
7
|
147
|
|
|
147
|
|
1971
|
use Catmandu::Fix::Parser; |
|
147
|
|
|
|
|
285
|
|
|
147
|
|
|
|
|
1744
|
|
8
|
147
|
|
|
147
|
|
106241
|
use Text::Hogan::Compiler; |
|
147
|
|
|
|
|
466
|
|
|
147
|
|
|
|
|
4380
|
|
9
|
147
|
|
|
147
|
|
70576
|
use Path::Tiny (); |
|
147
|
|
|
|
|
1275834
|
|
|
147
|
|
|
|
|
4846
|
|
10
|
147
|
|
|
147
|
|
106640
|
use File::Spec (); |
|
147
|
|
|
|
|
1487237
|
|
|
147
|
|
|
|
|
3777
|
|
11
|
147
|
|
|
147
|
|
1113
|
use File::Temp (); |
|
147
|
|
|
|
|
305
|
|
|
147
|
|
|
|
|
1879
|
|
12
|
147
|
|
|
147
|
|
90808
|
use Catmandu::Util qw( |
|
147
|
|
|
|
|
1234193
|
|
|
147
|
|
|
|
|
4886
|
|
13
|
147
|
|
|
|
|
10121
|
is_string |
14
|
|
|
|
|
|
|
is_array_ref |
15
|
|
|
|
|
|
|
is_hash_ref |
16
|
|
|
|
|
|
|
is_code_ref |
17
|
|
|
|
|
|
|
is_glob_ref |
18
|
|
|
|
|
|
|
is_instance |
19
|
|
|
|
|
|
|
is_able |
20
|
|
|
|
|
|
|
require_package |
21
|
|
|
|
|
|
|
); |
22
|
147
|
|
|
147
|
|
1223
|
use namespace::clean; |
|
147
|
|
|
|
|
299
|
|
23
|
147
|
|
|
147
|
|
856
|
|
|
147
|
|
|
|
|
283
|
|
|
147
|
|
|
|
|
1264
|
|
24
|
|
|
|
|
|
|
with 'Catmandu::Logger'; |
25
|
|
|
|
|
|
|
with 'Catmandu::Emit'; |
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
has parser => (is => 'lazy'); |
28
|
|
|
|
|
|
|
has fixer => (is => 'lazy', init_arg => undef); |
29
|
|
|
|
|
|
|
has _captures => |
30
|
|
|
|
|
|
|
(is => 'ro', lazy => 1, init_arg => undef, default => sub {+{}}); |
31
|
|
|
|
|
|
|
has var => |
32
|
|
|
|
|
|
|
(is => 'ro', lazy => 1, init_arg => undef, builder => '_generate_var'); |
33
|
|
|
|
|
|
|
has _fixes => (is => 'ro', init_arg => 'fixes', default => sub {[]}); |
34
|
|
|
|
|
|
|
has fixes => |
35
|
|
|
|
|
|
|
(is => 'ro', lazy => 1, init_arg => undef, builder => '_build_fixes'); |
36
|
|
|
|
|
|
|
has _reject_var => ( |
37
|
|
|
|
|
|
|
is => 'ro', |
38
|
|
|
|
|
|
|
lazy => 1, |
39
|
|
|
|
|
|
|
init_arg => undef, |
40
|
|
|
|
|
|
|
builder => '_build_reject_var' |
41
|
|
|
|
|
|
|
); |
42
|
|
|
|
|
|
|
has _fixes_var => |
43
|
|
|
|
|
|
|
(is => 'ro', lazy => 1, init_arg => undef, builder => '_build_fixes_var'); |
44
|
|
|
|
|
|
|
has preprocess => (is => 'ro'); |
45
|
|
|
|
|
|
|
has _hogan => |
46
|
|
|
|
|
|
|
(is => 'ro', lazy => 1, init_arg => undef, builder => '_build_hogan'); |
47
|
|
|
|
|
|
|
has _hogan_vars => (is => 'ro', init_arg => 'variables'); |
48
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
Catmandu::Fix::Parser->new; |
50
|
|
|
|
|
|
|
} |
51
|
149
|
|
|
149
|
|
3419
|
|
52
|
|
|
|
|
|
|
my ($self) = @_; |
53
|
|
|
|
|
|
|
my $fixes_arg = $self->_fixes; |
54
|
|
|
|
|
|
|
my $fixes = []; |
55
|
478
|
|
|
478
|
|
3705
|
|
56
|
478
|
|
|
|
|
1512
|
for my $fix (@$fixes_arg) { |
57
|
478
|
|
|
|
|
876
|
|
58
|
|
|
|
|
|
|
if (is_code_ref($fix)) { |
59
|
478
|
|
|
|
|
1120
|
push @$fixes, require_package('Catmandu::Fix::code')->new($fix); |
60
|
|
|
|
|
|
|
} |
61
|
480
|
100
|
100
|
|
|
5011
|
elsif (ref $fix && ref($fix) =~ /^IO::/) { |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
62
|
1
|
|
|
|
|
5
|
my $txt = Catmandu::Util::read_io($fix); |
63
|
|
|
|
|
|
|
$txt = $self->_preprocess($txt); |
64
|
|
|
|
|
|
|
push @$fixes, @{$self->parser->parse($txt)}; |
65
|
1
|
|
|
|
|
4
|
} |
66
|
1
|
|
|
|
|
5
|
elsif (is_glob_ref($fix)) { |
67
|
1
|
|
|
|
|
3
|
my $fh = Catmandu::Util::io($fix, binmode => ':encoding(UTF-8)'); |
|
1
|
|
|
|
|
20
|
|
68
|
|
|
|
|
|
|
my $txt = Catmandu::Util::read_io($fh); |
69
|
|
|
|
|
|
|
$txt = $self->_preprocess($txt); |
70
|
1
|
|
|
|
|
5
|
push @$fixes, @{$self->parser->parse($txt)}; |
71
|
1
|
|
|
|
|
3
|
} |
72
|
1
|
|
|
|
|
4
|
elsif (ref $fix) { |
73
|
1
|
|
|
|
|
2
|
push @$fixes, $fix; |
|
1
|
|
|
|
|
21
|
|
74
|
|
|
|
|
|
|
} |
75
|
|
|
|
|
|
|
elsif (is_string($fix)) { |
76
|
327
|
|
|
|
|
905
|
if ($fix =~ /[^\s]/ && $fix !~ /\(/) { |
77
|
|
|
|
|
|
|
$fix = Path::Tiny::path($fix)->slurp_utf8; |
78
|
|
|
|
|
|
|
} |
79
|
150
|
100
|
66
|
|
|
1158
|
$fix = $self->_preprocess($fix); |
80
|
10
|
|
|
|
|
55
|
push @$fixes, @{$self->parser->parse($fix)}; |
81
|
|
|
|
|
|
|
} |
82
|
150
|
|
|
|
|
11618
|
} |
83
|
150
|
|
|
|
|
5974
|
|
|
150
|
|
|
|
|
2518
|
|
84
|
|
|
|
|
|
|
$fixes; |
85
|
|
|
|
|
|
|
} |
86
|
|
|
|
|
|
|
|
87
|
475
|
|
|
|
|
4339
|
my ($self) = @_; |
88
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
my $reject = $self->_reject; |
90
|
|
|
|
|
|
|
my $sub = $self->_eval_sub( |
91
|
477
|
|
|
477
|
|
4378
|
$self->emit, |
92
|
|
|
|
|
|
|
args => [$self->var], |
93
|
477
|
|
|
|
|
1768
|
captures => $self->_captures |
94
|
477
|
|
|
|
|
1418
|
); |
95
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
sub { |
97
|
|
|
|
|
|
|
my $data = $_[0]; |
98
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
if (is_hash_ref($data)) { |
100
|
|
|
|
|
|
|
my $d = $sub->($data); |
101
|
492
|
|
|
492
|
|
1022
|
return if ref $d && $d == $reject; |
102
|
|
|
|
|
|
|
return $d; |
103
|
492
|
100
|
|
|
|
1706
|
} |
104
|
470
|
|
|
|
|
7991
|
|
105
|
466
|
100
|
66
|
|
|
2554
|
if (is_array_ref($data)) { |
106
|
457
|
|
|
|
|
4671
|
return [grep {!(ref $_ && $_ == $reject)} |
107
|
|
|
|
|
|
|
map {$sub->($_)} @$data]; |
108
|
|
|
|
|
|
|
} |
109
|
22
|
100
|
|
|
|
71
|
|
110
|
16
|
|
66
|
|
|
106
|
if (is_code_ref($data)) { |
111
|
9
|
|
|
|
|
28
|
return sub { |
|
16
|
|
|
|
|
309
|
|
112
|
|
|
|
|
|
|
while (1) { |
113
|
|
|
|
|
|
|
my $d = $sub->($data->() // return); |
114
|
13
|
100
|
|
|
|
39
|
return if ref $d && $d == $reject; |
115
|
|
|
|
|
|
|
return $d; |
116
|
6
|
|
|
|
|
486
|
} |
117
|
6
|
|
100
|
|
|
14
|
}; |
118
|
5
|
50
|
33
|
|
|
37
|
} |
119
|
5
|
|
|
|
|
34
|
|
120
|
|
|
|
|
|
|
if ( is_instance($data) |
121
|
3
|
|
|
|
|
16
|
&& is_able($data, 'does') |
122
|
|
|
|
|
|
|
&& $data->does('Catmandu::Iterable')) |
123
|
|
|
|
|
|
|
{ |
124
|
10
|
100
|
66
|
|
|
51
|
return $data->map(sub {$sub->($_[0])}) |
|
|
|
66
|
|
|
|
|
125
|
|
|
|
|
|
|
->reject(sub {ref $_[0] && $_[0] == $reject}); |
126
|
|
|
|
|
|
|
} |
127
|
|
|
|
|
|
|
|
128
|
24
|
|
|
|
|
428
|
Catmandu::BadArg->throw( |
129
|
9
|
50
|
|
|
|
574
|
"must be hashref, arrayref, coderef or iterable object"); |
|
23
|
|
|
|
|
167
|
|
130
|
|
|
|
|
|
|
}; |
131
|
|
|
|
|
|
|
} |
132
|
|
|
|
|
|
|
|
133
|
1
|
|
|
|
|
12
|
my ($self) = @_; |
134
|
474
|
|
|
|
|
4060
|
$self->capture($self->_reject); |
135
|
|
|
|
|
|
|
} |
136
|
|
|
|
|
|
|
|
137
|
|
|
|
|
|
|
my ($self) = @_; |
138
|
478
|
|
|
478
|
|
3736
|
$self->capture($self->fixes); |
139
|
478
|
|
|
|
|
1139
|
} |
140
|
|
|
|
|
|
|
|
141
|
|
|
|
|
|
|
Text::Hogan::Compiler->new; |
142
|
|
|
|
|
|
|
} |
143
|
0
|
|
|
0
|
|
0
|
|
144
|
0
|
|
|
|
|
0
|
my ($self, $text) = @_; |
145
|
|
|
|
|
|
|
return $text unless $self->preprocess || $self->_hogan_vars; |
146
|
|
|
|
|
|
|
my $vars = $self->_hogan_vars || {}; |
147
|
|
|
|
|
|
|
$self->_hogan->compile($text, {numeric_string_as_string => 1}) |
148
|
1
|
|
|
1
|
|
18
|
->render($vars); |
149
|
|
|
|
|
|
|
} |
150
|
|
|
|
|
|
|
|
151
|
|
|
|
|
|
|
my ($self, $data) = @_; |
152
|
152
|
|
|
152
|
|
359
|
$self->fixer->($data); |
153
|
152
|
100
|
66
|
|
|
1049
|
} |
154
|
1
|
|
50
|
|
|
5
|
|
155
|
1
|
|
|
|
|
27
|
$_[0]->_generate_var; |
156
|
|
|
|
|
|
|
} |
157
|
|
|
|
|
|
|
|
158
|
|
|
|
|
|
|
$_[0]->_generate_label; |
159
|
|
|
|
|
|
|
} |
160
|
495
|
|
|
495
|
1
|
186481
|
|
161
|
495
|
|
|
|
|
8420
|
my ($self, $capture) = @_; |
162
|
|
|
|
|
|
|
my $var = $self->_generate_var; |
163
|
|
|
|
|
|
|
$self->_captures->{$var} = $capture; |
164
|
|
|
|
|
|
|
$var; |
165
|
116
|
|
|
116
|
0
|
286
|
} |
166
|
|
|
|
|
|
|
|
167
|
|
|
|
|
|
|
my ($self) = @_; |
168
|
|
|
|
|
|
|
my $var = $self->var; |
169
|
0
|
|
|
0
|
0
|
0
|
my $err = $self->_generate_var; |
170
|
|
|
|
|
|
|
my $reject_var = $self->_reject_var; |
171
|
|
|
|
|
|
|
my $perl = ""; |
172
|
|
|
|
|
|
|
|
173
|
1418
|
|
|
1418
|
0
|
4119
|
$perl .= "eval {"; |
174
|
1418
|
|
|
|
|
3039
|
|
175
|
1418
|
|
|
|
|
20687
|
# Loop over all the fixes and emit their code |
176
|
1418
|
|
|
|
|
9134
|
$perl .= $self->emit_fixes($self->fixes); |
177
|
|
|
|
|
|
|
|
178
|
|
|
|
|
|
|
$perl .= "return ${var};"; |
179
|
|
|
|
|
|
|
$perl .= $self->_reject_label . ": return ${reject_var};"; |
180
|
478
|
|
|
478
|
0
|
905
|
$perl .= "} or do {"; |
181
|
478
|
|
|
|
|
6862
|
$perl .= $self->_emit_declare_vars($err, '$@'); |
182
|
478
|
|
|
|
|
1160
|
$perl .= "${err}->throw if is_instance(${err},'Throwable::Error');"; |
183
|
478
|
|
|
|
|
6980
|
$perl .= "Catmandu::FixError->throw(message => ${err}, data => ${var});"; |
184
|
478
|
|
|
|
|
847
|
$perl .= "};"; |
185
|
|
|
|
|
|
|
|
186
|
478
|
|
|
|
|
920
|
$self->log->debug($perl); |
187
|
|
|
|
|
|
|
|
188
|
|
|
|
|
|
|
$perl; |
189
|
478
|
|
|
|
|
6786
|
} |
190
|
|
|
|
|
|
|
|
191
|
475
|
|
|
|
|
1134
|
# Emit an array of fixes |
192
|
475
|
|
|
|
|
1343
|
my ($self, $fixes) = @_; |
193
|
475
|
|
|
|
|
867
|
my $perl = ''; |
194
|
475
|
|
|
|
|
1251
|
|
195
|
475
|
|
|
|
|
1242
|
for (my $i = 0; $i < @{$fixes}; $i++) { |
196
|
475
|
|
|
|
|
1255
|
my $fix = $fixes->[$i]; |
197
|
475
|
|
|
|
|
722
|
$perl .= $self->emit_fix($fix); |
198
|
|
|
|
|
|
|
} |
199
|
475
|
|
|
|
|
8329
|
|
200
|
|
|
|
|
|
|
$perl; |
201
|
475
|
|
|
|
|
179697
|
} |
202
|
|
|
|
|
|
|
|
203
|
|
|
|
|
|
|
$_[0]->_emit_reject; |
204
|
|
|
|
|
|
|
} |
205
|
|
|
|
|
|
|
|
206
|
741
|
|
|
741
|
0
|
1445
|
my ($self, $fix) = @_; |
207
|
741
|
|
|
|
|
1149
|
my $perl; |
208
|
|
|
|
|
|
|
|
209
|
741
|
|
|
|
|
1280
|
if ($fix->can('emit')) { |
|
1486
|
|
|
|
|
3543
|
|
210
|
745
|
|
|
|
|
1257
|
$perl = $self->emit_block( |
211
|
745
|
|
|
|
|
1731
|
sub { |
212
|
|
|
|
|
|
|
my ($label) = @_; |
213
|
|
|
|
|
|
|
$fix->emit($self, $label); |
214
|
741
|
|
|
|
|
1917
|
} |
215
|
|
|
|
|
|
|
); |
216
|
|
|
|
|
|
|
} |
217
|
|
|
|
|
|
|
elsif ($fix->can('fix')) { |
218
|
26
|
|
|
26
|
0
|
99
|
my $var = $self->var; |
219
|
|
|
|
|
|
|
my $ref = $self->_generate_var; |
220
|
|
|
|
|
|
|
$self->_captures->{$ref} = $fix; |
221
|
|
|
|
|
|
|
$perl = "${var} = ${ref}->fix(${var});"; |
222
|
870
|
|
|
870
|
0
|
1472
|
} |
223
|
870
|
|
|
|
|
1113
|
else { |
224
|
|
|
|
|
|
|
Catmandu::Error->throw('not a fix'); |
225
|
870
|
100
|
|
|
|
3207
|
} |
|
|
50
|
|
|
|
|
|
226
|
|
|
|
|
|
|
|
227
|
|
|
|
|
|
|
$perl; |
228
|
859
|
|
|
859
|
|
1427
|
} |
229
|
859
|
|
|
|
|
2743
|
|
230
|
|
|
|
|
|
|
my ($self, $cb) = @_; |
231
|
859
|
|
|
|
|
4012
|
my $label = $self->_generate_label; |
232
|
|
|
|
|
|
|
my $perl = "${label}: {"; |
233
|
|
|
|
|
|
|
$perl .= $cb->($label); |
234
|
11
|
|
|
|
|
195
|
$perl .= "};"; |
235
|
11
|
|
|
|
|
117
|
$perl; |
236
|
11
|
|
|
|
|
171
|
} |
237
|
11
|
|
|
|
|
108
|
|
238
|
|
|
|
|
|
|
my ($self, $var) = @_; |
239
|
|
|
|
|
|
|
"undef %{${var}} if is_hash_ref(${var});"; |
240
|
0
|
|
|
|
|
0
|
} |
241
|
|
|
|
|
|
|
|
242
|
|
|
|
|
|
|
shift->_emit_value(@_); |
243
|
870
|
|
|
|
|
3598
|
} |
244
|
|
|
|
|
|
|
|
245
|
|
|
|
|
|
|
shift->_emit_string(@_); |
246
|
|
|
|
|
|
|
} |
247
|
859
|
|
|
859
|
0
|
1485
|
|
248
|
859
|
|
|
|
|
2426
|
my ($self, $pattern) = @_; |
249
|
859
|
|
|
|
|
1612
|
$pattern =~ s/\//\\\//g; |
250
|
859
|
|
|
|
|
1547
|
$pattern =~ s/\\$/\\\\/; # pattern can't end with an escape in m/.../ |
251
|
859
|
|
|
|
|
1381
|
"m/$pattern/"; |
252
|
859
|
|
|
|
|
1594
|
} |
253
|
|
|
|
|
|
|
|
254
|
|
|
|
|
|
|
my ($self, $pattern, $replace) = @_; |
255
|
|
|
|
|
|
|
$pattern =~ s/\//\\\//g; |
256
|
0
|
|
|
0
|
0
|
0
|
$pattern =~ s/\\$/\\\\/; # pattern can't end with an escape in m/.../ |
257
|
0
|
|
|
|
|
0
|
$replace =~ s/\//\\\//g; |
258
|
|
|
|
|
|
|
$replace =~ s/\\$/\\\\/; # pattern can't end with an escape in m/.../ |
259
|
|
|
|
|
|
|
"s/$pattern/$replace/"; |
260
|
|
|
|
|
|
|
} |
261
|
0
|
|
|
0
|
0
|
0
|
|
262
|
|
|
|
|
|
|
shift->_emit_declare_vars(@_); |
263
|
|
|
|
|
|
|
} |
264
|
|
|
|
|
|
|
|
265
|
8
|
|
|
8
|
0
|
26
|
"{"; |
266
|
|
|
|
|
|
|
} |
267
|
|
|
|
|
|
|
|
268
|
|
|
|
|
|
|
"};"; |
269
|
0
|
|
|
0
|
0
|
0
|
} |
270
|
0
|
|
|
|
|
0
|
|
271
|
0
|
|
|
|
|
0
|
my ($self, $var, $cb) = @_; |
272
|
0
|
|
|
|
|
0
|
my $perl = ""; |
273
|
|
|
|
|
|
|
my $v = $self->_generate_var; |
274
|
|
|
|
|
|
|
$perl .= "foreach (\@{${var}}) {"; |
275
|
|
|
|
|
|
|
$perl .= $self->emit_declare_vars($v, '$_'); |
276
|
0
|
|
|
0
|
0
|
0
|
$perl .= $cb->($v); |
277
|
0
|
|
|
|
|
0
|
$perl .= "}"; |
278
|
0
|
|
|
|
|
0
|
$perl; |
279
|
0
|
|
|
|
|
0
|
} |
280
|
0
|
|
|
|
|
0
|
|
281
|
0
|
|
|
|
|
0
|
my ($self, $var, $cb) = @_; |
282
|
|
|
|
|
|
|
my $perl = ""; |
283
|
|
|
|
|
|
|
my $v = $self->_generate_var; |
284
|
|
|
|
|
|
|
$perl .= "foreach (keys(\%{${var}})) {"; |
285
|
4
|
|
|
4
|
0
|
20
|
$perl .= $self->emit_declare_vars($v, '$_'); |
286
|
|
|
|
|
|
|
$perl .= $cb->($v); |
287
|
|
|
|
|
|
|
$perl .= "}"; |
288
|
|
|
|
|
|
|
$perl; |
289
|
0
|
|
|
0
|
0
|
0
|
} |
290
|
|
|
|
|
|
|
|
291
|
|
|
|
|
|
|
my ($self, $var, $keys, $cb) = @_; |
292
|
|
|
|
|
|
|
|
293
|
0
|
|
|
0
|
0
|
0
|
$keys = [@$keys]; # protect keys |
294
|
|
|
|
|
|
|
|
295
|
|
|
|
|
|
|
if (@$keys) { # protect $var |
296
|
|
|
|
|
|
|
my $v = $self->_generate_var; |
297
|
0
|
|
|
0
|
0
|
0
|
$self->_emit_declare_vars($v, $var) |
298
|
0
|
|
|
|
|
0
|
. $self->_emit_walk_path($v, $keys, $cb); |
299
|
0
|
|
|
|
|
0
|
} |
300
|
0
|
|
|
|
|
0
|
else { |
301
|
0
|
|
|
|
|
0
|
$cb->($var); |
302
|
0
|
|
|
|
|
0
|
} |
303
|
0
|
|
|
|
|
0
|
} |
304
|
0
|
|
|
|
|
0
|
|
305
|
|
|
|
|
|
|
my ($self, $var, $keys, $cb) = @_; |
306
|
|
|
|
|
|
|
|
307
|
|
|
|
|
|
|
@$keys || return $cb->($var); |
308
|
4
|
|
|
4
|
0
|
9
|
|
309
|
4
|
|
|
|
|
7
|
my $key = shift @$keys; |
310
|
4
|
|
|
|
|
8
|
my $str_key = $self->emit_string($key); |
311
|
4
|
|
|
|
|
11
|
my $perl = ""; |
312
|
4
|
|
|
|
|
10
|
|
313
|
4
|
|
|
|
|
21
|
if ($key =~ /^[0-9]+$/) { |
314
|
4
|
|
|
|
|
8
|
$perl .= "if (is_hash_ref(${var})) {"; |
315
|
4
|
|
|
|
|
7
|
$perl .= "${var} = ${var}->{${str_key}};"; |
316
|
|
|
|
|
|
|
$perl .= $self->_emit_walk_path($var, [@$keys], $cb); |
317
|
|
|
|
|
|
|
$perl .= "} elsif (is_array_ref(${var}) && \@{${var}} > ${key}) {"; |
318
|
|
|
|
|
|
|
$perl .= "${var} = ${var}->[${key}];"; |
319
|
8
|
|
|
8
|
0
|
85
|
$perl .= $self->_emit_walk_path($var, [@$keys], $cb); |
320
|
|
|
|
|
|
|
$perl .= "}"; |
321
|
8
|
|
|
|
|
14
|
} |
322
|
|
|
|
|
|
|
elsif ($key eq '*') { |
323
|
8
|
100
|
|
|
|
18
|
my $v = $self->_generate_var; |
324
|
6
|
|
|
|
|
14
|
$perl .= "if (is_array_ref(${var})) {"; |
325
|
6
|
|
|
|
|
13
|
$perl .= $self->emit_foreach( |
326
|
|
|
|
|
|
|
$var, |
327
|
|
|
|
|
|
|
sub { |
328
|
|
|
|
|
|
|
return $self->_emit_walk_path(shift, $keys, $cb); |
329
|
2
|
|
|
|
|
5
|
} |
330
|
|
|
|
|
|
|
); |
331
|
|
|
|
|
|
|
$perl .= "}"; |
332
|
|
|
|
|
|
|
} |
333
|
|
|
|
|
|
|
else { |
334
|
12
|
|
|
12
|
|
23
|
if ($key eq '$first') { |
335
|
|
|
|
|
|
|
$perl .= "if (is_array_ref(${var}) && \@{${var}}) {"; |
336
|
12
|
100
|
|
|
|
22
|
$perl .= "${var} = ${var}->[0];"; |
337
|
|
|
|
|
|
|
} |
338
|
6
|
|
|
|
|
12
|
elsif ($key eq '$last') { |
339
|
6
|
|
|
|
|
11
|
$perl .= "if (is_array_ref(${var}) && \@{${var}}) {"; |
340
|
6
|
|
|
|
|
7
|
$perl .= "${var} = ${var}->[\@{${var}} - 1];"; |
341
|
|
|
|
|
|
|
} |
342
|
6
|
50
|
|
|
|
21
|
else { |
|
|
50
|
|
|
|
|
|
343
|
0
|
|
|
|
|
0
|
$perl .= "if (is_hash_ref(${var})) {"; |
344
|
0
|
|
|
|
|
0
|
$perl .= "${var} = ${var}->{${str_key}};"; |
345
|
0
|
|
|
|
|
0
|
} |
346
|
0
|
|
|
|
|
0
|
$perl .= $self->_emit_walk_path($var, $keys, $cb); |
347
|
0
|
|
|
|
|
0
|
$perl .= "}"; |
348
|
0
|
|
|
|
|
0
|
} |
349
|
0
|
|
|
|
|
0
|
|
350
|
|
|
|
|
|
|
$perl; |
351
|
|
|
|
|
|
|
} |
352
|
0
|
|
|
|
|
0
|
|
353
|
0
|
|
|
|
|
0
|
my ($self, $var, $keys, $cb) = @_; |
354
|
|
|
|
|
|
|
$self->_emit_create_path($var, [@$keys], $cb); |
355
|
|
|
|
|
|
|
} |
356
|
|
|
|
|
|
|
|
357
|
0
|
|
|
0
|
|
0
|
my ($self, $var, $keys, $cb) = @_; |
358
|
|
|
|
|
|
|
|
359
|
0
|
|
|
|
|
0
|
@$keys || return $cb->($var); |
360
|
0
|
|
|
|
|
0
|
|
361
|
|
|
|
|
|
|
my $key = shift @$keys; |
362
|
|
|
|
|
|
|
my $str_key = $self->emit_string($key); |
363
|
6
|
50
|
|
|
|
14
|
my $perl = ""; |
|
|
50
|
|
|
|
|
|
364
|
0
|
|
|
|
|
0
|
|
365
|
0
|
|
|
|
|
0
|
if ($key =~ /^[0-9]+$/) { |
366
|
|
|
|
|
|
|
my $v1 = $self->_generate_var; |
367
|
|
|
|
|
|
|
my $v2 = $self->_generate_var; |
368
|
0
|
|
|
|
|
0
|
$perl .= "if (is_hash_ref(${var})) {"; |
369
|
0
|
|
|
|
|
0
|
$perl .= "my ${v1} = ${var};"; |
370
|
|
|
|
|
|
|
$perl |
371
|
|
|
|
|
|
|
.= $self->_emit_create_path("${v1}->{${str_key}}", [@$keys], $cb); |
372
|
6
|
|
|
|
|
14
|
$perl .= "} elsif (is_maybe_array_ref(${var})) {"; |
373
|
6
|
|
|
|
|
10
|
$perl .= "my ${v2} = ${var} //= [];"; |
374
|
|
|
|
|
|
|
$perl .= $self->_emit_create_path("${v2}->[${key}]", [@$keys], $cb); |
375
|
6
|
|
|
|
|
14
|
$perl .= "}"; |
376
|
6
|
|
|
|
|
7
|
} |
377
|
|
|
|
|
|
|
elsif ($key eq '*') { |
378
|
|
|
|
|
|
|
my $v1 = $self->_generate_var; |
379
|
6
|
|
|
|
|
32
|
my $v2 = $self->_generate_var; |
380
|
|
|
|
|
|
|
$perl .= "if (is_array_ref(${var})) {"; |
381
|
|
|
|
|
|
|
$perl .= "my ${v1} = ${var};"; |
382
|
|
|
|
|
|
|
$perl .= "for (my ${v2} = 0; ${v2} < \@{${v1}}; ${v2}++) {"; |
383
|
0
|
|
|
0
|
0
|
0
|
$perl .= $self->_emit_create_path("${v1}->[${v2}]", $keys, $cb); |
384
|
0
|
|
|
|
|
0
|
$perl .= "}"; |
385
|
|
|
|
|
|
|
$perl .= "}"; |
386
|
|
|
|
|
|
|
} |
387
|
|
|
|
|
|
|
else { |
388
|
0
|
|
|
0
|
|
0
|
my $v = $self->_generate_var; |
389
|
|
|
|
|
|
|
if ( $key eq '$first' |
390
|
0
|
0
|
|
|
|
0
|
|| $key eq '$last' |
391
|
|
|
|
|
|
|
|| $key eq '$prepend' |
392
|
0
|
|
|
|
|
0
|
|| $key eq '$append') |
393
|
0
|
|
|
|
|
0
|
{ |
394
|
0
|
|
|
|
|
0
|
$perl .= "if (is_maybe_array_ref(${var})) {"; |
395
|
|
|
|
|
|
|
$perl .= "my ${v} = ${var} //= [];"; |
396
|
0
|
0
|
|
|
|
0
|
if ($key eq '$first') { |
|
|
0
|
|
|
|
|
|
397
|
0
|
|
|
|
|
0
|
$perl .= $self->_emit_create_path("${v}->[0]", $keys, $cb); |
398
|
0
|
|
|
|
|
0
|
} |
399
|
0
|
|
|
|
|
0
|
elsif ($key eq '$last') { |
400
|
0
|
|
|
|
|
0
|
$perl .= "if (\@${v}) {"; |
401
|
0
|
|
|
|
|
0
|
$perl .= $self->_emit_create_path("${v}->[\@${v} - 1]", |
402
|
|
|
|
|
|
|
[@$keys], $cb); |
403
|
0
|
|
|
|
|
0
|
$perl .= "} else {"; |
404
|
0
|
|
|
|
|
0
|
$perl .= $self->_emit_create_path("${v}->[0]", [@$keys], $cb); |
405
|
0
|
|
|
|
|
0
|
$perl .= "}"; |
406
|
0
|
|
|
|
|
0
|
} |
407
|
|
|
|
|
|
|
elsif ($key eq '$prepend') { |
408
|
|
|
|
|
|
|
$perl .= "if (\@${v}) {"; |
409
|
0
|
|
|
|
|
0
|
$perl .= "unshift(\@${v}, undef);"; |
410
|
0
|
|
|
|
|
0
|
$perl .= "}"; |
411
|
0
|
|
|
|
|
0
|
$perl .= $self->_emit_create_path("${v}->[0]", $keys, $cb); |
412
|
0
|
|
|
|
|
0
|
} |
413
|
0
|
|
|
|
|
0
|
elsif ($key eq '$append') { |
414
|
0
|
|
|
|
|
0
|
$perl |
415
|
0
|
|
|
|
|
0
|
.= $self->_emit_create_path("${v}->[\@${v}]", $keys, $cb); |
416
|
0
|
|
|
|
|
0
|
} |
417
|
|
|
|
|
|
|
$perl .= "}"; |
418
|
|
|
|
|
|
|
} |
419
|
0
|
|
|
|
|
0
|
else { |
420
|
0
|
0
|
0
|
|
|
0
|
$perl .= "if (is_maybe_hash_ref(${var})) {"; |
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
421
|
|
|
|
|
|
|
$perl .= "my ${v} = ${var} //= {};"; |
422
|
|
|
|
|
|
|
$perl |
423
|
|
|
|
|
|
|
.= $self->_emit_create_path("${v}->{${str_key}}", $keys, $cb); |
424
|
|
|
|
|
|
|
$perl .= "}"; |
425
|
0
|
|
|
|
|
0
|
} |
426
|
0
|
|
|
|
|
0
|
} |
427
|
0
|
0
|
|
|
|
0
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
428
|
0
|
|
|
|
|
0
|
$perl; |
429
|
|
|
|
|
|
|
} |
430
|
|
|
|
|
|
|
|
431
|
0
|
|
|
|
|
0
|
my ($self, $var, $key, $cb) = @_; |
432
|
0
|
|
|
|
|
0
|
|
433
|
|
|
|
|
|
|
return $cb->($var) unless defined $key; |
434
|
0
|
|
|
|
|
0
|
|
435
|
0
|
|
|
|
|
0
|
my $str_key = $self->emit_string($key); |
436
|
0
|
|
|
|
|
0
|
my $perl = ""; |
437
|
|
|
|
|
|
|
|
438
|
|
|
|
|
|
|
if ($key =~ /^[0-9]+$/) { |
439
|
0
|
|
|
|
|
0
|
$perl .= "if (is_hash_ref(${var}) && exists(${var}->{${str_key}})) {"; |
440
|
0
|
|
|
|
|
0
|
$perl .= $cb->("${var}->{${str_key}}"); |
441
|
0
|
|
|
|
|
0
|
$perl .= "} elsif (is_array_ref(${var}) && \@{${var}} > ${key}) {"; |
442
|
0
|
|
|
|
|
0
|
$perl .= $cb->("${var}->[${key}]"); |
443
|
|
|
|
|
|
|
$perl .= "}"; |
444
|
|
|
|
|
|
|
} |
445
|
0
|
|
|
|
|
0
|
elsif ($key eq '$first') { |
446
|
|
|
|
|
|
|
$perl .= "if (is_array_ref(${var}) && \@{${var}}) {"; |
447
|
|
|
|
|
|
|
$perl .= $cb->("${var}->[0]"); |
448
|
0
|
|
|
|
|
0
|
$perl .= "}"; |
449
|
|
|
|
|
|
|
} |
450
|
|
|
|
|
|
|
elsif ($key eq '$last') { |
451
|
0
|
|
|
|
|
0
|
$perl .= "if (is_array_ref(${var}) && \@{${var}}) {"; |
452
|
0
|
|
|
|
|
0
|
$perl .= $cb->("${var}->[\@{${var}} - 1]"); |
453
|
0
|
|
|
|
|
0
|
$perl .= "}"; |
454
|
|
|
|
|
|
|
} |
455
|
0
|
|
|
|
|
0
|
elsif ($key eq '*') { |
456
|
|
|
|
|
|
|
my $i = $self->_generate_var; |
457
|
|
|
|
|
|
|
$perl .= "if (is_array_ref(${var})) {"; |
458
|
|
|
|
|
|
|
$perl .= "for (my ${i} = 0; ${i} < \@{${var}}; ${i}++) {"; |
459
|
0
|
|
|
|
|
0
|
$perl .= $cb->("${var}->[${i}]", $i); |
460
|
|
|
|
|
|
|
$perl .= "}}"; |
461
|
|
|
|
|
|
|
} |
462
|
|
|
|
|
|
|
else { |
463
|
0
|
|
|
0
|
0
|
0
|
$perl .= "if (is_hash_ref(${var}) && exists(${var}->{${str_key}})) {"; |
464
|
|
|
|
|
|
|
$perl .= $cb->("${var}->{${str_key}}"); |
465
|
0
|
0
|
|
|
|
0
|
$perl .= "}"; |
466
|
|
|
|
|
|
|
} |
467
|
0
|
|
|
|
|
0
|
|
468
|
0
|
|
|
|
|
0
|
$perl; |
469
|
|
|
|
|
|
|
} |
470
|
0
|
0
|
|
|
|
0
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
471
|
0
|
|
|
|
|
0
|
my ($self, $var, $key, $val) = @_; |
472
|
0
|
|
|
|
|
0
|
|
473
|
0
|
|
|
|
|
0
|
return "${var} = $val;" unless defined $key; |
474
|
0
|
|
|
|
|
0
|
|
475
|
0
|
|
|
|
|
0
|
my $perl = ""; |
476
|
|
|
|
|
|
|
my $str_key = $self->emit_string($key); |
477
|
|
|
|
|
|
|
|
478
|
0
|
|
|
|
|
0
|
if ($key =~ /^[0-9]+$/) { |
479
|
0
|
|
|
|
|
0
|
$perl .= "if (is_hash_ref(${var})) {"; |
480
|
0
|
|
|
|
|
0
|
$perl .= "${var}->{${str_key}} = $val;"; |
481
|
|
|
|
|
|
|
$perl .= "} elsif (is_array_ref(${var})) {"; |
482
|
|
|
|
|
|
|
$perl .= "${var}->[${key}] = $val;"; |
483
|
0
|
|
|
|
|
0
|
$perl .= "}"; |
484
|
0
|
|
|
|
|
0
|
} |
485
|
0
|
|
|
|
|
0
|
elsif ($key eq '$first') { |
486
|
|
|
|
|
|
|
$perl .= "if (is_array_ref(${var})) {"; |
487
|
|
|
|
|
|
|
$perl .= "${var}->[0] = $val;"; |
488
|
0
|
|
|
|
|
0
|
$perl .= "}"; |
489
|
0
|
|
|
|
|
0
|
} |
490
|
0
|
|
|
|
|
0
|
elsif ($key eq '$last') { |
491
|
0
|
|
|
|
|
0
|
$perl .= "if (is_array_ref(${var})) {"; |
492
|
0
|
|
|
|
|
0
|
$perl .= "${var}->[\@{${var}} - 1] = $val;"; |
493
|
|
|
|
|
|
|
$perl .= "}"; |
494
|
|
|
|
|
|
|
} |
495
|
0
|
|
|
|
|
0
|
elsif ($key eq '$prepend') { |
496
|
0
|
|
|
|
|
0
|
$perl .= "if (is_array_ref(${var})) {"; |
497
|
0
|
|
|
|
|
0
|
$perl .= "unshift(\@{${var}}, $val);"; |
498
|
|
|
|
|
|
|
$perl .= "}"; |
499
|
|
|
|
|
|
|
} |
500
|
0
|
|
|
|
|
0
|
elsif ($key eq '$append') { |
501
|
|
|
|
|
|
|
$perl .= "if (is_array_ref(${var})) {"; |
502
|
|
|
|
|
|
|
$perl .= "push(\@{${var}}, $val);"; |
503
|
|
|
|
|
|
|
$perl .= "}"; |
504
|
0
|
|
|
0
|
0
|
0
|
} |
505
|
|
|
|
|
|
|
elsif ($key eq '*') { |
506
|
0
|
0
|
|
|
|
0
|
my $i = $self->_generate_var; |
507
|
|
|
|
|
|
|
$perl .= "if (is_array_ref(${var})) {"; |
508
|
0
|
|
|
|
|
0
|
$perl .= "for (my ${i} = 0; ${i} < \@{${var}}; ${i}++) {"; |
509
|
0
|
|
|
|
|
0
|
$perl .= "${var}->[${i}] = $val;"; |
510
|
|
|
|
|
|
|
$perl .= "}}"; |
511
|
0
|
0
|
|
|
|
0
|
} |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
512
|
0
|
|
|
|
|
0
|
else { |
513
|
0
|
|
|
|
|
0
|
$perl .= "if (is_hash_ref(${var})) {"; |
514
|
0
|
|
|
|
|
0
|
$perl .= "${var}->{${str_key}} = $val;"; |
515
|
0
|
|
|
|
|
0
|
$perl .= "}"; |
516
|
0
|
|
|
|
|
0
|
} |
517
|
|
|
|
|
|
|
|
518
|
|
|
|
|
|
|
$perl; |
519
|
0
|
|
|
|
|
0
|
} |
520
|
0
|
|
|
|
|
0
|
|
521
|
0
|
|
|
|
|
0
|
my ($self, $var, $key, $cb) = @_; |
522
|
|
|
|
|
|
|
|
523
|
|
|
|
|
|
|
my $str_key = $self->emit_string($key); |
524
|
0
|
|
|
|
|
0
|
my $perl = ""; |
525
|
0
|
|
|
|
|
0
|
my $vals; |
526
|
0
|
|
|
|
|
0
|
if ($cb) { |
527
|
|
|
|
|
|
|
$vals = $self->_generate_var; |
528
|
|
|
|
|
|
|
$perl = $self->emit_declare_vars($vals, '[]'); |
529
|
0
|
|
|
|
|
0
|
} |
530
|
0
|
|
|
|
|
0
|
|
531
|
0
|
|
|
|
|
0
|
if ($key =~ /^[0-9]+$/) { |
532
|
|
|
|
|
|
|
$perl .= "if (is_hash_ref(${var}) && exists(${var}->{${str_key}})) {"; |
533
|
|
|
|
|
|
|
$perl .= "push(\@{${vals}}, " if $cb; |
534
|
0
|
|
|
|
|
0
|
$perl .= "delete(${var}->{${str_key}})"; |
535
|
0
|
|
|
|
|
0
|
$perl .= ")" if $cb; |
536
|
0
|
|
|
|
|
0
|
$perl .= ";"; |
537
|
|
|
|
|
|
|
$perl .= "} elsif (is_array_ref(${var}) && \@{${var}} > ${key}) {"; |
538
|
|
|
|
|
|
|
$perl .= "push(\@{${vals}}, " if $cb; |
539
|
0
|
|
|
|
|
0
|
$perl .= "splice(\@{${var}}, ${key}, 1)"; |
540
|
0
|
|
|
|
|
0
|
$perl .= ")" if $cb; |
541
|
0
|
|
|
|
|
0
|
} |
542
|
0
|
|
|
|
|
0
|
elsif ($key eq '$first' || $key eq '$last' || $key eq '*') { |
543
|
0
|
|
|
|
|
0
|
$perl .= "if (is_array_ref(${var}) && \@{${var}}) {"; |
544
|
|
|
|
|
|
|
$perl .= "push(\@{${vals}}, " if $cb; |
545
|
|
|
|
|
|
|
$perl .= "splice(\@{${var}}, 0, 1)" if $key eq '$first'; |
546
|
0
|
|
|
|
|
0
|
$perl .= "splice(\@{${var}}, \@{${var}} - 1, 1)" if $key eq '$last'; |
547
|
0
|
|
|
|
|
0
|
$perl .= "splice(\@{${var}}, 0, \@{${var}})" if $key eq '*'; |
548
|
0
|
|
|
|
|
0
|
$perl .= ")" if $cb; |
549
|
|
|
|
|
|
|
} |
550
|
|
|
|
|
|
|
else { |
551
|
0
|
|
|
|
|
0
|
$perl .= "if (is_hash_ref(${var}) && exists(${var}->{${str_key}})) {"; |
552
|
|
|
|
|
|
|
$perl .= "push(\@{${vals}}, " if $cb; |
553
|
|
|
|
|
|
|
$perl .= "delete(${var}->{${str_key}})"; |
554
|
|
|
|
|
|
|
$perl .= ")" if $cb; |
555
|
0
|
|
|
0
|
0
|
0
|
} |
556
|
|
|
|
|
|
|
$perl .= ";"; |
557
|
0
|
|
|
|
|
0
|
$perl .= "}"; |
558
|
0
|
|
|
|
|
0
|
if ($cb) { |
559
|
0
|
|
|
|
|
0
|
$perl .= $cb->($vals); |
560
|
0
|
0
|
|
|
|
0
|
} |
561
|
0
|
|
|
|
|
0
|
|
562
|
0
|
|
|
|
|
0
|
$perl; |
563
|
|
|
|
|
|
|
} |
564
|
|
|
|
|
|
|
|
565
|
0
|
0
|
0
|
|
|
0
|
my ($self, $var, $key) = @_; |
|
|
0
|
0
|
|
|
|
|
566
|
0
|
|
|
|
|
0
|
|
567
|
0
|
0
|
|
|
|
0
|
my $perl = ""; |
568
|
0
|
|
|
|
|
0
|
|
569
|
0
|
0
|
|
|
|
0
|
if ($key =~ /^[0-9]+$/) { |
570
|
0
|
|
|
|
|
0
|
$perl .= "if (is_hash_ref(${var})) {"; |
571
|
0
|
|
|
|
|
0
|
$perl .= $self->emit_foreach_key( |
572
|
0
|
0
|
|
|
|
0
|
$var, |
573
|
0
|
|
|
|
|
0
|
sub { |
574
|
0
|
0
|
|
|
|
0
|
my $v = shift; |
575
|
|
|
|
|
|
|
"delete(${var}->{${v}}) if ${v} ne ${key};"; |
576
|
|
|
|
|
|
|
} |
577
|
0
|
|
|
|
|
0
|
); |
578
|
0
|
0
|
|
|
|
0
|
$perl .= "} elsif (is_array_ref(${var})) {"; |
579
|
0
|
0
|
|
|
|
0
|
$perl .= "if (\@{${var}} > ${key}) {"; |
580
|
0
|
0
|
|
|
|
0
|
$perl .= "splice(\@{${var}}, 0, ${key});" if $key > 0; |
581
|
0
|
0
|
|
|
|
0
|
$perl .= "splice(\@{${var}}, 1, \@{${var}} - 1);"; |
582
|
0
|
0
|
|
|
|
0
|
$perl .= "} else {"; |
583
|
|
|
|
|
|
|
$perl .= "splice(\@{${var}}, 0, \@{${var}});"; |
584
|
|
|
|
|
|
|
$perl .= "}"; |
585
|
0
|
|
|
|
|
0
|
$perl .= "}"; |
586
|
0
|
0
|
|
|
|
0
|
} |
587
|
0
|
|
|
|
|
0
|
elsif ($key eq '$first') { |
588
|
0
|
0
|
|
|
|
0
|
$perl .= "if (is_array_ref(${var}) && \@{${var}} > 1) {"; |
589
|
|
|
|
|
|
|
$perl .= "splice(\@{${var}}, 1, \@{${var}} - 1);"; |
590
|
0
|
|
|
|
|
0
|
$perl .= "}"; |
591
|
0
|
|
|
|
|
0
|
} |
592
|
0
|
0
|
|
|
|
0
|
elsif ($key eq '$last') { |
593
|
0
|
|
|
|
|
0
|
$perl .= "if (is_array_ref(${var}) && \@{${var}} > 1) {"; |
594
|
|
|
|
|
|
|
$perl .= "splice(\@{${var}}, 0, \@{${var}} - 1);"; |
595
|
|
|
|
|
|
|
$perl .= "}"; |
596
|
0
|
|
|
|
|
0
|
} |
597
|
|
|
|
|
|
|
elsif ($key eq '*') { |
598
|
|
|
|
|
|
|
|
599
|
|
|
|
|
|
|
# retain everything |
600
|
8
|
|
|
8
|
0
|
15
|
} |
601
|
|
|
|
|
|
|
else { |
602
|
8
|
|
|
|
|
21
|
$key = $self->emit_string($key); |
603
|
|
|
|
|
|
|
$perl .= "if (is_hash_ref(${var})) {"; |
604
|
8
|
100
|
|
|
|
40
|
$perl .= $self->emit_foreach_key( |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
605
|
2
|
|
|
|
|
4
|
$var, |
606
|
|
|
|
|
|
|
sub { |
607
|
|
|
|
|
|
|
my $v = shift; |
608
|
|
|
|
|
|
|
"if ($v ne ${key}) {" . "delete(${var}->{${v}});" . "}"; |
609
|
2
|
|
|
2
|
|
3
|
} |
610
|
2
|
|
|
|
|
7
|
); |
611
|
|
|
|
|
|
|
$perl .= "}"; |
612
|
2
|
|
|
|
|
10
|
} |
613
|
2
|
|
|
|
|
9
|
|
614
|
2
|
|
|
|
|
5
|
$perl; |
615
|
2
|
50
|
|
|
|
8
|
} |
616
|
2
|
|
|
|
|
5
|
|
617
|
2
|
|
|
|
|
4
|
my ($self, $var) = @_; |
618
|
2
|
|
|
|
|
4
|
"$var = clone($var);"; |
619
|
2
|
|
|
|
|
3
|
} |
620
|
2
|
|
|
|
|
3
|
|
621
|
|
|
|
|
|
|
# Split a path on '.' or '/', but not on '\.' or '\/'. |
622
|
|
|
|
|
|
|
my ($self, $path) = @_; |
623
|
1
|
|
|
|
|
4
|
Catmandu::Util::split_path($path); |
624
|
1
|
|
|
|
|
3
|
} |
625
|
1
|
|
|
|
|
1
|
|
626
|
|
|
|
|
|
|
1; |
627
|
|
|
|
|
|
|
|
628
|
1
|
|
|
|
|
4
|
|
629
|
1
|
|
|
|
|
4
|
=pod |
630
|
1
|
|
|
|
|
1
|
|
631
|
|
|
|
|
|
|
=head1 NAME |
632
|
|
|
|
|
|
|
|
633
|
|
|
|
|
|
|
Catmandu::Fix - a Catmandu class used for data transformations |
634
|
|
|
|
|
|
|
|
635
|
|
|
|
|
|
|
=head1 SYNOPSIS |
636
|
|
|
|
|
|
|
|
637
|
2
|
|
|
|
|
6
|
# From the command line |
638
|
2
|
|
|
|
|
6
|
|
639
|
|
|
|
|
|
|
$ catmandu convert JSON --fix 'add(foo,bar)' < data.json |
640
|
|
|
|
|
|
|
$ catmandu convert YAML --fix 'upcase(job) remove(test)' < data.yml |
641
|
|
|
|
|
|
|
$ catmandu convert CSV --fix 'sort(tags)' < data.csv |
642
|
2
|
|
|
2
|
|
4
|
$ catmandu run /tmp/myfixes.txt |
643
|
2
|
|
|
|
|
8
|
$ catmandu convert OAI --url http://biblio.ugent.be/oai --fix /tmp/myfixes.txt |
644
|
|
|
|
|
|
|
|
645
|
2
|
|
|
|
|
10
|
# With preprocessing |
646
|
2
|
|
|
|
|
9
|
$ catmandu convert JSON --var field=foo --fix 'add({{field}},bar)' < data.json |
647
|
|
|
|
|
|
|
|
648
|
|
|
|
|
|
|
# From Perl |
649
|
8
|
|
|
|
|
25
|
|
650
|
|
|
|
|
|
|
use Catmandu; |
651
|
|
|
|
|
|
|
|
652
|
|
|
|
|
|
|
my $fixer = Catmandu->fixer('upcase(job)','removed(test)'); |
653
|
0
|
|
|
0
|
0
|
0
|
my $fixer = Catmandu->fixer('/tmp/myfixes.txt'); |
654
|
0
|
|
|
|
|
0
|
|
655
|
|
|
|
|
|
|
# Convert data |
656
|
|
|
|
|
|
|
my $arr = $fixer->fix([ ... ]); |
657
|
|
|
|
|
|
|
my $hash = $fixer->fix({ ... }); |
658
|
|
|
|
|
|
|
my $importer = Catmandu->importer('YAML', file => 'data.yml'); |
659
|
8
|
|
|
8
|
0
|
11
|
my $fixed_importer = $fixer->fix($importer); |
660
|
8
|
|
|
|
|
22
|
|
661
|
|
|
|
|
|
|
# With preprocessing |
662
|
|
|
|
|
|
|
my $fixer = Catmandu::Fix->new( |
663
|
|
|
|
|
|
|
variables => {x => 'foo', y => 'bar'}, |
664
|
|
|
|
|
|
|
fixes => ['add({{x}},{{y}})'], |
665
|
|
|
|
|
|
|
); |
666
|
|
|
|
|
|
|
|
667
|
|
|
|
|
|
|
# Inline fixes |
668
|
|
|
|
|
|
|
use Catmandu::Fix::upcase as => 'my_upcase'; |
669
|
|
|
|
|
|
|
use Catmandu::Fix::remove as => 'my_remove'; |
670
|
|
|
|
|
|
|
|
671
|
|
|
|
|
|
|
my $hash = { 'job' => 'librarian' , deep => { nested => '1'} }; |
672
|
|
|
|
|
|
|
|
673
|
|
|
|
|
|
|
my_upcase($hash,'job'); |
674
|
|
|
|
|
|
|
my_remove($hash,'deep.nested'); |
675
|
|
|
|
|
|
|
|
676
|
|
|
|
|
|
|
=head1 DESCRIPTION |
677
|
|
|
|
|
|
|
|
678
|
|
|
|
|
|
|
A Catmandu::Fix is a Perl package that can transform data. These packages are used |
679
|
|
|
|
|
|
|
for easy data manipulation by non programmers. The main intention is to use fixes |
680
|
|
|
|
|
|
|
on the command line or in Fix scripts. A small DSL language is available to execute |
681
|
|
|
|
|
|
|
many Fix command on a stream of data. |
682
|
|
|
|
|
|
|
|
683
|
|
|
|
|
|
|
When a C<fix> argument is given to a L<Catmandu::Importer>, L<Catmandu::Exporter> or |
684
|
|
|
|
|
|
|
L<Catmandu::Store> then the transformations are executed on every item in the stream. |
685
|
|
|
|
|
|
|
|
686
|
|
|
|
|
|
|
=head1 FIX LANGUAGE |
687
|
|
|
|
|
|
|
|
688
|
|
|
|
|
|
|
A Fix script is a collection of one or more Fix commands. The fixes are executed |
689
|
|
|
|
|
|
|
on every record in the dataset. If this command is executed on the command line: |
690
|
|
|
|
|
|
|
|
691
|
|
|
|
|
|
|
$ catmandu convert JSON --fix 'upcase(title); add(deep.nested.field,1)' < data.json |
692
|
|
|
|
|
|
|
|
693
|
|
|
|
|
|
|
then all the title fields will be upcased and a new deeply nested field will be added: |
694
|
|
|
|
|
|
|
|
695
|
|
|
|
|
|
|
{ "title":"foo" } |
696
|
|
|
|
|
|
|
{ "title":"bar" } |
697
|
|
|
|
|
|
|
|
698
|
|
|
|
|
|
|
becomes: |
699
|
|
|
|
|
|
|
|
700
|
|
|
|
|
|
|
{ "title":"FOO" , "deep":{"nested":{"field":1}} } |
701
|
|
|
|
|
|
|
{ "title":"BAR" , "deep":{"nested":{"field":1}} } |
702
|
|
|
|
|
|
|
|
703
|
|
|
|
|
|
|
Using the command line, Fix commands need a semicolon (;) as separator. All these commands can |
704
|
|
|
|
|
|
|
also be written into a Fix script where semicolons are not required: |
705
|
|
|
|
|
|
|
|
706
|
|
|
|
|
|
|
$ catmandu convert JSON --fix script.fix < data.json |
707
|
|
|
|
|
|
|
|
708
|
|
|
|
|
|
|
where C<script.fix> contains: |
709
|
|
|
|
|
|
|
|
710
|
|
|
|
|
|
|
upcase(title) |
711
|
|
|
|
|
|
|
add(deep.nested.field,1) |
712
|
|
|
|
|
|
|
|
713
|
|
|
|
|
|
|
Conditionals can be used to provide the logic when to execute fixes: |
714
|
|
|
|
|
|
|
|
715
|
|
|
|
|
|
|
if exists(error) |
716
|
|
|
|
|
|
|
set(valid, 0) |
717
|
|
|
|
|
|
|
end |
718
|
|
|
|
|
|
|
|
719
|
|
|
|
|
|
|
if exists(error) |
720
|
|
|
|
|
|
|
set(is_valid, 0) |
721
|
|
|
|
|
|
|
elsif exists(warning) |
722
|
|
|
|
|
|
|
set(is_valid, 1) |
723
|
|
|
|
|
|
|
log(...) |
724
|
|
|
|
|
|
|
else |
725
|
|
|
|
|
|
|
set(is_valid, 1) |
726
|
|
|
|
|
|
|
end |
727
|
|
|
|
|
|
|
|
728
|
|
|
|
|
|
|
unless all_match(title, "PERL") |
729
|
|
|
|
|
|
|
add(is_perl, "noooo") |
730
|
|
|
|
|
|
|
end |
731
|
|
|
|
|
|
|
|
732
|
|
|
|
|
|
|
exists(error) and set(is_valid, 0) |
733
|
|
|
|
|
|
|
exists(error) && set(is_valid, 0) |
734
|
|
|
|
|
|
|
|
735
|
|
|
|
|
|
|
exists(title) or log('title missing') |
736
|
|
|
|
|
|
|
exists(title) || log('title missing') |
737
|
|
|
|
|
|
|
|
738
|
|
|
|
|
|
|
Binds are used to manipulate the context in which Fixes are executed. E.g. |
739
|
|
|
|
|
|
|
execute a fix on every item in a list: |
740
|
|
|
|
|
|
|
|
741
|
|
|
|
|
|
|
# 'demo' is an array of hashes |
742
|
|
|
|
|
|
|
bind list(path:demo) |
743
|
|
|
|
|
|
|
add_field(foo,bar) |
744
|
|
|
|
|
|
|
end |
745
|
|
|
|
|
|
|
# do is an alias for bind |
746
|
|
|
|
|
|
|
do list(path:demo) |
747
|
|
|
|
|
|
|
add_field(foo,bar) |
748
|
|
|
|
|
|
|
end |
749
|
|
|
|
|
|
|
|
750
|
|
|
|
|
|
|
To delete records from a stream of data the C<reject> Fix can be used: |
751
|
|
|
|
|
|
|
|
752
|
|
|
|
|
|
|
reject() # Reject all in the stream |
753
|
|
|
|
|
|
|
|
754
|
|
|
|
|
|
|
if exists(foo) |
755
|
|
|
|
|
|
|
reject() # Reject records that contain a 'foo' field |
756
|
|
|
|
|
|
|
end |
757
|
|
|
|
|
|
|
|
758
|
|
|
|
|
|
|
reject exists(foo) # Reject records that contain a 'foo' field |
759
|
|
|
|
|
|
|
|
760
|
|
|
|
|
|
|
The opposite of C<reject> is C<select>: |
761
|
|
|
|
|
|
|
|
762
|
|
|
|
|
|
|
select() # Keep all records in the stream |
763
|
|
|
|
|
|
|
|
764
|
|
|
|
|
|
|
select exists(foo) # Keep only the records that contain a 'foo' field |
765
|
|
|
|
|
|
|
|
766
|
|
|
|
|
|
|
Comments in Fix scripts are all lines (or parts of a line) that start with a hash (#): |
767
|
|
|
|
|
|
|
|
768
|
|
|
|
|
|
|
# This is ignored |
769
|
|
|
|
|
|
|
add(test,123) # This is also a comment |
770
|
|
|
|
|
|
|
|
771
|
|
|
|
|
|
|
You can load fixes from another namespace with the C<use> statement: |
772
|
|
|
|
|
|
|
|
773
|
|
|
|
|
|
|
# this will look for fixes in the Foo::Bar namespace and make them |
774
|
|
|
|
|
|
|
# available prefixed by fb |
775
|
|
|
|
|
|
|
use(foo.bar, as: fb) |
776
|
|
|
|
|
|
|
fb.baz() |
777
|
|
|
|
|
|
|
|
778
|
|
|
|
|
|
|
# this will look for Foo::Bar::Condition::is_baz |
779
|
|
|
|
|
|
|
if fb.is_baz() |
780
|
|
|
|
|
|
|
... |
781
|
|
|
|
|
|
|
fix() |
782
|
|
|
|
|
|
|
... |
783
|
|
|
|
|
|
|
end |
784
|
|
|
|
|
|
|
|
785
|
|
|
|
|
|
|
=head1 FIX COMMANDS, ARGUMENTS AND OPTIONS |
786
|
|
|
|
|
|
|
|
787
|
|
|
|
|
|
|
Fix commands manipulate data or in some cases execute side effects. Fix |
788
|
|
|
|
|
|
|
commands have zero or more arguments and zero or more options. Fix command |
789
|
|
|
|
|
|
|
arguments are separated by commas ",". Fix options are name/value pairs |
790
|
|
|
|
|
|
|
separated by a colon ":". |
791
|
|
|
|
|
|
|
|
792
|
|
|
|
|
|
|
# A command with zero arguments |
793
|
|
|
|
|
|
|
my_command() |
794
|
|
|
|
|
|
|
|
795
|
|
|
|
|
|
|
# A command with multiple arguments |
796
|
|
|
|
|
|
|
my_other_command(foo,bar,test) |
797
|
|
|
|
|
|
|
|
798
|
|
|
|
|
|
|
# A command with optional arguments |
799
|
|
|
|
|
|
|
my_special_command(foo,bar,color:blue,size:12) |
800
|
|
|
|
|
|
|
|
801
|
|
|
|
|
|
|
All command arguments are treated as strings. These strings can be FIX PATHs |
802
|
|
|
|
|
|
|
pointing to values or string literals. When command line arguments don't contain |
803
|
|
|
|
|
|
|
special characters comma "," , equal "=" , great than ">" or colon ":", then |
804
|
|
|
|
|
|
|
they can be written as-is. Otherwise, the arguments need to be quoted with single |
805
|
|
|
|
|
|
|
or double quotes: |
806
|
|
|
|
|
|
|
|
807
|
|
|
|
|
|
|
# Both commands below have the same effect |
808
|
|
|
|
|
|
|
my_other_command(foo,bar,test) |
809
|
|
|
|
|
|
|
my_other_command("foo","bar","test") |
810
|
|
|
|
|
|
|
|
811
|
|
|
|
|
|
|
# Illegal syntax |
812
|
|
|
|
|
|
|
my_special_command(foo,http://test.org,color:blue,size:12) # <- syntax error |
813
|
|
|
|
|
|
|
|
814
|
|
|
|
|
|
|
# Correct syntax |
815
|
|
|
|
|
|
|
my_special_command(foo,"http://test.org",color:blue,size:12) |
816
|
|
|
|
|
|
|
|
817
|
|
|
|
|
|
|
# Or, alternative |
818
|
|
|
|
|
|
|
my_special_command("foo","http://test.org",color:"blue",size:12) |
819
|
|
|
|
|
|
|
|
820
|
|
|
|
|
|
|
=head1 FIX PATHS |
821
|
|
|
|
|
|
|
|
822
|
|
|
|
|
|
|
Most of the Fix commands use paths to point to values |
823
|
|
|
|
|
|
|
in a data record. E.g. 'foo.2.bar' is a key 'bar' which is the 3-rd value of the |
824
|
|
|
|
|
|
|
key 'foo'. |
825
|
|
|
|
|
|
|
|
826
|
|
|
|
|
|
|
A special case is when you want to point to all items in an array. In this case |
827
|
|
|
|
|
|
|
the wildcard '*' can be used. E.g. 'foo.*' points to all the items in the 'foo' |
828
|
|
|
|
|
|
|
array. |
829
|
|
|
|
|
|
|
|
830
|
|
|
|
|
|
|
For array values there are special wildcards available: |
831
|
|
|
|
|
|
|
|
832
|
|
|
|
|
|
|
* $append - Add a new item at the end of an array |
833
|
|
|
|
|
|
|
* $prepend - Add a new item at the start of an array |
834
|
|
|
|
|
|
|
* $first - Syntactic sugar for index '0' (the head of the array) |
835
|
|
|
|
|
|
|
* $last - Syntactic sugar for index '-1' (the tail of the array) |
836
|
|
|
|
|
|
|
|
837
|
|
|
|
|
|
|
E.g. |
838
|
|
|
|
|
|
|
|
839
|
|
|
|
|
|
|
# Create { mods => { titleInfo => [ { 'title' => 'a title' }] } }; |
840
|
|
|
|
|
|
|
add('mods.titleInfo.$append.title', 'a title'); |
841
|
|
|
|
|
|
|
|
842
|
|
|
|
|
|
|
# Create { mods => { titleInfo => [ { 'title' => 'a title' } , { 'title' => 'another title' }] } }; |
843
|
|
|
|
|
|
|
add('mods.titleInfo.$append.title', 'another title'); |
844
|
|
|
|
|
|
|
|
845
|
|
|
|
|
|
|
# Create { mods => { titleInfo => [ { 'title' => 'foo' } , { 'title' => 'another title' }] } }; |
846
|
|
|
|
|
|
|
add('mods.titleInfo.$first.title', 'foo'); |
847
|
|
|
|
|
|
|
|
848
|
|
|
|
|
|
|
# Create { mods => { titleInfo => [ { 'title' => 'foo' } , { 'title' => 'bar' }] } }; |
849
|
|
|
|
|
|
|
add('mods.titleInfo.$last.title', 'bar'); |
850
|
|
|
|
|
|
|
|
851
|
|
|
|
|
|
|
Some Fix commands can implement an alternatice path syntax to point to values. |
852
|
|
|
|
|
|
|
See for example L<Catmandu::MARC>, L<Catmandu:PICA>: |
853
|
|
|
|
|
|
|
|
854
|
|
|
|
|
|
|
# Copy the MARC 245a field to the my.title field |
855
|
|
|
|
|
|
|
marc_map(245a,my.title) |
856
|
|
|
|
|
|
|
|
857
|
|
|
|
|
|
|
=head1 OPTIONS |
858
|
|
|
|
|
|
|
|
859
|
|
|
|
|
|
|
=head2 fixes |
860
|
|
|
|
|
|
|
|
861
|
|
|
|
|
|
|
An array of fixes. L<Catmandu::Fix> which will execute every fix in consecutive |
862
|
|
|
|
|
|
|
order. A fix can be the name of a Catmandu::Fix::* routine, or the path to a |
863
|
|
|
|
|
|
|
plain text file containing all the fixes to be executed. Required. |
864
|
|
|
|
|
|
|
|
865
|
|
|
|
|
|
|
=head2 preprocess |
866
|
|
|
|
|
|
|
|
867
|
|
|
|
|
|
|
If set to C<1>, fix files or inline fixes will first be preprocessed as a |
868
|
|
|
|
|
|
|
moustache template. See C<variables> below for an example. Default is C<0>, no |
869
|
|
|
|
|
|
|
preprocessing. |
870
|
|
|
|
|
|
|
|
871
|
|
|
|
|
|
|
=head2 variables |
872
|
|
|
|
|
|
|
|
873
|
|
|
|
|
|
|
An optional hashref of variables that are used to preprocess the fix files or |
874
|
|
|
|
|
|
|
inline fixes as a moustache template. Setting the C<variables> option also sets |
875
|
|
|
|
|
|
|
C<preprocess> to 1. |
876
|
|
|
|
|
|
|
|
877
|
|
|
|
|
|
|
my $fixer = Catmandu::Fix->new( |
878
|
|
|
|
|
|
|
variables => {x => 'foo', y => 'bar'}, |
879
|
|
|
|
|
|
|
fixes => ['add({{x}},{{y}})'], |
880
|
|
|
|
|
|
|
); |
881
|
|
|
|
|
|
|
my $data = {}; |
882
|
|
|
|
|
|
|
$fixer->fix($data); |
883
|
|
|
|
|
|
|
# $data is now {foo => 'bar'} |
884
|
|
|
|
|
|
|
|
885
|
|
|
|
|
|
|
=head1 METHODS |
886
|
|
|
|
|
|
|
|
887
|
|
|
|
|
|
|
=head2 fix(HASH) |
888
|
|
|
|
|
|
|
|
889
|
|
|
|
|
|
|
Execute all the fixes on a HASH. Returns the fixed HASH. |
890
|
|
|
|
|
|
|
|
891
|
|
|
|
|
|
|
=head2 fix(ARRAY) |
892
|
|
|
|
|
|
|
|
893
|
|
|
|
|
|
|
Execute all the fixes on every element in the ARRAY. Returns an ARRAY of fixes. |
894
|
|
|
|
|
|
|
|
895
|
|
|
|
|
|
|
=head2 fix(Catmandu::Iterator) |
896
|
|
|
|
|
|
|
|
897
|
|
|
|
|
|
|
Execute all the fixes on every item in an L<Catmandu::Iterator>. Returns a |
898
|
|
|
|
|
|
|
(lazy) iterator on all the fixes. |
899
|
|
|
|
|
|
|
|
900
|
|
|
|
|
|
|
=head2 fix(sub {}) |
901
|
|
|
|
|
|
|
|
902
|
|
|
|
|
|
|
Executes all the fixes on a generator function. Returns a new generator with fixed data. |
903
|
|
|
|
|
|
|
|
904
|
|
|
|
|
|
|
=head2 log |
905
|
|
|
|
|
|
|
|
906
|
|
|
|
|
|
|
Return the current logger. See L<Catmandu> for activating the logger in your main code. |
907
|
|
|
|
|
|
|
|
908
|
|
|
|
|
|
|
=head1 CODING |
909
|
|
|
|
|
|
|
|
910
|
|
|
|
|
|
|
One can extend the Fix language by creating own custom-made fixes. Three methods are |
911
|
|
|
|
|
|
|
available to create an new fix function: |
912
|
|
|
|
|
|
|
|
913
|
|
|
|
|
|
|
* Simplest: create a class that implements a C<fix> method. |
914
|
|
|
|
|
|
|
* For most use cases: create a class that consumes the C<Catmandu::Fix::Builder> role and use C<Catmandu::Path> to build your fixer. |
915
|
|
|
|
|
|
|
* Hardest: create a class that emits Perl code that will be evaled by the Fix module. |
916
|
|
|
|
|
|
|
|
917
|
|
|
|
|
|
|
Both methods will be explained shortly. |
918
|
|
|
|
|
|
|
|
919
|
|
|
|
|
|
|
=head2 Quick and easy |
920
|
|
|
|
|
|
|
|
921
|
|
|
|
|
|
|
A Fix function is a Perl class in the C<Catmandu::Fix> namespace that implements a C<fix> method. |
922
|
|
|
|
|
|
|
The C<fix> methods accepts a Perl hash as input and returns a (fixed) Perl hash as output. As |
923
|
|
|
|
|
|
|
an example, the code belows implements the C<meow> Fix which inserts a 'meow' field with value 'purrrrr'. |
924
|
|
|
|
|
|
|
|
925
|
|
|
|
|
|
|
package Catmandu::Fix::meow; |
926
|
|
|
|
|
|
|
|
927
|
|
|
|
|
|
|
use Moo; |
928
|
|
|
|
|
|
|
|
929
|
|
|
|
|
|
|
sub fix { |
930
|
|
|
|
|
|
|
my ($self,$data) = @_; |
931
|
|
|
|
|
|
|
$data->{meow} = 'purrrrr'; |
932
|
|
|
|
|
|
|
$data; |
933
|
|
|
|
|
|
|
} |
934
|
|
|
|
|
|
|
|
935
|
|
|
|
|
|
|
1; |
936
|
|
|
|
|
|
|
|
937
|
|
|
|
|
|
|
Given this Perl class, the following fix statement can be used in your application: |
938
|
|
|
|
|
|
|
|
939
|
|
|
|
|
|
|
# Will add 'meow' = 'purrrrr' to the data |
940
|
|
|
|
|
|
|
meow() |
941
|
|
|
|
|
|
|
|
942
|
|
|
|
|
|
|
Use the quick and easy method when your fixes are not dependent on reading or writing data |
943
|
|
|
|
|
|
|
from/to a JSON path. Your Perl classes need to implement their own logic to read or write data |
944
|
|
|
|
|
|
|
into the given Perl hash. |
945
|
|
|
|
|
|
|
|
946
|
|
|
|
|
|
|
Fix arguments are passed as arguments to the C<new> function of the Perl class. As in |
947
|
|
|
|
|
|
|
|
948
|
|
|
|
|
|
|
# In the fix file... |
949
|
|
|
|
|
|
|
meow('test123', count: 4) |
950
|
|
|
|
|
|
|
|
951
|
|
|
|
|
|
|
# ...will be translated into this pseudo code |
952
|
|
|
|
|
|
|
my $fix = Catmandu::Fix::meow->new('test123', count: 4); |
953
|
|
|
|
|
|
|
|
954
|
|
|
|
|
|
|
Using L<Moo> these arguments can be catched with L<Catmandu::Fix::Has> package: |
955
|
|
|
|
|
|
|
|
956
|
|
|
|
|
|
|
package Catmandu::Fix::meow; |
957
|
|
|
|
|
|
|
|
958
|
|
|
|
|
|
|
use Catmandu::Sane; |
959
|
|
|
|
|
|
|
use Moo; |
960
|
|
|
|
|
|
|
use Catmandu::Fix::Has; |
961
|
|
|
|
|
|
|
|
962
|
|
|
|
|
|
|
has msg => (fix_arg => 1); # required parameter 1 |
963
|
|
|
|
|
|
|
has count => (fix_opt => 1, default => sub { 4 }); # optional parameter 'count' with default value 4 |
964
|
|
|
|
|
|
|
|
965
|
|
|
|
|
|
|
sub fix { |
966
|
|
|
|
|
|
|
my ($self,$data) = @_; |
967
|
|
|
|
|
|
|
$data->{meow} = $self->msg x $self->count; |
968
|
|
|
|
|
|
|
$data; |
969
|
|
|
|
|
|
|
} |
970
|
|
|
|
|
|
|
|
971
|
|
|
|
|
|
|
1; |
972
|
|
|
|
|
|
|
|
973
|
|
|
|
|
|
|
Using this code the fix statement can be used like: |
974
|
|
|
|
|
|
|
|
975
|
|
|
|
|
|
|
# Will add 'meow' = 'purrpurrpurrpurr' |
976
|
|
|
|
|
|
|
meow('purr', count: 4) |
977
|
|
|
|
|
|
|
|
978
|
|
|
|
|
|
|
=head1 SEE ALSO |
979
|
|
|
|
|
|
|
|
980
|
|
|
|
|
|
|
L<Catmandu::Fixable>, |
981
|
|
|
|
|
|
|
L<Catmandu::Importer>, |
982
|
|
|
|
|
|
|
L<Catmandu::Exporter>, |
983
|
|
|
|
|
|
|
L<Catmandu::Store>, |
984
|
|
|
|
|
|
|
L<Catmandu::Bag> |
985
|
|
|
|
|
|
|
|
986
|
|
|
|
|
|
|
=cut |