line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
12
|
|
|
12
|
|
793
|
use 5.008; |
|
12
|
|
|
|
|
47
|
|
2
|
12
|
|
|
12
|
|
74
|
use strict; |
|
12
|
|
|
|
|
29
|
|
|
12
|
|
|
|
|
300
|
|
3
|
12
|
|
|
12
|
|
59
|
use warnings; |
|
12
|
|
|
|
|
28
|
|
|
12
|
|
|
|
|
795
|
|
4
|
|
|
|
|
|
|
|
5
|
|
|
|
|
|
|
|
6
|
|
|
|
|
|
|
our $AUTHORITY = 'cpan:TOBYINK'; |
7
|
|
|
|
|
|
|
our $VERSION = '0.045'; |
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
use Sub::HandlesVia::HandlerLibrary; |
10
|
12
|
|
|
12
|
|
3343
|
our @ISA = 'Sub::HandlesVia::HandlerLibrary'; |
|
12
|
|
|
|
|
30
|
|
|
12
|
|
|
|
|
617
|
|
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
use Sub::HandlesVia::Handler qw( handler ); |
13
|
12
|
|
|
12
|
|
83
|
use Types::Standard qw( HashRef ArrayRef Optional Str CodeRef Item Any Ref Defined RegexpRef ); |
|
12
|
|
|
|
|
27
|
|
|
12
|
|
|
|
|
110
|
|
14
|
12
|
|
|
12
|
|
1211
|
|
|
12
|
|
|
|
|
29
|
|
|
12
|
|
|
|
|
67
|
|
15
|
|
|
|
|
|
|
our @METHODS = qw( all accessor clear count defined delete elements exists get |
16
|
|
|
|
|
|
|
is_empty keys kv set shallow_clone values sorted_keys reset delete_where |
17
|
|
|
|
|
|
|
for_each_key for_each_value for_each_pair ); |
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
my ($me, $type) = @_; |
20
|
|
|
|
|
|
|
if ($type == HashRef or $type == Ref or $type == Ref['HASH']) { |
21
|
194
|
|
|
194
|
|
476
|
return { |
22
|
194
|
50
|
66
|
|
|
630
|
trust_mutated => 'always', |
|
|
|
66
|
|
|
|
|
23
|
|
|
|
|
|
|
}; |
24
|
29
|
|
|
|
|
2383
|
} |
25
|
|
|
|
|
|
|
if ($type->is_parameterized and $type->parent->name eq 'HashRef' and $type->parent->library eq 'Types::Standard') { |
26
|
|
|
|
|
|
|
return { |
27
|
165
|
50
|
66
|
|
|
566860
|
trust_mutated => 'maybe', |
|
|
|
66
|
|
|
|
|
28
|
|
|
|
|
|
|
value_type => $type->type_parameter, |
29
|
80
|
|
|
|
|
5872
|
key_type => Str, |
30
|
|
|
|
|
|
|
}; |
31
|
|
|
|
|
|
|
} |
32
|
|
|
|
|
|
|
if ($type->is_parameterized and $type->parent->name eq 'Map' and $type->parent->library eq 'Types::Standard') { |
33
|
|
|
|
|
|
|
return { |
34
|
85
|
0
|
33
|
|
|
5093
|
trust_mutated => 'maybe', |
|
|
|
33
|
|
|
|
|
35
|
|
|
|
|
|
|
value_type => $type->parameters->[1], |
36
|
0
|
|
|
|
|
0
|
key_type => $type->parameters->[0], |
37
|
|
|
|
|
|
|
}; |
38
|
|
|
|
|
|
|
} |
39
|
|
|
|
|
|
|
return $me->SUPER::_type_inspector($type); |
40
|
|
|
|
|
|
|
} |
41
|
85
|
|
|
|
|
777
|
|
42
|
|
|
|
|
|
|
my $additional_validation_for_set_and_insert = sub { |
43
|
|
|
|
|
|
|
my $self = CORE::shift; |
44
|
|
|
|
|
|
|
my ($sig_was_checked, $gen) = @_; |
45
|
|
|
|
|
|
|
my $ti = __PACKAGE__->_type_inspector($gen->isa); |
46
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
if ($ti and $ti->{trust_mutated} eq 'always') { |
48
|
|
|
|
|
|
|
return { code => '1;', env => {} }; |
49
|
|
|
|
|
|
|
} |
50
|
|
|
|
|
|
|
if ($ti and $ti->{trust_mutated} eq 'maybe') { |
51
|
|
|
|
|
|
|
my ( $env, $code, $arg ); |
52
|
|
|
|
|
|
|
$env = {}; |
53
|
|
|
|
|
|
|
$arg = sub { |
54
|
|
|
|
|
|
|
my $gen = shift; |
55
|
|
|
|
|
|
|
return '$shv_key' if $_[0]=='1'; |
56
|
|
|
|
|
|
|
return '$shv_value' if $_[0]=='2'; |
57
|
|
|
|
|
|
|
$gen->generate_arg( @_ ); |
58
|
|
|
|
|
|
|
}; |
59
|
|
|
|
|
|
|
$code = sprintf( |
60
|
|
|
|
|
|
|
'my($shv_key,$shv_value)=%s; if (%s>0) { %s }; if (%s>1) { %s };', |
61
|
|
|
|
|
|
|
$gen->generate_args, |
62
|
|
|
|
|
|
|
$gen->generate_argc, |
63
|
|
|
|
|
|
|
$gen->generate_type_assertion( $env, $ti->{key_type} || Str, '$shv_key' ), |
64
|
|
|
|
|
|
|
$gen->generate_argc, |
65
|
|
|
|
|
|
|
$gen->generate_type_assertion( $env, $ti->{value_type}, '$shv_value' ), |
66
|
|
|
|
|
|
|
); |
67
|
|
|
|
|
|
|
return { |
68
|
|
|
|
|
|
|
code => $code, |
69
|
|
|
|
|
|
|
env => $env, |
70
|
|
|
|
|
|
|
arg => $arg, |
71
|
|
|
|
|
|
|
}; |
72
|
|
|
|
|
|
|
} |
73
|
|
|
|
|
|
|
return; |
74
|
|
|
|
|
|
|
}; |
75
|
|
|
|
|
|
|
|
76
|
|
|
|
|
|
|
|
77
|
|
|
|
|
|
|
handler |
78
|
|
|
|
|
|
|
name => 'Hash:count', |
79
|
|
|
|
|
|
|
args => 0, |
80
|
|
|
|
|
|
|
template => 'scalar keys %{$GET}', |
81
|
|
|
|
|
|
|
documentation => 'Returns the number of keys in the hash.', |
82
|
|
|
|
|
|
|
_examples => sub { |
83
|
|
|
|
|
|
|
my ( $class, $attr, $method ) = @_; |
84
|
|
|
|
|
|
|
return join "", |
85
|
|
|
|
|
|
|
" my \$object = $class\->new( $attr => { foo => 0, bar => 1 } );\n", |
86
|
1
|
|
|
1
|
|
70
|
" say \$object->$method; ## ==> 2\n", |
87
|
1
|
|
|
|
|
6
|
"\n"; |
88
|
|
|
|
|
|
|
}, |
89
|
|
|
|
|
|
|
} |
90
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
handler |
92
|
41
|
|
|
41
|
1
|
351
|
name => 'Hash:is_empty', |
93
|
|
|
|
|
|
|
args => 0, |
94
|
|
|
|
|
|
|
template => '!scalar keys %{$GET}', |
95
|
|
|
|
|
|
|
documentation => 'Returns true iff there are no keys in the hash.', |
96
|
|
|
|
|
|
|
_examples => sub { |
97
|
|
|
|
|
|
|
my ( $class, $attr, $method ) = @_; |
98
|
|
|
|
|
|
|
return join "", |
99
|
|
|
|
|
|
|
" my \$object = $class\->new( $attr => { foo => 0, bar => 1 } );\n", |
100
|
|
|
|
|
|
|
" say \$object->$method; ## ==> false\n", |
101
|
1
|
|
|
1
|
|
65
|
" \$object->_set_$attr( {} );\n", |
102
|
1
|
|
|
|
|
8
|
" say \$object->$method; ## ==> true\n", |
103
|
|
|
|
|
|
|
"\n"; |
104
|
|
|
|
|
|
|
}, |
105
|
|
|
|
|
|
|
} |
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
handler |
108
|
|
|
|
|
|
|
name => 'Hash:keys', |
109
|
41
|
|
|
41
|
1
|
349
|
args => 0, |
110
|
|
|
|
|
|
|
template => 'keys %{$GET}', |
111
|
|
|
|
|
|
|
documentation => 'Returns the list of keys in the hash.', |
112
|
|
|
|
|
|
|
_examples => sub { |
113
|
|
|
|
|
|
|
my ( $class, $attr, $method ) = @_; |
114
|
|
|
|
|
|
|
return join "", |
115
|
|
|
|
|
|
|
" my \$object = $class\->new( $attr => { foo => 0, bar => 1 } );\n", |
116
|
|
|
|
|
|
|
" # says 'foo' and 'bar' in an unpredictable order\n", |
117
|
|
|
|
|
|
|
" say for \$object->$method;\n", |
118
|
1
|
|
|
1
|
|
62
|
"\n"; |
119
|
1
|
|
|
|
|
6
|
}, |
120
|
|
|
|
|
|
|
} |
121
|
|
|
|
|
|
|
|
122
|
|
|
|
|
|
|
handler |
123
|
|
|
|
|
|
|
name => 'Hash:sorted_keys', |
124
|
|
|
|
|
|
|
args => 0, |
125
|
41
|
|
|
41
|
1
|
346
|
template => 'sort(keys %{$GET})', |
126
|
|
|
|
|
|
|
documentation => 'Returns an alphabetically sorted list of keys in the hash.', |
127
|
|
|
|
|
|
|
_examples => sub { |
128
|
|
|
|
|
|
|
my ( $class, $attr, $method ) = @_; |
129
|
|
|
|
|
|
|
return join "", |
130
|
|
|
|
|
|
|
" my \$object = $class\->new( $attr => { foo => 0, bar => 1 } );\n", |
131
|
|
|
|
|
|
|
" # says 'bar' then 'foo'\n", |
132
|
|
|
|
|
|
|
" say for \$object->$method;\n", |
133
|
|
|
|
|
|
|
"\n"; |
134
|
1
|
|
|
1
|
|
63
|
}, |
135
|
1
|
|
|
|
|
15
|
} |
136
|
|
|
|
|
|
|
|
137
|
|
|
|
|
|
|
handler |
138
|
|
|
|
|
|
|
name => 'Hash:values', |
139
|
|
|
|
|
|
|
args => 0, |
140
|
|
|
|
|
|
|
template => 'values %{$GET}', |
141
|
3
|
|
|
3
|
1
|
29
|
documentation => 'Returns the list of values in the hash.', |
142
|
|
|
|
|
|
|
_examples => sub { |
143
|
|
|
|
|
|
|
my ( $class, $attr, $method ) = @_; |
144
|
|
|
|
|
|
|
return join "", |
145
|
|
|
|
|
|
|
" my \$object = $class\->new( $attr => { foo => 0, bar => 1 } );\n", |
146
|
|
|
|
|
|
|
" # says '0' and '1' in an unpredictable order\n", |
147
|
|
|
|
|
|
|
" say for \$object->$method;\n", |
148
|
|
|
|
|
|
|
"\n"; |
149
|
|
|
|
|
|
|
}, |
150
|
1
|
|
|
1
|
|
76
|
} |
151
|
1
|
|
|
|
|
6
|
|
152
|
|
|
|
|
|
|
handler |
153
|
|
|
|
|
|
|
name => 'Hash:all', |
154
|
|
|
|
|
|
|
args => 0, |
155
|
|
|
|
|
|
|
template => '%{$GET}', |
156
|
|
|
|
|
|
|
documentation => 'Returns the hash in list context.', |
157
|
41
|
|
|
41
|
1
|
431
|
_examples => sub { |
158
|
|
|
|
|
|
|
my ( $class, $attr, $method ) = @_; |
159
|
|
|
|
|
|
|
return join "", |
160
|
|
|
|
|
|
|
" my \$object = $class\->new( $attr => { foo => 0, bar => 1 } );\n", |
161
|
|
|
|
|
|
|
" my \%hash = \$object->$method;\n", |
162
|
|
|
|
|
|
|
"\n"; |
163
|
|
|
|
|
|
|
}, |
164
|
|
|
|
|
|
|
} |
165
|
|
|
|
|
|
|
|
166
|
1
|
|
|
1
|
|
71
|
handler |
167
|
1
|
|
|
|
|
7
|
name => 'Hash:elements', |
168
|
|
|
|
|
|
|
args => 0, |
169
|
|
|
|
|
|
|
template => '%{$GET}', |
170
|
|
|
|
|
|
|
documentation => 'Returns the hash in list context.', |
171
|
|
|
|
|
|
|
_examples => sub { |
172
|
4
|
|
|
4
|
1
|
45
|
my ( $class, $attr, $method ) = @_; |
173
|
|
|
|
|
|
|
return join "", |
174
|
|
|
|
|
|
|
" my \$object = $class\->new( $attr => { foo => 0, bar => 1 } );\n", |
175
|
|
|
|
|
|
|
" my \%hash = \$object->$method;\n", |
176
|
|
|
|
|
|
|
"\n"; |
177
|
|
|
|
|
|
|
}, |
178
|
|
|
|
|
|
|
} |
179
|
|
|
|
|
|
|
|
180
|
|
|
|
|
|
|
handler |
181
|
1
|
|
|
1
|
|
62
|
name => 'Hash:kv', |
182
|
1
|
|
|
|
|
6
|
args => 0, |
183
|
|
|
|
|
|
|
template => 'map [ $_ => ($GET)->{$_} ], keys %{$GET}', |
184
|
|
|
|
|
|
|
documentation => 'Returns a list of arrayrefs, where each arrayref is a key-value pair.', |
185
|
|
|
|
|
|
|
} |
186
|
|
|
|
|
|
|
|
187
|
41
|
|
|
41
|
1
|
352
|
handler |
188
|
|
|
|
|
|
|
name => 'Hash:get', |
189
|
|
|
|
|
|
|
min_args => 1, |
190
|
41
|
|
|
41
|
1
|
198
|
usage => '$key', |
191
|
|
|
|
|
|
|
prefer_shift_self => 1, |
192
|
|
|
|
|
|
|
template => '#ARG>1 ? @{$GET}{@ARG} : ($GET)->{$ARG}', |
193
|
|
|
|
|
|
|
documentation => 'Returns a value from the hashref by its key.', |
194
|
|
|
|
|
|
|
_examples => sub { |
195
|
|
|
|
|
|
|
my ( $class, $attr, $method ) = @_; |
196
|
|
|
|
|
|
|
return join "", |
197
|
|
|
|
|
|
|
" my \$object = $class\->new( $attr => { foo => 0, bar => 1 } );\n", |
198
|
|
|
|
|
|
|
" say \$object->$method( 'bar' ); ## ==> 1\n", |
199
|
|
|
|
|
|
|
"\n"; |
200
|
|
|
|
|
|
|
}, |
201
|
|
|
|
|
|
|
} |
202
|
|
|
|
|
|
|
|
203
|
|
|
|
|
|
|
handler |
204
|
|
|
|
|
|
|
name => 'Hash:defined', |
205
|
|
|
|
|
|
|
args => 1, |
206
|
1
|
|
|
1
|
|
66
|
signature => [Str], |
207
|
1
|
|
|
|
|
13
|
usage => '$key', |
208
|
|
|
|
|
|
|
template => 'defined(($GET)->{$ARG})', |
209
|
|
|
|
|
|
|
documentation => 'Indicates whether a value exists and is defined in the hashref by its key.', |
210
|
|
|
|
|
|
|
_examples => sub { |
211
|
|
|
|
|
|
|
my ( $class, $attr, $method ) = @_; |
212
|
44
|
|
|
44
|
1
|
359
|
return join "", |
213
|
|
|
|
|
|
|
" my \$object = $class\->new( $attr => { foo => 0, bar => 1 } );\n", |
214
|
|
|
|
|
|
|
" say \$object->$method( 'foo' ); ## ==> 1\n", |
215
|
|
|
|
|
|
|
"\n"; |
216
|
|
|
|
|
|
|
}, |
217
|
|
|
|
|
|
|
} |
218
|
|
|
|
|
|
|
|
219
|
|
|
|
|
|
|
handler |
220
|
|
|
|
|
|
|
name => 'Hash:exists', |
221
|
|
|
|
|
|
|
args => 1, |
222
|
|
|
|
|
|
|
signature => [Str], |
223
|
1
|
|
|
1
|
|
63
|
usage => '$key', |
224
|
1
|
|
|
|
|
6
|
template => 'defined(($GET)->{$ARG})', |
225
|
|
|
|
|
|
|
documentation => 'Indicates whether a value exists in the hashref by its key.', |
226
|
|
|
|
|
|
|
_examples => sub { |
227
|
|
|
|
|
|
|
my ( $class, $attr, $method ) = @_; |
228
|
|
|
|
|
|
|
return join "", |
229
|
41
|
|
|
41
|
1
|
237
|
" my \$object = $class\->new( $attr => { foo => 0, bar => 1 } );\n", |
230
|
|
|
|
|
|
|
" say \$object->$method( 'foo' ); ## ==> true\n", |
231
|
|
|
|
|
|
|
" say \$object->$method( 'baz' ); ## ==> false\n", |
232
|
|
|
|
|
|
|
"\n"; |
233
|
|
|
|
|
|
|
}, |
234
|
|
|
|
|
|
|
} |
235
|
|
|
|
|
|
|
|
236
|
|
|
|
|
|
|
handler |
237
|
|
|
|
|
|
|
name => 'Hash:delete', |
238
|
|
|
|
|
|
|
min_args => 1, |
239
|
|
|
|
|
|
|
usage => '$key', |
240
|
1
|
|
|
1
|
|
63
|
template => 'my %shv_tmp = %{$GET}; my @shv_return = delete @shv_tmp{@ARG}; «\%shv_tmp»; wantarray ? @shv_return : $shv_return[-1]', |
241
|
1
|
|
|
|
|
9
|
lvalue_template => 'delete(@{$GET}{@ARG})', |
242
|
|
|
|
|
|
|
prefer_shift_self => 1, |
243
|
|
|
|
|
|
|
additional_validation => 'no incoming values', |
244
|
|
|
|
|
|
|
documentation => 'Removes a value from the hashref by its key.', |
245
|
|
|
|
|
|
|
_examples => sub { |
246
|
|
|
|
|
|
|
my ( $class, $attr, $method ) = @_; |
247
|
41
|
|
|
41
|
1
|
224
|
return join "", |
248
|
|
|
|
|
|
|
" my \$object = $class\->new( $attr => { foo => 0, bar => 1 } );\n", |
249
|
|
|
|
|
|
|
" \$object->$method( 'foo' );\n", |
250
|
|
|
|
|
|
|
" say exists \$object->$attr\->{foo}; ## ==> false\n", |
251
|
|
|
|
|
|
|
"\n"; |
252
|
|
|
|
|
|
|
}, |
253
|
|
|
|
|
|
|
} |
254
|
|
|
|
|
|
|
|
255
|
|
|
|
|
|
|
handler |
256
|
|
|
|
|
|
|
name => 'Hash:delete_where', |
257
|
|
|
|
|
|
|
min_args => 1, |
258
|
|
|
|
|
|
|
usage => '$match', |
259
|
|
|
|
|
|
|
signature => [ CodeRef | RegexpRef ], |
260
|
1
|
|
|
1
|
|
66
|
template => 'my %shv_tmp = %{$GET}; my $shv_match = $ARG; my @shv_keys = ("CODE" eq ref $shv_match) ? grep($shv_match->($_), keys %shv_tmp) : grep(/$shv_match/, keys %shv_tmp); my @shv_return = delete @shv_tmp{@shv_keys}; «\%shv_tmp»; wantarray ? @shv_return : $shv_return[-1]', |
261
|
1
|
|
|
|
|
7
|
prefer_shift_self => 1, |
262
|
|
|
|
|
|
|
documentation => 'Removes values from the hashref by matching keys against a coderef or regexp.', |
263
|
|
|
|
|
|
|
_examples => sub { |
264
|
|
|
|
|
|
|
my ( $class, $attr, $method ) = @_; |
265
|
|
|
|
|
|
|
return join "", |
266
|
|
|
|
|
|
|
" my \$object = $class\->new( $attr => { foo => 0, bar => 1, baz => 2 } );\n", |
267
|
41
|
|
|
41
|
1
|
375
|
" \$object->$method( sub { \$_ eq 'foo' or \$_ eq 'bar' } );\n", |
268
|
|
|
|
|
|
|
" say Dumper( \$object->$attr ); ## ==> { baz => 2 }\n", |
269
|
|
|
|
|
|
|
" \n", |
270
|
|
|
|
|
|
|
" my \$object2 = $class\->new( $attr => { foo => 0, bar => 1, baz => 2 } );\n", |
271
|
|
|
|
|
|
|
" \$object2->$method( qr/^b/ );\n", |
272
|
|
|
|
|
|
|
" say Dumper( \$object2->$attr ); ## ==> { foo => 0 }\n", |
273
|
|
|
|
|
|
|
"\n"; |
274
|
|
|
|
|
|
|
}, |
275
|
|
|
|
|
|
|
} |
276
|
|
|
|
|
|
|
|
277
|
|
|
|
|
|
|
handler |
278
|
|
|
|
|
|
|
name => 'Hash:clear', |
279
|
1
|
|
|
1
|
|
71
|
args => 0, |
280
|
1
|
|
|
|
|
11
|
template => '«{}»', |
281
|
|
|
|
|
|
|
lvalue_template => '%{$GET} = ()', |
282
|
|
|
|
|
|
|
additional_validation => 'no incoming values', |
283
|
|
|
|
|
|
|
documentation => 'Empties the hash.', |
284
|
|
|
|
|
|
|
_examples => sub { |
285
|
|
|
|
|
|
|
my ( $class, $attr, $method ) = @_; |
286
|
|
|
|
|
|
|
return join "", |
287
|
|
|
|
|
|
|
" my \$object = $class\->new( $attr => { foo => 0, bar => 1 } );\n", |
288
|
|
|
|
|
|
|
" \$object->$method;\n", |
289
|
|
|
|
|
|
|
" say exists \$object->$attr\->{foo}; ## ==> false\n", |
290
|
3
|
|
|
3
|
1
|
23
|
" say exists \$object->$attr\->{bar}; ## ==> false\n", |
291
|
|
|
|
|
|
|
"\n"; |
292
|
|
|
|
|
|
|
}, |
293
|
|
|
|
|
|
|
} |
294
|
|
|
|
|
|
|
|
295
|
|
|
|
|
|
|
handler |
296
|
|
|
|
|
|
|
name => 'Hash:shallow_clone', |
297
|
|
|
|
|
|
|
args => 0, |
298
|
|
|
|
|
|
|
template => '+{%{$GET}}', |
299
|
|
|
|
|
|
|
documentation => 'Creates a new hashref with the same keys and values as the original.', |
300
|
|
|
|
|
|
|
} |
301
|
1
|
|
|
1
|
|
65
|
|
302
|
1
|
|
|
|
|
8
|
my $me = CORE::shift; |
303
|
|
|
|
|
|
|
handler |
304
|
|
|
|
|
|
|
name => 'Hash:set', |
305
|
|
|
|
|
|
|
min_args => 2, |
306
|
|
|
|
|
|
|
usage => '$key, $value, ...', |
307
|
|
|
|
|
|
|
prefer_shift_self => 1, |
308
|
|
|
|
|
|
|
template => ( |
309
|
41
|
|
|
41
|
1
|
375
|
'my (@shv_params) = @ARG; ' . |
310
|
|
|
|
|
|
|
'scalar(@shv_params) % 2 and ⸨"Wrong number of parameters; expected even-sized list of keys and values"⸩;' . |
311
|
|
|
|
|
|
|
'my (@shv_keys_idx) = grep(!($_ % 2), 0..$#shv_params); ' . |
312
|
3
|
|
|
3
|
1
|
18
|
'my (@shv_values_idx) = grep(($_ % 2), 0..$#shv_params); ' . |
313
|
|
|
|
|
|
|
'grep(!defined, @shv_params[@shv_keys_idx]) and ⸨"Undef did not pass type constraint; keys must be defined"⸩;'. |
314
|
|
|
|
|
|
|
'"____VALIDATION_HERE____"; '. |
315
|
|
|
|
|
|
|
'my %shv_tmp = %{$GET}; @shv_tmp{@shv_params[@shv_keys_idx]} = @shv_params[@shv_values_idx]; «\\%shv_tmp»;' . |
316
|
|
|
|
|
|
|
'wantarray ? @shv_tmp{@shv_params[@shv_keys_idx]} : $shv_tmp{$shv_params[$shv_keys_idx[0]]}' ), |
317
|
|
|
|
|
|
|
lvalue_template => ( |
318
|
|
|
|
|
|
|
'my (@shv_params) = @ARG; ' . |
319
|
|
|
|
|
|
|
'scalar(@shv_params) % 2 and ⸨"Wrong number of parameters; expected even-sized list of keys and values"⸩;' . |
320
|
42
|
|
|
42
|
1
|
134
|
'my (@shv_keys_idx) = grep(!($_ % 2), 0..$#shv_params); ' . |
321
|
|
|
|
|
|
|
'my (@shv_values_idx) = grep(($_ % 2), 0..$#shv_params); ' . |
322
|
|
|
|
|
|
|
'grep(!defined, @shv_params[@shv_keys_idx]) and ⸨"Undef did not pass type constraint; keys must be defined"⸩;'. |
323
|
|
|
|
|
|
|
'"____VALIDATION_HERE____"; '. |
324
|
|
|
|
|
|
|
'@{$GET}{@shv_params[@shv_keys_idx]} = @shv_params[@shv_values_idx];' . |
325
|
|
|
|
|
|
|
'wantarray ? @{$GET}{@shv_params[@shv_keys_idx]} : ($GET)->{$shv_params[$shv_keys_idx[0]]}' ), |
326
|
|
|
|
|
|
|
additional_validation => sub { |
327
|
|
|
|
|
|
|
my $self = CORE::shift; |
328
|
|
|
|
|
|
|
my ($sig_was_checked, $gen) = @_; |
329
|
|
|
|
|
|
|
my $ti = __PACKAGE__->_type_inspector($gen->isa); |
330
|
|
|
|
|
|
|
my $env = {}; |
331
|
|
|
|
|
|
|
if ($ti and $ti->{trust_mutated} eq 'always') { |
332
|
|
|
|
|
|
|
# still need to check keys are strings |
333
|
|
|
|
|
|
|
return { |
334
|
|
|
|
|
|
|
code => sprintf( |
335
|
|
|
|
|
|
|
'for my $shv_tmp (@shv_keys_idx) { %s };', |
336
|
|
|
|
|
|
|
$gen->generate_type_assertion( $env, Str, '$shv_params[$shv_tmp]' ), |
337
|
|
|
|
|
|
|
), |
338
|
|
|
|
|
|
|
env => $env, |
339
|
|
|
|
|
|
|
add_later => 1, |
340
|
|
|
|
|
|
|
}; |
341
|
|
|
|
|
|
|
} |
342
|
|
|
|
|
|
|
if ($ti and $ti->{trust_mutated} eq 'maybe') { |
343
|
|
|
|
|
|
|
return { |
344
|
|
|
|
|
|
|
code => sprintf( |
345
|
39
|
|
|
39
|
|
128
|
'for my $shv_tmp (@shv_keys_idx) { %s }; for my $shv_tmp (@shv_values_idx) { %s };', |
346
|
39
|
|
|
|
|
132
|
$gen->generate_type_assertion( $env, $ti->{key_type}, '$shv_params[$shv_tmp]' ), |
347
|
39
|
|
|
|
|
160
|
$gen->generate_type_assertion( $env, $ti->{value_type}, '$shv_params[$shv_tmp]' ), |
348
|
39
|
|
|
|
|
326
|
), |
349
|
39
|
100
|
66
|
|
|
283
|
env => $env, |
350
|
|
|
|
|
|
|
add_later => 1, |
351
|
|
|
|
|
|
|
}; |
352
|
6
|
|
|
|
|
33
|
} |
353
|
|
|
|
|
|
|
return; |
354
|
|
|
|
|
|
|
}, |
355
|
|
|
|
|
|
|
documentation => 'Given a key and value, adds the key to the hashref with the given value.', |
356
|
|
|
|
|
|
|
_examples => sub { |
357
|
|
|
|
|
|
|
my ( $class, $attr, $method ) = @_; |
358
|
|
|
|
|
|
|
return join "", |
359
|
|
|
|
|
|
|
" my \$object = $class\->new( $attr => { foo => 0, bar => 1 } );\n", |
360
|
33
|
100
|
66
|
|
|
200
|
" \$object->$method( bar => 2, baz => 1 );\n", |
361
|
|
|
|
|
|
|
" say \$object->$attr\->{foo}; ## ==> 0\n", |
362
|
|
|
|
|
|
|
" say \$object->$attr\->{baz}; ## ==> 1\n", |
363
|
|
|
|
|
|
|
" say \$object->$attr\->{bar}; ## ==> 2\n", |
364
|
|
|
|
|
|
|
"\n"; |
365
|
16
|
|
|
|
|
79
|
}, |
366
|
|
|
|
|
|
|
} |
367
|
|
|
|
|
|
|
|
368
|
|
|
|
|
|
|
handler |
369
|
|
|
|
|
|
|
name => 'Hash:accessor', |
370
|
|
|
|
|
|
|
min_args => 1, |
371
|
17
|
|
|
|
|
73
|
max_args => 2, |
372
|
|
|
|
|
|
|
signature => [Str, Optional[Any]], |
373
|
|
|
|
|
|
|
usage => '$key, $value?', |
374
|
|
|
|
|
|
|
template => 'if (#ARG == 1) { ($GET)->{ $ARG[1] } } else { my %shv_tmp = %{$GET}; $shv_tmp{$ARG[1]} = $ARG[2]; «\\%shv_tmp» }', |
375
|
1
|
|
|
1
|
|
76
|
lvalue_template => '(#ARG == 1) ? ($GET)->{ $ARG[1] } : (($GET)->{ $ARG[1] } = $ARG[2])', |
376
|
1
|
|
|
|
|
9
|
additional_validation => $additional_validation_for_set_and_insert, |
377
|
|
|
|
|
|
|
documentation => 'Acts like C<get> if given just a key, or C<set> if given a key and a value.', |
378
|
|
|
|
|
|
|
} |
379
|
|
|
|
|
|
|
|
380
|
|
|
|
|
|
|
handler |
381
|
|
|
|
|
|
|
name => 'Hash:for_each_pair', |
382
|
|
|
|
|
|
|
args => 1, |
383
|
|
|
|
|
|
|
signature => [CodeRef], |
384
|
42
|
|
|
|
|
501
|
usage => '$coderef', |
385
|
|
|
|
|
|
|
template => 'while (my ($shv_key,$shv_value)=each %{$GET}) { &{$ARG}($shv_key,$shv_value) }; $SELF', |
386
|
|
|
|
|
|
|
documentation => 'Chainable method which calls the coderef for each key in the hash, passing the key and value to the coderef.', |
387
|
79
|
|
|
79
|
1
|
343
|
} |
388
|
|
|
|
|
|
|
|
389
|
|
|
|
|
|
|
handler |
390
|
|
|
|
|
|
|
name => 'Hash:for_each_key', |
391
|
|
|
|
|
|
|
args => 1, |
392
|
|
|
|
|
|
|
signature => [CodeRef], |
393
|
|
|
|
|
|
|
usage => '$coderef', |
394
|
|
|
|
|
|
|
template => 'for my $shv_key (keys %{$GET}) { &{$ARG}($shv_key) }; $SELF', |
395
|
|
|
|
|
|
|
documentation => 'Chainable method which calls the coderef for each key in the hash, passing just the key to the coderef.', |
396
|
|
|
|
|
|
|
} |
397
|
|
|
|
|
|
|
|
398
|
|
|
|
|
|
|
handler |
399
|
|
|
|
|
|
|
name => 'Hash:for_each_value', |
400
|
4
|
|
|
4
|
1
|
22
|
args => 1, |
401
|
|
|
|
|
|
|
signature => [CodeRef], |
402
|
|
|
|
|
|
|
usage => '$coderef', |
403
|
|
|
|
|
|
|
template => 'for my $shv_value (values %{$GET}) { &{$ARG}($shv_value) }; $SELF', |
404
|
|
|
|
|
|
|
documentation => 'Chainable method which calls the coderef for each value in the hash, passing just the value to the coderef.', |
405
|
|
|
|
|
|
|
} |
406
|
|
|
|
|
|
|
|
407
|
|
|
|
|
|
|
handler |
408
|
|
|
|
|
|
|
name => 'Hash:reset', |
409
|
|
|
|
|
|
|
args => 0, |
410
|
4
|
|
|
4
|
1
|
53
|
template => '« $DEFAULT »', |
411
|
|
|
|
|
|
|
default_for_reset => sub { '{}' }, |
412
|
|
|
|
|
|
|
documentation => 'Resets the attribute to its default value, or an empty hashref if it has no default.', |
413
|
|
|
|
|
|
|
} |
414
|
|
|
|
|
|
|
|
415
|
|
|
|
|
|
|
1; |