line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package List::Objects::WithUtils::Role::Hash; |
2
|
|
|
|
|
|
|
$List::Objects::WithUtils::Role::Hash::VERSION = '2.028002'; |
3
|
136
|
|
|
136
|
|
62371
|
use strictures 2; |
|
136
|
|
|
|
|
3090
|
|
|
136
|
|
|
|
|
5163
|
|
4
|
|
|
|
|
|
|
|
5
|
136
|
|
|
136
|
|
34263
|
use Module::Runtime (); |
|
136
|
|
|
|
|
44795
|
|
|
136
|
|
|
|
|
1792
|
|
6
|
136
|
|
|
136
|
|
453
|
use Scalar::Util (); |
|
136
|
|
|
|
|
130
|
|
|
136
|
|
|
|
|
1336
|
|
7
|
136
|
|
|
136
|
|
397
|
use List::Util (); |
|
136
|
|
|
|
|
126
|
|
|
136
|
|
|
|
|
9184
|
|
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
|
56
|
100
|
|
56
|
0
|
385
|
Scalar::Util::blessed($_[0]) ? |
16
|
|
|
|
|
|
|
$_[0] : Module::Runtime::use_module(HASH_TYPE) |
17
|
|
|
|
|
|
|
} |
18
|
|
|
|
|
|
|
|
19
|
136
|
|
|
136
|
|
448
|
use Role::Tiny; |
|
136
|
|
|
|
|
154
|
|
|
136
|
|
|
|
|
635
|
|
20
|
|
|
|
|
|
|
|
21
|
126
|
|
|
126
|
1
|
579
|
sub array_type { 'List::Objects::WithUtils::Array' } |
22
|
4
|
|
|
4
|
1
|
21
|
sub inflated_type { 'List::Objects::WithUtils::Hash::Inflated' } |
23
|
2
|
|
|
2
|
1
|
12
|
sub inflated_rw_type { 'List::Objects::WithUtils::Hash::Inflated::RW' } |
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
=for Pod::Coverage TO_JSON TO_ZPL damn type |
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
=cut |
28
|
|
|
|
|
|
|
|
29
|
2
|
|
|
2
|
1
|
8
|
sub is_mutable { 1 } |
30
|
2
|
|
|
2
|
1
|
20
|
sub is_immutable { ! $_[0]->is_mutable } |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
2
|
0
|
|
sub type { } |
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
our %Required; |
35
|
|
|
|
|
|
|
sub new { |
36
|
75
|
|
|
75
|
1
|
288
|
my $arraytype = $_[0]->array_type; |
37
|
|
|
|
|
|
|
$Required{$arraytype} = Module::Runtime::require_module($arraytype) |
38
|
75
|
100
|
|
|
|
368
|
unless exists $Required{$arraytype}; |
39
|
75
|
|
66
|
|
|
1526
|
bless +{ @_[1 .. $#_] }, Scalar::Util::blessed($_[0]) || $_[0] |
40
|
|
|
|
|
|
|
} |
41
|
|
|
|
|
|
|
|
42
|
13
|
|
|
13
|
1
|
723
|
sub export { %{ $_[0] } } |
|
13
|
|
|
|
|
120
|
|
43
|
16
|
|
|
16
|
1
|
2562
|
sub unbless { +{ %{ $_[0] } } } |
|
16
|
|
|
|
|
79
|
|
44
|
|
|
|
|
|
|
|
45
|
136
|
|
|
136
|
|
37322
|
{ no warnings 'once'; |
|
136
|
|
|
|
|
182
|
|
|
136
|
|
|
|
|
13394
|
|
46
|
|
|
|
|
|
|
*TO_JSON = *unbless; |
47
|
|
|
|
|
|
|
*TO_ZPL = *unbless; |
48
|
|
|
|
|
|
|
*damn = *unbless; |
49
|
|
|
|
|
|
|
} |
50
|
|
|
|
|
|
|
|
51
|
1
|
|
|
1
|
1
|
5
|
sub clear { %{ $_[0] } = (); $_[0] } |
|
1
|
|
|
|
|
5
|
|
|
1
|
|
|
|
|
5
|
|
52
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
=for Pod::Coverage untyped |
54
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
=cut |
56
|
|
|
|
|
|
|
|
57
|
4
|
|
|
4
|
1
|
24
|
sub copy { blessed_or_pkg($_[0])->new(%{ $_[0] }) } |
|
4
|
|
|
|
|
46
|
|
58
|
136
|
|
|
136
|
|
516
|
{ no warnings 'once'; *untyped = *copy; } |
|
136
|
|
|
|
|
175
|
|
|
136
|
|
|
|
|
44889
|
|
59
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
sub inflate { |
61
|
3
|
|
|
3
|
1
|
16
|
my ($self, %params) = @_; |
62
|
3
|
100
|
|
|
|
8
|
my $type = $params{rw} ? 'inflated_rw_type' : 'inflated_type'; |
63
|
3
|
|
|
|
|
8
|
my $cls = blessed_or_pkg($self); |
64
|
3
|
|
|
|
|
36
|
Module::Runtime::require_module( $cls->$type ); |
65
|
3
|
|
|
|
|
13
|
$cls->$type->new( %$self ) |
66
|
|
|
|
|
|
|
} |
67
|
|
|
|
|
|
|
|
68
|
6
|
|
|
6
|
1
|
44
|
sub defined { CORE::defined $_[0]->{ $_[1] } } |
69
|
10
|
|
|
10
|
1
|
710
|
sub exists { CORE::exists $_[0]->{ $_[1] } } |
70
|
|
|
|
|
|
|
|
71
|
4
|
|
|
4
|
1
|
15
|
sub is_empty { ! keys %{ $_[0] } } |
|
4
|
|
|
|
|
24
|
|
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
sub get { |
74
|
49
|
100
|
|
49
|
1
|
10593
|
if (@_ > 2) { |
75
|
|
|
|
|
|
|
return blessed_or_pkg($_[0])->array_type->new( |
76
|
2
|
|
|
|
|
7
|
@{ $_[0] }{ @_[1 .. $#_] } |
|
2
|
|
|
|
|
16
|
|
77
|
|
|
|
|
|
|
) |
78
|
|
|
|
|
|
|
} |
79
|
47
|
|
|
|
|
215
|
$_[0]->{ $_[1] } |
80
|
|
|
|
|
|
|
} |
81
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
sub get_or_else { |
83
|
10
|
100
|
100
|
10
|
1
|
125
|
exists $_[0]->{ $_[1] } ? $_[0]->{ $_[1] } |
|
|
100
|
|
|
|
|
|
84
|
|
|
|
|
|
|
: (Scalar::Util::reftype $_[2] || '') eq 'CODE' ? $_[2]->(@_[0,1]) |
85
|
|
|
|
|
|
|
: $_[2] |
86
|
|
|
|
|
|
|
} |
87
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
sub get_path { |
89
|
11
|
|
|
11
|
1
|
368
|
my $ref = $_[0]; |
90
|
11
|
|
|
|
|
23
|
for my $part (@_[1 .. $#_]) { |
91
|
25
|
100
|
|
|
|
51
|
$ref = ref $part eq 'ARRAY' ? $ref->[ $part->[0] ] : $ref->{$part}; |
92
|
23
|
100
|
|
|
|
43
|
return undef unless defined $ref; |
93
|
|
|
|
|
|
|
} |
94
|
|
|
|
|
|
|
$ref |
95
|
6
|
|
|
|
|
18
|
} |
96
|
|
|
|
|
|
|
|
97
|
|
|
|
|
|
|
=for Pod::Coverage slice |
98
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
=cut |
100
|
|
|
|
|
|
|
|
101
|
136
|
|
|
136
|
|
565
|
{ no warnings 'once'; *slice = *sliced; } |
|
136
|
|
|
|
|
155
|
|
|
136
|
|
|
|
|
71696
|
|
102
|
|
|
|
|
|
|
{ local $@; |
103
|
|
|
|
|
|
|
if ($] >= 5.020) { |
104
|
4
|
|
|
4
|
1
|
123
|
eval q[ |
|
4
|
|
|
|
|
25
|
|
|
11
|
|
|
|
|
74
|
|
105
|
|
|
|
|
|
|
sub sliced { |
106
|
|
|
|
|
|
|
blessed_or_pkg($_[0])->new( |
107
|
|
|
|
|
|
|
%{ $_[0] }{ grep {; exists $_[0]->{$_} } @_[1 .. $#_] } |
108
|
|
|
|
|
|
|
) |
109
|
|
|
|
|
|
|
} |
110
|
|
|
|
|
|
|
]; |
111
|
|
|
|
|
|
|
} else { |
112
|
|
|
|
|
|
|
eval q[ |
113
|
|
|
|
|
|
|
sub sliced { |
114
|
|
|
|
|
|
|
blessed_or_pkg($_[0])->new( |
115
|
|
|
|
|
|
|
map {; exists $_[0]->{$_} ? ($_ => $_[0]->{$_}) : () } |
116
|
|
|
|
|
|
|
@_[1 .. $#_] |
117
|
|
|
|
|
|
|
) |
118
|
|
|
|
|
|
|
} |
119
|
|
|
|
|
|
|
]; |
120
|
|
|
|
|
|
|
} |
121
|
|
|
|
|
|
|
die "installing sub 'sliced' died: $@" if $@; |
122
|
|
|
|
|
|
|
} |
123
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
sub set { |
125
|
9
|
|
|
9
|
1
|
743
|
my $self = shift; |
126
|
9
|
|
|
|
|
11
|
my (@keysidx, @valsidx); |
127
|
9
|
100
|
|
|
|
58
|
$_ % 2 ? push @valsidx, $_ : push @keysidx, $_ for 0 .. $#_; |
128
|
9
|
|
|
|
|
19
|
@{$self}{ @_[@keysidx] } = @_[@valsidx]; |
|
9
|
|
|
|
|
29
|
|
129
|
8
|
|
|
|
|
38
|
$self |
130
|
|
|
|
|
|
|
} |
131
|
|
|
|
|
|
|
|
132
|
|
|
|
|
|
|
sub maybe_set { |
133
|
2
|
|
|
2
|
1
|
21
|
my $self = shift; |
134
|
2
|
|
|
|
|
6
|
for (grep {; not $_ % 2 } 0 .. $#_) { |
|
12
|
|
|
|
|
16
|
|
135
|
6
|
100
|
|
|
|
21
|
$self->{ $_[$_] } = $_[$_ + 1] unless exists $self->{ $_[$_] } |
136
|
|
|
|
|
|
|
} |
137
|
|
|
|
|
|
|
$self |
138
|
2
|
|
|
|
|
10
|
} |
139
|
|
|
|
|
|
|
|
140
|
|
|
|
|
|
|
sub delete { |
141
|
|
|
|
|
|
|
blessed_or_pkg($_[0])->array_type->new( |
142
|
4
|
|
|
4
|
1
|
27
|
CORE::delete @{ $_[0] }{ @_[1 .. $#_] } |
|
4
|
|
|
|
|
22
|
|
143
|
|
|
|
|
|
|
) |
144
|
|
|
|
|
|
|
} |
145
|
|
|
|
|
|
|
|
146
|
|
|
|
|
|
|
sub keys { |
147
|
|
|
|
|
|
|
blessed_or_pkg($_[0])->array_type->new( |
148
|
10
|
|
|
10
|
1
|
958
|
CORE::keys %{ $_[0] } |
|
10
|
|
|
|
|
76
|
|
149
|
|
|
|
|
|
|
) |
150
|
|
|
|
|
|
|
} |
151
|
|
|
|
|
|
|
|
152
|
|
|
|
|
|
|
sub values { |
153
|
|
|
|
|
|
|
blessed_or_pkg($_[0])->array_type->new( |
154
|
2
|
|
|
2
|
1
|
25
|
CORE::values %{ $_[0] } |
|
2
|
|
|
|
|
16
|
|
155
|
|
|
|
|
|
|
) |
156
|
|
|
|
|
|
|
} |
157
|
|
|
|
|
|
|
|
158
|
|
|
|
|
|
|
sub intersection { |
159
|
3
|
|
|
3
|
1
|
33
|
my %seen; my %inner; |
160
|
|
|
|
|
|
|
blessed_or_pkg($_[0])->array_type->new( |
161
|
8
|
|
|
|
|
25
|
grep {; not $seen{$_}++ } |
162
|
3
|
|
|
|
|
8
|
grep {; ++$inner{$_} > $#_ } map {; CORE::keys %$_ } @_ |
|
49
|
|
|
|
|
58
|
|
|
8
|
|
|
|
|
27
|
|
163
|
|
|
|
|
|
|
) |
164
|
|
|
|
|
|
|
} |
165
|
|
|
|
|
|
|
|
166
|
|
|
|
|
|
|
sub diff { |
167
|
3
|
|
|
3
|
1
|
41
|
my %seen; my %inner; |
168
|
3
|
|
|
|
|
5
|
my @vals = map {; CORE::keys %$_ } @_; |
|
7
|
|
|
|
|
22
|
|
169
|
3
|
|
|
|
|
15
|
$seen{$_}++ for @vals; |
170
|
|
|
|
|
|
|
blessed_or_pkg($_[0])->array_type->new( |
171
|
19
|
|
|
|
|
31
|
grep {; $seen{$_} != @_ } |
172
|
3
|
|
|
|
|
9
|
grep {; not $inner{$_}++ } @vals |
|
28
|
|
|
|
|
30
|
|
173
|
|
|
|
|
|
|
) |
174
|
|
|
|
|
|
|
} |
175
|
|
|
|
|
|
|
|
176
|
|
|
|
|
|
|
sub iter { |
177
|
3
|
|
|
3
|
1
|
25
|
my @list = %{ $_[0] }; |
|
3
|
|
|
|
|
21
|
|
178
|
9
|
|
|
9
|
|
46
|
sub { splice @list, 0, 2 } |
179
|
3
|
|
|
|
|
17
|
} |
180
|
|
|
|
|
|
|
|
181
|
|
|
|
|
|
|
sub kv { |
182
|
|
|
|
|
|
|
blessed_or_pkg($_[0])->array_type->new( |
183
|
2
|
|
|
2
|
1
|
25
|
map {; [ $_, $_[0]->{ $_ } ] } CORE::keys %{ $_[0] } |
|
4
|
|
|
|
|
18
|
|
|
2
|
|
|
|
|
10
|
|
184
|
|
|
|
|
|
|
) |
185
|
|
|
|
|
|
|
} |
186
|
|
|
|
|
|
|
|
187
|
|
|
|
|
|
|
sub kv_sort { |
188
|
10
|
100
|
66
|
10
|
1
|
783
|
if (defined $_[1] && (my $cb = $_[1])) { |
189
|
6
|
|
|
|
|
13
|
my $pkg = caller; |
190
|
136
|
|
|
136
|
|
603
|
no strict 'refs'; |
|
136
|
|
|
|
|
145
|
|
|
136
|
|
|
|
|
22830
|
|
191
|
|
|
|
|
|
|
return blessed_or_pkg($_[0])->array_type->new( |
192
|
15
|
|
|
|
|
59
|
map {; [ $_, $_[0]->{ $_ } ] } sort {; |
193
|
15
|
|
|
|
|
73
|
local (*{"${pkg}::a"}, *{"${pkg}::b"}) = (\$a, \$b); |
|
15
|
|
|
|
|
25
|
|
|
15
|
|
|
|
|
25
|
|
194
|
15
|
|
|
|
|
27
|
$a->$cb($b) |
195
|
6
|
|
|
|
|
16
|
} CORE::keys %{ $_[0] } |
|
6
|
|
|
|
|
44
|
|
196
|
|
|
|
|
|
|
) |
197
|
|
|
|
|
|
|
} |
198
|
|
|
|
|
|
|
blessed_or_pkg($_[0])->array_type->new( |
199
|
4
|
|
|
|
|
8
|
map {; [ $_, $_[0]->{ $_ } ] } sort( CORE::keys %{ $_[0] } ) |
|
16
|
|
|
|
|
32
|
|
|
4
|
|
|
|
|
22
|
|
200
|
|
|
|
|
|
|
) |
201
|
|
|
|
|
|
|
} |
202
|
|
|
|
|
|
|
|
203
|
|
|
|
|
|
|
sub kv_map { |
204
|
3
|
|
|
3
|
1
|
28
|
my ($self, $cb) = @_; |
205
|
3
|
|
|
|
|
6
|
my $pkg = caller; |
206
|
136
|
|
|
136
|
|
609
|
no strict 'refs'; |
|
136
|
|
|
|
|
165
|
|
|
136
|
|
|
|
|
15421
|
|
207
|
|
|
|
|
|
|
blessed_or_pkg($self)->array_type->new( |
208
|
|
|
|
|
|
|
List::Util::pairmap {; |
209
|
9
|
|
|
9
|
|
25
|
local (*{"${pkg}::a"}, *{"${pkg}::b"}) = (\$a, \$b); |
|
9
|
|
|
|
|
15
|
|
|
9
|
|
|
|
|
13
|
|
210
|
9
|
|
|
|
|
16
|
$a->$cb($b) |
211
|
3
|
|
|
|
|
8
|
} %$self |
212
|
|
|
|
|
|
|
) |
213
|
|
|
|
|
|
|
} |
214
|
|
|
|
|
|
|
|
215
|
|
|
|
|
|
|
sub kv_grep { |
216
|
3
|
|
|
3
|
1
|
28
|
my ($self, $cb) = @_; |
217
|
3
|
|
|
|
|
5
|
my $pkg = caller; |
218
|
136
|
|
|
136
|
|
534
|
no strict 'refs'; |
|
136
|
|
|
|
|
157
|
|
|
136
|
|
|
|
|
22471
|
|
219
|
|
|
|
|
|
|
blessed_or_pkg($self)->new( |
220
|
|
|
|
|
|
|
List::Util::pairgrep {; |
221
|
9
|
|
|
9
|
|
71
|
local (*{"${pkg}::a"}, *{"${pkg}::b"}) = (\$a, \$b); |
|
9
|
|
|
|
|
17
|
|
|
9
|
|
|
|
|
13
|
|
222
|
9
|
|
|
|
|
15
|
$a->$cb($b) |
223
|
3
|
|
|
|
|
9
|
} %$self |
224
|
|
|
|
|
|
|
) |
225
|
|
|
|
|
|
|
} |
226
|
|
|
|
|
|
|
|
227
|
|
|
|
|
|
|
=for Pod::Coverage invert |
228
|
|
|
|
|
|
|
|
229
|
|
|
|
|
|
|
=cut |
230
|
|
|
|
|
|
|
|
231
|
|
|
|
|
|
|
sub inverted { |
232
|
3
|
|
|
3
|
1
|
25
|
my ($self) = @_; |
233
|
3
|
|
|
|
|
9
|
my $cls = blessed_or_pkg($self); |
234
|
3
|
|
|
|
|
34
|
my %new; |
235
|
|
|
|
|
|
|
List::Util::pairmap {; |
236
|
|
|
|
|
|
|
exists $new{$b} ? |
237
|
12
|
100
|
|
12
|
|
42
|
$new{$b}->push($a) : ( $new{$b} = $cls->array_type->new($a) ) |
238
|
3
|
|
|
|
|
49
|
} %$self; |
239
|
3
|
|
|
|
|
21
|
$cls->new(%new) |
240
|
|
|
|
|
|
|
} |
241
|
136
|
|
|
136
|
|
540
|
{ no warnings 'once'; *invert = *inverted; } |
|
136
|
|
|
|
|
150
|
|
|
136
|
|
|
|
|
31071
|
|
242
|
|
|
|
|
|
|
|
243
|
|
|
|
|
|
|
|
244
|
|
|
|
|
|
|
sub random_kv { |
245
|
2
|
|
|
2
|
1
|
4
|
my $key = (CORE::keys %{ $_[0] })[rand CORE::keys %{ $_[0] }]; |
|
2
|
|
|
|
|
5
|
|
|
2
|
|
|
|
|
38
|
|
246
|
2
|
100
|
|
|
|
9
|
$key ? [ $key => $_[0]->{$key} ] : undef |
247
|
|
|
|
|
|
|
} |
248
|
|
|
|
|
|
|
|
249
|
|
|
|
|
|
|
sub random_key { |
250
|
2
|
|
100
|
2
|
1
|
6
|
(CORE::keys %{ $_[0] })[rand (CORE::keys %{ $_[0] } || return undef)] |
|
1
|
|
|
|
|
6
|
|
251
|
|
|
|
|
|
|
} |
252
|
|
|
|
|
|
|
|
253
|
|
|
|
|
|
|
sub random_value { |
254
|
2
|
|
|
2
|
1
|
6
|
[@_ = %{ $_[0] }]->[1|rand @_] |
|
2
|
|
|
|
|
42
|
|
255
|
|
|
|
|
|
|
} |
256
|
|
|
|
|
|
|
|
257
|
|
|
|
|
|
|
|
258
|
|
|
|
|
|
|
print |
259
|
|
|
|
|
|
|
qq[ huf: I learned that from toyota via agile blahblah,], |
260
|
|
|
|
|
|
|
qq[ it's asking the five "why" questions.\n], |
261
|
|
|
|
|
|
|
qq[ WHY WHY WHY WHY GOD WHY\n] |
262
|
|
|
|
|
|
|
unless caller; |
263
|
|
|
|
|
|
|
1; |
264
|
|
|
|
|
|
|
|
265
|
|
|
|
|
|
|
|
266
|
|
|
|
|
|
|
=pod |
267
|
|
|
|
|
|
|
|
268
|
|
|
|
|
|
|
=head1 NAME |
269
|
|
|
|
|
|
|
|
270
|
|
|
|
|
|
|
List::Objects::WithUtils::Role::Hash - Hash manipulation methods |
271
|
|
|
|
|
|
|
|
272
|
|
|
|
|
|
|
=head1 SYNOPSIS |
273
|
|
|
|
|
|
|
|
274
|
|
|
|
|
|
|
## Via List::Objects::WithUtils::Hash -> |
275
|
|
|
|
|
|
|
use List::Objects::WithUtils 'hash'; |
276
|
|
|
|
|
|
|
|
277
|
|
|
|
|
|
|
my $hash = hash(foo => 'bar'); |
278
|
|
|
|
|
|
|
|
279
|
|
|
|
|
|
|
$hash->set( |
280
|
|
|
|
|
|
|
foo => 'baz', |
281
|
|
|
|
|
|
|
pie => 'tasty', |
282
|
|
|
|
|
|
|
); |
283
|
|
|
|
|
|
|
|
284
|
|
|
|
|
|
|
my @matches = $hash->keys->grep(sub { $_[0] =~ /foo/ })->all; |
285
|
|
|
|
|
|
|
|
286
|
|
|
|
|
|
|
my $pie = $hash->get('pie') |
287
|
|
|
|
|
|
|
if $hash->exists('pie'); |
288
|
|
|
|
|
|
|
|
289
|
|
|
|
|
|
|
for my $pair ( $hash->kv->all ) { |
290
|
|
|
|
|
|
|
my ($key, $val) = @$pair; |
291
|
|
|
|
|
|
|
... |
292
|
|
|
|
|
|
|
} |
293
|
|
|
|
|
|
|
|
294
|
|
|
|
|
|
|
my $obj = $hash->inflate; |
295
|
|
|
|
|
|
|
my $foo = $obj->foo; |
296
|
|
|
|
|
|
|
|
297
|
|
|
|
|
|
|
## As a Role -> |
298
|
|
|
|
|
|
|
use Role::Tiny::With; |
299
|
|
|
|
|
|
|
with 'List::Objects::WithUtils::Role::Hash'; |
300
|
|
|
|
|
|
|
|
301
|
|
|
|
|
|
|
=head1 DESCRIPTION |
302
|
|
|
|
|
|
|
|
303
|
|
|
|
|
|
|
A L role defining methods for creating and manipulating HASH-type |
304
|
|
|
|
|
|
|
objects. |
305
|
|
|
|
|
|
|
|
306
|
|
|
|
|
|
|
In addition to the methods documented below, these objects provide a |
307
|
|
|
|
|
|
|
C method exporting a plain HASH-type reference for convenience when |
308
|
|
|
|
|
|
|
feeding L or similar, as well as a C method for |
309
|
|
|
|
|
|
|
compatibility with L. |
310
|
|
|
|
|
|
|
|
311
|
|
|
|
|
|
|
=head2 Basic hash methods |
312
|
|
|
|
|
|
|
|
313
|
|
|
|
|
|
|
=head3 new |
314
|
|
|
|
|
|
|
|
315
|
|
|
|
|
|
|
Constructs a new HASH-type object. |
316
|
|
|
|
|
|
|
|
317
|
|
|
|
|
|
|
=head3 copy |
318
|
|
|
|
|
|
|
|
319
|
|
|
|
|
|
|
Creates a shallow clone of the current object. |
320
|
|
|
|
|
|
|
|
321
|
|
|
|
|
|
|
=head3 defined |
322
|
|
|
|
|
|
|
|
323
|
|
|
|
|
|
|
if ( $hash->defined($key) ) { ... } |
324
|
|
|
|
|
|
|
|
325
|
|
|
|
|
|
|
Returns boolean true if the key has a defined value. |
326
|
|
|
|
|
|
|
|
327
|
|
|
|
|
|
|
=head3 exists |
328
|
|
|
|
|
|
|
|
329
|
|
|
|
|
|
|
if ( $hash->exists($key) ) { ... } |
330
|
|
|
|
|
|
|
|
331
|
|
|
|
|
|
|
Returns boolean true if the key exists. |
332
|
|
|
|
|
|
|
|
333
|
|
|
|
|
|
|
=head3 export |
334
|
|
|
|
|
|
|
|
335
|
|
|
|
|
|
|
my %hash = $hash->export; |
336
|
|
|
|
|
|
|
|
337
|
|
|
|
|
|
|
Returns a raw key => value list. |
338
|
|
|
|
|
|
|
|
339
|
|
|
|
|
|
|
For a plain HASH-type reference, see: L |
340
|
|
|
|
|
|
|
|
341
|
|
|
|
|
|
|
=head3 array_type |
342
|
|
|
|
|
|
|
|
343
|
|
|
|
|
|
|
The class name of array-type objects that will be used to contain the results |
344
|
|
|
|
|
|
|
of methods returning a list. |
345
|
|
|
|
|
|
|
|
346
|
|
|
|
|
|
|
Defaults to L. |
347
|
|
|
|
|
|
|
|
348
|
|
|
|
|
|
|
Subclasses can override C to produce different types of array |
349
|
|
|
|
|
|
|
objects. |
350
|
|
|
|
|
|
|
|
351
|
|
|
|
|
|
|
=head3 inflate |
352
|
|
|
|
|
|
|
|
353
|
|
|
|
|
|
|
my $obj = hash(foo => 'bar', baz => 'quux')->inflate; |
354
|
|
|
|
|
|
|
my $baz = $obj->baz; |
355
|
|
|
|
|
|
|
|
356
|
|
|
|
|
|
|
Inflates the hash-type object into a simple struct-like object with accessor |
357
|
|
|
|
|
|
|
methods matching the keys of the hash. |
358
|
|
|
|
|
|
|
|
359
|
|
|
|
|
|
|
By default, accessors are read-only; specifying C 1> allows setting new |
360
|
|
|
|
|
|
|
values: |
361
|
|
|
|
|
|
|
|
362
|
|
|
|
|
|
|
my $obj = hash(foo => 'bar', baz => 'quux')->inflate(rw => 1); |
363
|
|
|
|
|
|
|
$obj->foo('frobulate'); |
364
|
|
|
|
|
|
|
|
365
|
|
|
|
|
|
|
Returns an L (or L) object. |
366
|
|
|
|
|
|
|
|
367
|
|
|
|
|
|
|
The default objects provide a C method returning a |
368
|
|
|
|
|
|
|
plain hash; this makes it easy to turn inflated objects back into a C |
369
|
|
|
|
|
|
|
for modification: |
370
|
|
|
|
|
|
|
|
371
|
|
|
|
|
|
|
my $first = hash( foo => 'bar', baz => 'quux' )->inflate; |
372
|
|
|
|
|
|
|
my $second = hash( $first->DEFLATE, frobulate => 1 )->inflate; |
373
|
|
|
|
|
|
|
|
374
|
|
|
|
|
|
|
=head3 inflated_type |
375
|
|
|
|
|
|
|
|
376
|
|
|
|
|
|
|
The class that objects are blessed into when calling L. |
377
|
|
|
|
|
|
|
|
378
|
|
|
|
|
|
|
Defaults to L. |
379
|
|
|
|
|
|
|
|
380
|
|
|
|
|
|
|
=head3 inflated_rw_type |
381
|
|
|
|
|
|
|
|
382
|
|
|
|
|
|
|
The class that objects are blessed into when calling L with |
383
|
|
|
|
|
|
|
C 1> specified. |
384
|
|
|
|
|
|
|
|
385
|
|
|
|
|
|
|
Defaults to L, a subclass of |
386
|
|
|
|
|
|
|
L. |
387
|
|
|
|
|
|
|
|
388
|
|
|
|
|
|
|
=head3 is_empty |
389
|
|
|
|
|
|
|
|
390
|
|
|
|
|
|
|
Returns boolean true if the hash has no keys. |
391
|
|
|
|
|
|
|
|
392
|
|
|
|
|
|
|
=head3 is_mutable |
393
|
|
|
|
|
|
|
|
394
|
|
|
|
|
|
|
Returns boolean true if the hash is mutable; immutable subclasses can override |
395
|
|
|
|
|
|
|
to provide a negative value. |
396
|
|
|
|
|
|
|
|
397
|
|
|
|
|
|
|
=head3 is_immutable |
398
|
|
|
|
|
|
|
|
399
|
|
|
|
|
|
|
The opposite of L. |
400
|
|
|
|
|
|
|
|
401
|
|
|
|
|
|
|
=head3 unbless |
402
|
|
|
|
|
|
|
|
403
|
|
|
|
|
|
|
Returns a plain C reference (shallow clone). |
404
|
|
|
|
|
|
|
|
405
|
|
|
|
|
|
|
=head2 Methods that manipulate the hash |
406
|
|
|
|
|
|
|
|
407
|
|
|
|
|
|
|
=head3 clear |
408
|
|
|
|
|
|
|
|
409
|
|
|
|
|
|
|
Clears the current hash entirely. |
410
|
|
|
|
|
|
|
|
411
|
|
|
|
|
|
|
Returns the (same, but now empty) hash object. |
412
|
|
|
|
|
|
|
|
413
|
|
|
|
|
|
|
=head3 delete |
414
|
|
|
|
|
|
|
|
415
|
|
|
|
|
|
|
$hash->delete(@keys); |
416
|
|
|
|
|
|
|
|
417
|
|
|
|
|
|
|
Deletes the given key(s) from the hash. |
418
|
|
|
|
|
|
|
|
419
|
|
|
|
|
|
|
Returns an L object containing the deleted values. |
420
|
|
|
|
|
|
|
|
421
|
|
|
|
|
|
|
=head3 set |
422
|
|
|
|
|
|
|
|
423
|
|
|
|
|
|
|
$hash->set( |
424
|
|
|
|
|
|
|
key1 => $val, |
425
|
|
|
|
|
|
|
key2 => $other, |
426
|
|
|
|
|
|
|
) |
427
|
|
|
|
|
|
|
|
428
|
|
|
|
|
|
|
Sets keys in the hash. |
429
|
|
|
|
|
|
|
|
430
|
|
|
|
|
|
|
Returns the current hash object. |
431
|
|
|
|
|
|
|
|
432
|
|
|
|
|
|
|
=head3 maybe_set |
433
|
|
|
|
|
|
|
|
434
|
|
|
|
|
|
|
my $hash = hash(foo => 1, bar => 2, baz => 3); |
435
|
|
|
|
|
|
|
$hash->maybe_set(foo => 2, bar => 3, quux => 4); |
436
|
|
|
|
|
|
|
# $hash = +{ foo => 1, bar => 2, baz => 3, quux => 4 } |
437
|
|
|
|
|
|
|
|
438
|
|
|
|
|
|
|
Like L, but only sets values that do not already exist in the hash. |
439
|
|
|
|
|
|
|
|
440
|
|
|
|
|
|
|
Returns the current hash object. |
441
|
|
|
|
|
|
|
|
442
|
|
|
|
|
|
|
=head2 Methods that retrieve items |
443
|
|
|
|
|
|
|
|
444
|
|
|
|
|
|
|
=head3 get |
445
|
|
|
|
|
|
|
|
446
|
|
|
|
|
|
|
my $val = $hash->get($key); |
447
|
|
|
|
|
|
|
my @vals = $hash->get(@keys)->all; |
448
|
|
|
|
|
|
|
|
449
|
|
|
|
|
|
|
Retrieves a key or list of keys from the hash. |
450
|
|
|
|
|
|
|
|
451
|
|
|
|
|
|
|
If taking a slice (multiple keys were specified), values are returned |
452
|
|
|
|
|
|
|
as an L object. (See L if you'd rather generate a new |
453
|
|
|
|
|
|
|
hash.) |
454
|
|
|
|
|
|
|
|
455
|
|
|
|
|
|
|
=head3 get_path |
456
|
|
|
|
|
|
|
|
457
|
|
|
|
|
|
|
my $hash = hash( |
458
|
|
|
|
|
|
|
foo => +{ bar => +{ baz => 'bork' } }, |
459
|
|
|
|
|
|
|
quux => [ +{ weeble => 'snork' } ], |
460
|
|
|
|
|
|
|
); |
461
|
|
|
|
|
|
|
my $item = $hash->get_path(qw/foo bar baz/); # 'bork' |
462
|
|
|
|
|
|
|
|
463
|
|
|
|
|
|
|
Attempt to retrieve a value from a 'deep' hash (without risking |
464
|
|
|
|
|
|
|
autovivification). |
465
|
|
|
|
|
|
|
|
466
|
|
|
|
|
|
|
If an element of the given path is a (plain) array reference, as in this |
467
|
|
|
|
|
|
|
example: |
468
|
|
|
|
|
|
|
|
469
|
|
|
|
|
|
|
my $item = $hash->get_path('quux', [1], 'weeble'); # "snork" |
470
|
|
|
|
|
|
|
|
471
|
|
|
|
|
|
|
... then it is taken as the index of an array or array-type object in the |
472
|
|
|
|
|
|
|
path. |
473
|
|
|
|
|
|
|
|
474
|
|
|
|
|
|
|
Returns undef if any of the path elements are nonexistant. |
475
|
|
|
|
|
|
|
|
476
|
|
|
|
|
|
|
An exception is thrown if an invalid access is attempted, such as trying to |
477
|
|
|
|
|
|
|
use a hash-type object as if it were an array. |
478
|
|
|
|
|
|
|
|
479
|
|
|
|
|
|
|
(Available from v2.15.1) |
480
|
|
|
|
|
|
|
|
481
|
|
|
|
|
|
|
=head3 get_or_else |
482
|
|
|
|
|
|
|
|
483
|
|
|
|
|
|
|
# Expect to find an array() obj at $key in $hash, |
484
|
|
|
|
|
|
|
# or create an empty one if $key doesn't exist: |
485
|
|
|
|
|
|
|
my @all = $hash->get_or_else($key => array)->all; |
486
|
|
|
|
|
|
|
|
487
|
|
|
|
|
|
|
# Or pass a coderef |
488
|
|
|
|
|
|
|
# First arg is the object being operated on |
489
|
|
|
|
|
|
|
# Second arg is the requested key |
490
|
|
|
|
|
|
|
my $item = $hash->get_or_else($key => sub { shift->get($defaultkey) }); |
491
|
|
|
|
|
|
|
|
492
|
|
|
|
|
|
|
Retrieves a key from the hash; optionally takes a second argument that is used |
493
|
|
|
|
|
|
|
as a default value if the given key does not exist in the hash. |
494
|
|
|
|
|
|
|
|
495
|
|
|
|
|
|
|
If the second argument is a coderef, it is invoked on the object (with the |
496
|
|
|
|
|
|
|
requested key as an argument) and its return value is taken as the default |
497
|
|
|
|
|
|
|
value. |
498
|
|
|
|
|
|
|
|
499
|
|
|
|
|
|
|
=head3 keys |
500
|
|
|
|
|
|
|
|
501
|
|
|
|
|
|
|
my @keys = $hash->keys->all; |
502
|
|
|
|
|
|
|
|
503
|
|
|
|
|
|
|
Returns the list of keys in the hash as an L object. |
504
|
|
|
|
|
|
|
|
505
|
|
|
|
|
|
|
=head3 values |
506
|
|
|
|
|
|
|
|
507
|
|
|
|
|
|
|
my @vals = $hash->values->all; |
508
|
|
|
|
|
|
|
|
509
|
|
|
|
|
|
|
Returns the list of values in the hash as an L object. |
510
|
|
|
|
|
|
|
|
511
|
|
|
|
|
|
|
=head3 inverted |
512
|
|
|
|
|
|
|
|
513
|
|
|
|
|
|
|
my $hash = hash( |
514
|
|
|
|
|
|
|
a => 1, |
515
|
|
|
|
|
|
|
b => 2, |
516
|
|
|
|
|
|
|
c => 2, |
517
|
|
|
|
|
|
|
d => 3 |
518
|
|
|
|
|
|
|
); |
519
|
|
|
|
|
|
|
my $newhash = $hash->inverted; |
520
|
|
|
|
|
|
|
# $newhash = +{ |
521
|
|
|
|
|
|
|
# 1 => array('a'), |
522
|
|
|
|
|
|
|
# 2 => array('b', 'c'), |
523
|
|
|
|
|
|
|
# 3 => array('d'), |
524
|
|
|
|
|
|
|
# } |
525
|
|
|
|
|
|
|
|
526
|
|
|
|
|
|
|
Inverts the hash; the values of the original hash become keys in the new |
527
|
|
|
|
|
|
|
object. Their corresponding values are L objects containing the |
528
|
|
|
|
|
|
|
key(s) that mapped to the original value. |
529
|
|
|
|
|
|
|
|
530
|
|
|
|
|
|
|
This is a bit like reversing the hash, but lossless with regards to non-unique |
531
|
|
|
|
|
|
|
values. |
532
|
|
|
|
|
|
|
|
533
|
|
|
|
|
|
|
(Available from v2.14.1) |
534
|
|
|
|
|
|
|
|
535
|
|
|
|
|
|
|
=head3 iter |
536
|
|
|
|
|
|
|
|
537
|
|
|
|
|
|
|
my $iter = $hash->iter; |
538
|
|
|
|
|
|
|
while (my ($key, $val) = $iter->()) { |
539
|
|
|
|
|
|
|
# ... |
540
|
|
|
|
|
|
|
} |
541
|
|
|
|
|
|
|
|
542
|
|
|
|
|
|
|
Returns an iterator that, when called, returns ($key, $value) pairs. |
543
|
|
|
|
|
|
|
When the list is exhausted, an empty list is returned. |
544
|
|
|
|
|
|
|
|
545
|
|
|
|
|
|
|
The iterator operates on a shallow clone of the hash, making it safe to |
546
|
|
|
|
|
|
|
operate on the original hash while using the iterator. |
547
|
|
|
|
|
|
|
|
548
|
|
|
|
|
|
|
(Available from v2.9.1) |
549
|
|
|
|
|
|
|
|
550
|
|
|
|
|
|
|
=head3 kv |
551
|
|
|
|
|
|
|
|
552
|
|
|
|
|
|
|
for my $pair ($hash->kv->all) { |
553
|
|
|
|
|
|
|
my ($key, $val) = @$pair; |
554
|
|
|
|
|
|
|
} |
555
|
|
|
|
|
|
|
|
556
|
|
|
|
|
|
|
Returns an L object containing the key/value pairs in the hash, |
557
|
|
|
|
|
|
|
each of which is a two-element (unblessed) ARRAY. |
558
|
|
|
|
|
|
|
|
559
|
|
|
|
|
|
|
=head3 kv_grep |
560
|
|
|
|
|
|
|
|
561
|
|
|
|
|
|
|
my $positive_vals = $hash->kv_grep(sub { $b > 0 }); |
562
|
|
|
|
|
|
|
|
563
|
|
|
|
|
|
|
Like C, but operates on pairs. See L. |
564
|
|
|
|
|
|
|
|
565
|
|
|
|
|
|
|
Returns a hash-type object consisting of the key/value pairs for which the |
566
|
|
|
|
|
|
|
given block returned true. |
567
|
|
|
|
|
|
|
|
568
|
|
|
|
|
|
|
(Available from v2.21.1) |
569
|
|
|
|
|
|
|
|
570
|
|
|
|
|
|
|
=head3 kv_map |
571
|
|
|
|
|
|
|
|
572
|
|
|
|
|
|
|
# Add 1 to each value, get back an array-type object: |
573
|
|
|
|
|
|
|
my $kvs = hash(a => 2, b => 2, c => 3) |
574
|
|
|
|
|
|
|
->kv_map(sub { ($a, $b + 1) }); |
575
|
|
|
|
|
|
|
|
576
|
|
|
|
|
|
|
Like C |
577
|
|
|
|
|
|
|
|
578
|
|
|
|
|
|
|
Returns an L object containing the results of the map. |
579
|
|
|
|
|
|
|
|
580
|
|
|
|
|
|
|
(Available from v2.8.1; in versions prior to v2.20.1, C<$_[0]> and C<$_[1]> |
581
|
|
|
|
|
|
|
must be used in place of C<$a> and C<$b>, respectively.) |
582
|
|
|
|
|
|
|
|
583
|
|
|
|
|
|
|
=head3 kv_sort |
584
|
|
|
|
|
|
|
|
585
|
|
|
|
|
|
|
my $kvs = hash(a => 1, b => 2, c => 3)->kv_sort; |
586
|
|
|
|
|
|
|
# $kvs = array( |
587
|
|
|
|
|
|
|
# [ a => 1 ], |
588
|
|
|
|
|
|
|
# [ b => 2 ], |
589
|
|
|
|
|
|
|
# [ c => 3 ] |
590
|
|
|
|
|
|
|
# ) |
591
|
|
|
|
|
|
|
|
592
|
|
|
|
|
|
|
my $reversed = hash(a => 1, b => 2, c => 3) |
593
|
|
|
|
|
|
|
->kv_sort(sub { $b cmp $a }); |
594
|
|
|
|
|
|
|
# Reverse result as above |
595
|
|
|
|
|
|
|
|
596
|
|
|
|
|
|
|
Like L, but sorted by key. A sort routine can be provided. |
597
|
|
|
|
|
|
|
|
598
|
|
|
|
|
|
|
In versions prior to v2.19.1, C<$_[0]> and C<$_[1]> must be used in place of |
599
|
|
|
|
|
|
|
C<$a> and C<$b>, respectively. |
600
|
|
|
|
|
|
|
|
601
|
|
|
|
|
|
|
=head3 random_kv |
602
|
|
|
|
|
|
|
|
603
|
|
|
|
|
|
|
Returns a random key/value pair from the hash as an C-type reference. |
604
|
|
|
|
|
|
|
|
605
|
|
|
|
|
|
|
Returns undef if the hash is empty. |
606
|
|
|
|
|
|
|
|
607
|
|
|
|
|
|
|
(Available from v2.28.1) |
608
|
|
|
|
|
|
|
|
609
|
|
|
|
|
|
|
=head3 random_key |
610
|
|
|
|
|
|
|
|
611
|
|
|
|
|
|
|
Returns a random key from the hash. |
612
|
|
|
|
|
|
|
|
613
|
|
|
|
|
|
|
Returns undef if the hash is empty. |
614
|
|
|
|
|
|
|
|
615
|
|
|
|
|
|
|
(Available from v2.28.1) |
616
|
|
|
|
|
|
|
|
617
|
|
|
|
|
|
|
=head3 random_value |
618
|
|
|
|
|
|
|
|
619
|
|
|
|
|
|
|
Returns a random value from the hash. |
620
|
|
|
|
|
|
|
|
621
|
|
|
|
|
|
|
Returns undef if the hash is empty. |
622
|
|
|
|
|
|
|
|
623
|
|
|
|
|
|
|
(Available from v2.28.1) |
624
|
|
|
|
|
|
|
|
625
|
|
|
|
|
|
|
=head3 sliced |
626
|
|
|
|
|
|
|
|
627
|
|
|
|
|
|
|
my $newhash = $hash->sliced(@keys); |
628
|
|
|
|
|
|
|
|
629
|
|
|
|
|
|
|
Returns a new hash object built from the specified set of keys and their |
630
|
|
|
|
|
|
|
respective values. |
631
|
|
|
|
|
|
|
|
632
|
|
|
|
|
|
|
If a given key is not found in the hash, it is omitted from the result (this |
633
|
|
|
|
|
|
|
is different than C hash slice syntax, which sets unknown keys to |
634
|
|
|
|
|
|
|
C in the slice). |
635
|
|
|
|
|
|
|
|
636
|
|
|
|
|
|
|
If you only need the values, see L. |
637
|
|
|
|
|
|
|
|
638
|
|
|
|
|
|
|
=head2 Methods that compare hashes |
639
|
|
|
|
|
|
|
|
640
|
|
|
|
|
|
|
=head3 intersection |
641
|
|
|
|
|
|
|
|
642
|
|
|
|
|
|
|
my $first = hash(a => 1, b => 2, c => 3); |
643
|
|
|
|
|
|
|
my $second = hash(b => 2, c => 3, d => 4); |
644
|
|
|
|
|
|
|
my $intersection = $first->intersection($second); |
645
|
|
|
|
|
|
|
my @common = $intersection->sort->all; |
646
|
|
|
|
|
|
|
|
647
|
|
|
|
|
|
|
Returns the list of keys common between all given hash-type objects (including |
648
|
|
|
|
|
|
|
the invocant) as an L object. |
649
|
|
|
|
|
|
|
|
650
|
|
|
|
|
|
|
=head3 diff |
651
|
|
|
|
|
|
|
|
652
|
|
|
|
|
|
|
The opposite of L; returns the list of keys that are not common |
653
|
|
|
|
|
|
|
to all given hash-type objects (including the invocant) as an L |
654
|
|
|
|
|
|
|
object. |
655
|
|
|
|
|
|
|
|
656
|
|
|
|
|
|
|
=head1 NOTES FOR CONSUMERS |
657
|
|
|
|
|
|
|
|
658
|
|
|
|
|
|
|
If creating your own consumer of this role, some extra effort is required to |
659
|
|
|
|
|
|
|
make C<$a> and C<$b> work in sort statements without warnings; an example with |
660
|
|
|
|
|
|
|
a custom exported constructor might look something like: |
661
|
|
|
|
|
|
|
|
662
|
|
|
|
|
|
|
package My::Custom::Hash; |
663
|
|
|
|
|
|
|
use strictures 2; |
664
|
|
|
|
|
|
|
require Role::Tiny; |
665
|
|
|
|
|
|
|
Role::Tiny->apply_roles_to_package( __PACKAGE__, |
666
|
|
|
|
|
|
|
qw/ |
667
|
|
|
|
|
|
|
List::Objects::WithUtils::Role::Hash |
668
|
|
|
|
|
|
|
My::Custom::Hash::Role |
669
|
|
|
|
|
|
|
/ |
670
|
|
|
|
|
|
|
); |
671
|
|
|
|
|
|
|
|
672
|
|
|
|
|
|
|
use Exporter (); |
673
|
|
|
|
|
|
|
our @EXPORT = 'myhash'; |
674
|
|
|
|
|
|
|
sub import { |
675
|
|
|
|
|
|
|
my $pkg = caller; |
676
|
|
|
|
|
|
|
{ no strict 'refs'; |
677
|
|
|
|
|
|
|
${"${pkg}::a"} = ${"${pkg}::a"}; |
678
|
|
|
|
|
|
|
${"${pkg}::b"} = ${"${pkg}::b"}; |
679
|
|
|
|
|
|
|
} |
680
|
|
|
|
|
|
|
goto &Exporter::import |
681
|
|
|
|
|
|
|
} |
682
|
|
|
|
|
|
|
|
683
|
|
|
|
|
|
|
sub myhash { __PACKAGE__->new(@_) } |
684
|
|
|
|
|
|
|
|
685
|
|
|
|
|
|
|
=head1 SEE ALSO |
686
|
|
|
|
|
|
|
|
687
|
|
|
|
|
|
|
L |
688
|
|
|
|
|
|
|
|
689
|
|
|
|
|
|
|
L |
690
|
|
|
|
|
|
|
|
691
|
|
|
|
|
|
|
L |
692
|
|
|
|
|
|
|
|
693
|
|
|
|
|
|
|
L |
694
|
|
|
|
|
|
|
|
695
|
|
|
|
|
|
|
L |
696
|
|
|
|
|
|
|
|
697
|
|
|
|
|
|
|
=head1 AUTHOR |
698
|
|
|
|
|
|
|
|
699
|
|
|
|
|
|
|
Jon Portnoy |
700
|
|
|
|
|
|
|
|
701
|
|
|
|
|
|
|
Portions of this code are derived from L by Matthew Phillips |
702
|
|
|
|
|
|
|
(CPAN: MATTP), haarg et al |
703
|
|
|
|
|
|
|
|
704
|
|
|
|
|
|
|
Licensed under the same terms as Perl. |
705
|
|
|
|
|
|
|
|
706
|
|
|
|
|
|
|
=cut |