| line |
stmt |
bran |
cond |
sub |
code |
|
1
|
|
|
|
|
package List::Objects::WithUtils::Role::Hash; |
|
2
|
40
|
|
|
40
|
use strictures 1; |
|
|
40
|
|
|
|
|
|
|
40
|
|
|
|
|
|
3
|
|
|
|
|
|
|
4
|
40
|
|
|
40
|
use Module::Runtime (); |
|
|
40
|
|
|
|
|
|
|
40
|
|
|
|
|
|
5
|
40
|
|
|
40
|
use Scalar::Util (); |
|
|
40
|
|
|
|
|
|
|
40
|
|
|
|
|
|
6
|
|
|
|
|
|
|
7
|
|
|
|
|
=pod |
|
8
|
|
|
|
|
|
|
9
|
|
|
|
|
=for Pod::Coverage HASH_TYPE blessed_or_pkg |
|
10
|
|
|
|
|
|
|
11
|
|
|
|
|
=cut |
|
12
|
|
|
|
|
|
|
13
|
|
|
|
|
sub HASH_TYPE () { 'List::Objects::WithUtils::Hash' } |
|
14
|
|
|
|
|
sub blessed_or_pkg { |
|
15
|
23
|
|
|
23
|
my $pkg; |
|
16
|
23
|
100
|
|
|
($pkg = Scalar::Util::blessed $_[0]) ? |
|
17
|
|
|
|
|
$pkg : Module::Runtime::use_module(HASH_TYPE) |
|
18
|
|
|
|
|
} |
|
19
|
|
|
|
|
|
|
20
|
40
|
|
|
40
|
use Role::Tiny; |
|
|
40
|
|
|
|
|
|
|
40
|
|
|
|
|
|
21
|
|
|
|
|
|
|
22
|
48
|
|
|
48
|
sub array_type { 'List::Objects::WithUtils::Array' } |
|
23
|
4
|
|
|
4
|
sub inflated_type { 'List::Objects::WithUtils::Hash::Inflated' } |
|
24
|
2
|
|
|
2
|
sub inflated_rw_type { 'List::Objects::WithUtils::Hash::Inflated::RW' } |
|
25
|
|
|
|
|
|
|
26
|
|
|
|
|
=pod |
|
27
|
|
|
|
|
|
|
28
|
|
|
|
|
=for Pod::Coverage TO_JSON type |
|
29
|
|
|
|
|
|
|
30
|
|
|
|
|
=cut |
|
31
|
|
|
|
|
|
|
32
|
2
|
|
|
2
|
sub is_mutable { 1 } |
|
33
|
2
|
|
|
2
|
sub is_immutable { ! $_[0]->is_mutable } |
|
34
|
|
|
|
|
|
|
35
|
1
|
|
|
1
|
sub type { } |
|
36
|
|
|
|
|
|
|
37
|
|
|
|
|
sub new { |
|
38
|
32
|
|
|
32
|
Module::Runtime::require_module( $_[0]->array_type ); |
|
39
|
32
|
|
|
|
bless +{ @_[1 .. $#_] }, $_[0] |
|
40
|
|
|
|
|
} |
|
41
|
|
|
|
|
|
|
42
|
2
|
|
|
2
|
sub unbless { +{ %{ $_[0] } } } |
|
|
2
|
|
|
|
|
|
43
|
40
|
|
|
40
|
{ no warnings 'once'; *TO_JSON = *unbless; } |
|
|
40
|
|
|
|
|
|
|
40
|
|
|
|
|
|
44
|
|
|
|
|
|
|
45
|
2
|
|
|
2
|
sub clear { %{ $_[0] } = (); $_[0] } |
|
|
2
|
|
|
|
|
|
|
2
|
|
|
|
|
|
46
|
|
|
|
|
|
|
47
|
|
|
|
|
sub copy { |
|
48
|
2
|
|
|
2
|
bless +{ %{ $_[0] } }, blessed_or_pkg($_[0]) |
|
|
2
|
|
|
|
|
|
49
|
|
|
|
|
} |
|
50
|
|
|
|
|
|
|
51
|
|
|
|
|
sub inflate { |
|
52
|
3
|
|
|
3
|
my ($self, %params) = @_; |
|
53
|
3
|
100
|
|
|
my $type = $params{rw} ? 'inflated_rw_type' : 'inflated_type'; |
|
54
|
3
|
|
|
|
my $pkg = blessed_or_pkg($self); |
|
55
|
3
|
|
|
|
Module::Runtime::require_module( $pkg->$type ); |
|
56
|
3
|
|
|
|
$pkg->$type->new( %$self ) |
|
57
|
|
|
|
|
} |
|
58
|
|
|
|
|
|
|
59
|
3
|
|
|
3
|
sub defined { CORE::defined $_[0]->{ $_[1] } } |
|
60
|
4
|
|
|
4
|
sub exists { CORE::exists $_[0]->{ $_[1] } } |
|
61
|
|
|
|
|
|
|
62
|
5
|
100
|
|
5
|
sub is_empty { keys %{ $_[0] } ? 0 : 1 } |
|
|
5
|
|
|
|
|
|
63
|
|
|
|
|
|
|
64
|
|
|
|
|
sub get { |
|
65
|
20
|
100
|
|
20
|
if (@_ > 2) { |
|
66
|
1
|
|
|
|
return blessed_or_pkg($_[0])->array_type->new( |
|
67
|
1
|
|
|
|
@{ $_[0] }{ @_[1 .. $#_] } |
|
68
|
|
|
|
|
) |
|
69
|
|
|
|
|
} |
|
70
|
19
|
|
|
|
$_[0]->{ $_[1] } |
|
71
|
|
|
|
|
} |
|
72
|
|
|
|
|
|
|
73
|
|
|
|
|
sub sliced { |
|
74
|
|
|
|
|
blessed_or_pkg($_[0])->new( |
|
75
|
3
|
|
|
3
|
map {; |
|
76
|
7
|
100
|
|
|
exists $_[0]->{$_} ? |
|
77
|
|
|
|
|
( $_ => $_[0]->{$_} ) |
|
78
|
|
|
|
|
: () |
|
79
|
|
|
|
|
} @_[1 .. $#_] |
|
80
|
|
|
|
|
) |
|
81
|
|
|
|
|
} |
|
82
|
|
|
|
|
|
|
83
|
|
|
|
|
sub set { |
|
84
|
6
|
|
|
6
|
my $self = shift; |
|
85
|
6
|
|
|
|
my @keysidx = grep {; not $_ % 2 } 0 .. $#_ ; |
|
|
16
|
|
|
|
|
|
86
|
6
|
|
|
|
my @valsidx = grep {; $_ % 2 } 0 .. $#_ ; |
|
|
16
|
|
|
|
|
|
87
|
|
|
|
|
|
|
88
|
6
|
|
|
|
@{$self}{ @_[@keysidx] } = @_[@valsidx]; |
|
|
6
|
|
|
|
|
|
89
|
|
|
|
|
|
|
90
|
5
|
|
|
|
$self |
|
91
|
|
|
|
|
} |
|
92
|
|
|
|
|
|
|
93
|
|
|
|
|
sub delete { |
|
94
|
3
|
|
|
|
blessed_or_pkg($_[0])->array_type->new( |
|
95
|
3
|
|
|
3
|
CORE::delete @{ $_[0] }{ @_[1 .. $#_] } |
|
96
|
|
|
|
|
) |
|
97
|
|
|
|
|
} |
|
98
|
|
|
|
|
|
|
99
|
|
|
|
|
sub keys { |
|
100
|
5
|
|
|
|
blessed_or_pkg($_[0])->array_type->new( |
|
101
|
5
|
|
|
5
|
CORE::keys %{ $_[0] } |
|
102
|
|
|
|
|
) |
|
103
|
|
|
|
|
} |
|
104
|
|
|
|
|
|
|
105
|
|
|
|
|
sub values { |
|
106
|
2
|
|
|
|
blessed_or_pkg($_[0])->array_type->new( |
|
107
|
2
|
|
|
2
|
CORE::values %{ $_[0] } |
|
108
|
|
|
|
|
) |
|
109
|
|
|
|
|
} |
|
110
|
|
|
|
|
|
|
111
|
|
|
|
|
sub kv { |
|
112
|
|
|
|
|
blessed_or_pkg($_[0])->array_type->new( |
|
113
|
2
|
|
|
2
|
map {; [ $_, $_[0]->{ $_ } ] } CORE::keys %{ $_[0] } |
|
|
4
|
|
|
|
|
|
|
2
|
|
|
|
|
|
114
|
|
|
|
|
) |
|
115
|
|
|
|
|
} |
|
116
|
|
|
|
|
|
|
117
|
|
|
|
|
sub kv_sort { |
|
118
|
2
|
100
|
|
2
|
if (defined $_[1]) { |
|
119
|
|
|
|
|
return blessed_or_pkg($_[0])->array_type->new( |
|
120
|
4
|
|
|
|
map {; [ $_, $_[0]->{ $_ } ] } |
|
121
|
1
|
|
|
|
CORE::sort {; $_[1]->($a, $b) } CORE::keys %{ $_[0] } |
|
|
5
|
|
|
|
|
|
|
1
|
|
|
|
|
|
122
|
|
|
|
|
) |
|
123
|
|
|
|
|
} |
|
124
|
|
|
|
|
blessed_or_pkg($_[0])->array_type->new( |
|
125
|
1
|
|
|
|
map {; [ $_, $_[0]->{ $_ } ] } CORE::sort( CORE::keys %{ $_[0] } ) |
|
|
4
|
|
|
|
|
|
|
1
|
|
|
|
|
|
126
|
|
|
|
|
) |
|
127
|
|
|
|
|
} |
|
128
|
|
|
|
|
|
|
129
|
3
|
|
|
3
|
sub export { %{ $_[0] } } |
|
|
3
|
|
|
|
|
|
130
|
|
|
|
|
|
|
131
|
|
|
|
|
1; |
|
132
|
|
|
|
|
|
|
133
|
|
|
|
|
|
|
134
|
|
|
|
|
=pod |
|
135
|
|
|
|
|
|
|
136
|
|
|
|
|
=head1 NAME |
|
137
|
|
|
|
|
|
|
138
|
|
|
|
|
List::Objects::WithUtils::Role::Hash - Hash manipulation methods |
|
139
|
|
|
|
|
|
|
140
|
|
|
|
|
=head1 SYNOPSIS |
|
141
|
|
|
|
|
|
|
142
|
|
|
|
|
## Via List::Objects::WithUtils::Hash -> |
|
143
|
|
|
|
|
use List::Objects::WithUtils 'hash'; |
|
144
|
|
|
|
|
|
|
145
|
|
|
|
|
my $hash = hash(foo => 'bar'); |
|
146
|
|
|
|
|
|
|
147
|
|
|
|
|
$hash->set( |
|
148
|
|
|
|
|
foo => 'baz', |
|
149
|
|
|
|
|
pie => 'tasty', |
|
150
|
|
|
|
|
); |
|
151
|
|
|
|
|
|
|
152
|
|
|
|
|
my @matches = $hash->keys->grep(sub { |
|
153
|
|
|
|
|
$_[0] =~ /foo/ |
|
154
|
|
|
|
|
})->all; |
|
155
|
|
|
|
|
|
|
156
|
|
|
|
|
my $pie = $hash->get('pie') |
|
157
|
|
|
|
|
if $hash->exists('pie'); |
|
158
|
|
|
|
|
|
|
159
|
|
|
|
|
for my $pair ( $hash->kv->all ) { |
|
160
|
|
|
|
|
my ($key, $val) = @$pair; |
|
161
|
|
|
|
|
... |
|
162
|
|
|
|
|
} |
|
163
|
|
|
|
|
|
|
164
|
|
|
|
|
my $obj = $hash->inflate; |
|
165
|
|
|
|
|
my $foo = $obj->foo; |
|
166
|
|
|
|
|
|
|
167
|
|
|
|
|
## As a Role -> |
|
168
|
|
|
|
|
use Role::Tiny::With; |
|
169
|
|
|
|
|
with 'List::Objects::WithUtils::Role::Hash'; |
|
170
|
|
|
|
|
|
|
171
|
|
|
|
|
=head1 DESCRIPTION |
|
172
|
|
|
|
|
|
|
173
|
|
|
|
|
A L<Role::Tiny> role defining methods for creating and manipulating HASH-type |
|
174
|
|
|
|
|
objects. |
|
175
|
|
|
|
|
|
|
176
|
|
|
|
|
In addition to the methods documented below, these objects provide a |
|
177
|
|
|
|
|
C<TO_JSON> method exporting a plain HASH-type reference for convenience when |
|
178
|
|
|
|
|
feeding L<JSON::Tiny> or similar. |
|
179
|
|
|
|
|
|
|
180
|
|
|
|
|
=head2 new |
|
181
|
|
|
|
|
|
|
182
|
|
|
|
|
Constructs a new HASH-type object. |
|
183
|
|
|
|
|
|
|
184
|
|
|
|
|
=head2 export |
|
185
|
|
|
|
|
|
|
186
|
|
|
|
|
my %hash = $hash->export; |
|
187
|
|
|
|
|
|
|
188
|
|
|
|
|
Returns a raw key/value list. |
|
189
|
|
|
|
|
|
|
190
|
|
|
|
|
=head2 clear |
|
191
|
|
|
|
|
|
|
192
|
|
|
|
|
Clears the current hash entirely. |
|
193
|
|
|
|
|
|
|
194
|
|
|
|
|
Returns the hash object (as of version 1.013). |
|
195
|
|
|
|
|
|
|
196
|
|
|
|
|
=head2 copy |
|
197
|
|
|
|
|
|
|
198
|
|
|
|
|
Creates a shallow clone of the current object. |
|
199
|
|
|
|
|
|
|
200
|
|
|
|
|
=head2 unbless |
|
201
|
|
|
|
|
|
|
202
|
|
|
|
|
Returns a plain C</HASH> reference (shallow clone). |
|
203
|
|
|
|
|
|
|
204
|
|
|
|
|
=head2 defined |
|
205
|
|
|
|
|
|
|
206
|
|
|
|
|
if ( $hash->defined($key) ) { ... } |
|
207
|
|
|
|
|
|
|
208
|
|
|
|
|
Returns boolean true if the key has a defined value. |
|
209
|
|
|
|
|
|
|
210
|
|
|
|
|
=head2 delete |
|
211
|
|
|
|
|
|
|
212
|
|
|
|
|
$hash->delete( @keys ); |
|
213
|
|
|
|
|
|
|
214
|
|
|
|
|
Deletes keys from the hash. |
|
215
|
|
|
|
|
|
|
216
|
|
|
|
|
Returns an L</array_type> object containing the deleted values. |
|
217
|
|
|
|
|
|
|
218
|
|
|
|
|
=head2 exists |
|
219
|
|
|
|
|
|
|
220
|
|
|
|
|
if ( $hash->exists($key) ) { ... } |
|
221
|
|
|
|
|
|
|
222
|
|
|
|
|
Returns boolean true if the key exists. |
|
223
|
|
|
|
|
|
|
224
|
|
|
|
|
=head2 get |
|
225
|
|
|
|
|
|
|
226
|
|
|
|
|
my $val = $hash->get($key); |
|
227
|
|
|
|
|
my @vals = $hash->get(@keys)->all; |
|
228
|
|
|
|
|
|
|
229
|
|
|
|
|
Retrieves a key or list of keys from the hash. |
|
230
|
|
|
|
|
|
|
231
|
|
|
|
|
If we're taking a slice (multiple keys were specified), values are returned |
|
232
|
|
|
|
|
as an L</array_type> object. (See L</sliced> if you'd rather generate a new |
|
233
|
|
|
|
|
hash.) |
|
234
|
|
|
|
|
|
|
235
|
|
|
|
|
=head2 inflate |
|
236
|
|
|
|
|
|
|
237
|
|
|
|
|
my $obj = hash(foo => 'bar', baz => 'quux')->inflate; |
|
238
|
|
|
|
|
my $baz = $obj->baz; |
|
239
|
|
|
|
|
|
|
240
|
|
|
|
|
Inflates a simple object providing accessors for a hash. |
|
241
|
|
|
|
|
|
|
242
|
|
|
|
|
By default, accessors are read-only; specifying C<rw => 1> allows setting new |
|
243
|
|
|
|
|
values: |
|
244
|
|
|
|
|
|
|
245
|
|
|
|
|
my $obj = hash(foo => 'bar', baz => 'quux')->inflate(rw => 1); |
|
246
|
|
|
|
|
$obj->foo('frobulate'); |
|
247
|
|
|
|
|
|
|
248
|
|
|
|
|
Returns an L</inflated_type> (or L</inflated_rw_type>) object. |
|
249
|
|
|
|
|
|
|
250
|
|
|
|
|
The default objects provide a C<DEFLATE> method returning a |
|
251
|
|
|
|
|
plain hash; this makes it easy to turn inflated objects back into a C<hash()> |
|
252
|
|
|
|
|
for modification: |
|
253
|
|
|
|
|
|
|
254
|
|
|
|
|
my $first = hash( foo => 'bar', baz => 'quux' )->inflate; |
|
255
|
|
|
|
|
my $second = hash( $first->DEFLATE, frobulate => 1 )->inflate; |
|
256
|
|
|
|
|
|
|
257
|
|
|
|
|
=head2 is_empty |
|
258
|
|
|
|
|
|
|
259
|
|
|
|
|
Returns boolean true if the hash has no keys. |
|
260
|
|
|
|
|
|
|
261
|
|
|
|
|
=head2 is_mutable |
|
262
|
|
|
|
|
|
|
263
|
|
|
|
|
Returns boolean true if the hash is mutable; immutable subclasses can override |
|
264
|
|
|
|
|
to provide a negative value. |
|
265
|
|
|
|
|
|
|
266
|
|
|
|
|
=head2 is_immutable |
|
267
|
|
|
|
|
|
|
268
|
|
|
|
|
The opposite of L</is_mutable>. |
|
269
|
|
|
|
|
|
|
270
|
|
|
|
|
=head2 keys |
|
271
|
|
|
|
|
|
|
272
|
|
|
|
|
my @keys = $hash->keys->all; |
|
273
|
|
|
|
|
|
|
274
|
|
|
|
|
Returns the list of keys in the hash as an L</array_type> object. |
|
275
|
|
|
|
|
|
|
276
|
|
|
|
|
=head2 values |
|
277
|
|
|
|
|
|
|
278
|
|
|
|
|
my @vals = $hash->values->all; |
|
279
|
|
|
|
|
|
|
280
|
|
|
|
|
Returns the list of values in the hash as an L</array_type> object. |
|
281
|
|
|
|
|
|
|
282
|
|
|
|
|
=head2 kv |
|
283
|
|
|
|
|
|
|
284
|
|
|
|
|
for my $pair ($hash->kv->all) { |
|
285
|
|
|
|
|
my ($key, $val) = @$pair; |
|
286
|
|
|
|
|
} |
|
287
|
|
|
|
|
|
|
288
|
|
|
|
|
Returns an L</array_type> object containing the key/value pairs in the HASH, |
|
289
|
|
|
|
|
each of which is a two-element ARRAY. |
|
290
|
|
|
|
|
|
|
291
|
|
|
|
|
=head2 kv_sort |
|
292
|
|
|
|
|
|
|
293
|
|
|
|
|
my $kvs = hash(a => 1, b => 2, c => 3)->kv_sort; |
|
294
|
|
|
|
|
# $kvs = array( |
|
295
|
|
|
|
|
# [ a => 1 ], |
|
296
|
|
|
|
|
# [ b => 2 ], |
|
297
|
|
|
|
|
# [ c => 3 ] |
|
298
|
|
|
|
|
# ) |
|
299
|
|
|
|
|
|
|
300
|
|
|
|
|
my $reversed = hash(a => 1, b => 2, c => 3) |
|
301
|
|
|
|
|
->kv_sort(sub { $_[1] cmp $_[0] }); |
|
302
|
|
|
|
|
# Reverse result as above |
|
303
|
|
|
|
|
|
|
304
|
|
|
|
|
Like L</kv>, but sorted by key. A sort routine can be provided; C<$_[0]> and |
|
305
|
|
|
|
|
C<$_[1]> are equivalent to the usual sort variables C<$a> and C<$b>. |
|
306
|
|
|
|
|
|
|
307
|
|
|
|
|
=head2 set |
|
308
|
|
|
|
|
|
|
309
|
|
|
|
|
$hash->set( |
|
310
|
|
|
|
|
key1 => $val, |
|
311
|
|
|
|
|
key2 => $other, |
|
312
|
|
|
|
|
) |
|
313
|
|
|
|
|
|
|
314
|
|
|
|
|
Sets keys in the hash. |
|
315
|
|
|
|
|
|
|
316
|
|
|
|
|
As of version 1.007, returns the current hash object. |
|
317
|
|
|
|
|
The return value of prior versions is unreliable. |
|
318
|
|
|
|
|
|
|
319
|
|
|
|
|
=head2 sliced |
|
320
|
|
|
|
|
|
|
321
|
|
|
|
|
my $newhash = $hash->sliced(@keys); |
|
322
|
|
|
|
|
|
|
323
|
|
|
|
|
Returns a new hash object built from the specified set of keys. |
|
324
|
|
|
|
|
|
|
325
|
|
|
|
|
(See L</get> if you only need the values.) |
|
326
|
|
|
|
|
|
|
327
|
|
|
|
|
=head2 array_type |
|
328
|
|
|
|
|
|
|
329
|
|
|
|
|
The class name of array-type objects that will be used to contain the results |
|
330
|
|
|
|
|
of methods returning a list. |
|
331
|
|
|
|
|
|
|
332
|
|
|
|
|
Defaults to L<List::Objects::WithUtils::Array>. |
|
333
|
|
|
|
|
|
|
334
|
|
|
|
|
Subclasses can override C<array_type> to produce different types of array |
|
335
|
|
|
|
|
objects; the method can also be queried to find out what kind of array object |
|
336
|
|
|
|
|
will be returned: |
|
337
|
|
|
|
|
|
|
338
|
|
|
|
|
my $type = $hash->array_type; |
|
339
|
|
|
|
|
|
|
340
|
|
|
|
|
=head2 inflated_type |
|
341
|
|
|
|
|
|
|
342
|
|
|
|
|
The class name that objects are blessed into when calling L</inflate>. |
|
343
|
|
|
|
|
|
|
344
|
|
|
|
|
Defaults to L<List::Objects::WithUtils::Hash::Inflated>. |
|
345
|
|
|
|
|
|
|
346
|
|
|
|
|
=head2 inflated_rw_type |
|
347
|
|
|
|
|
|
|
348
|
|
|
|
|
The class name that objects are blessed into when calling L</inflate> with |
|
349
|
|
|
|
|
C<rw => 1>. |
|
350
|
|
|
|
|
|
|
351
|
|
|
|
|
Defaults to L<List::Objects::WithUtils::Hash::Inflated::RW>, a subclass of |
|
352
|
|
|
|
|
L<List::Objects::WithUtils::Hash::Inflated>. |
|
353
|
|
|
|
|
|
|
354
|
|
|
|
|
=head1 SEE ALSO |
|
355
|
|
|
|
|
|
|
356
|
|
|
|
|
L<List::Objects::WithUtils> |
|
357
|
|
|
|
|
|
|
358
|
|
|
|
|
L<Data::Perl> |
|
359
|
|
|
|
|
|
|
360
|
|
|
|
|
=head1 AUTHOR |
|
361
|
|
|
|
|
|
|
362
|
|
|
|
|
Jon Portnoy <avenj@cobaltirc.org> |
|
363
|
|
|
|
|
|
|
364
|
|
|
|
|
Portions of this code are derived from L<Data::Perl> by Matthew Phillips |
|
365
|
|
|
|
|
(CPAN: MATTP), haarg et al |
|
366
|
|
|
|
|
|
|
367
|
|
|
|
|
Licensed under the same terms as Perl. |
|
368
|
|
|
|
|
|
|
369
|
|
|
|
|
=cut |
|
370
|
|
|
|
|
|