line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
#--------------------------------------------------------------------- |
2
|
|
|
|
|
|
|
package Data::Omap; |
3
|
|
|
|
|
|
|
#--------------------------------------------------------------------- |
4
|
|
|
|
|
|
|
|
5
|
|
|
|
|
|
|
=head1 NAME |
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
Data::Omap - Perl module to implement ordered mappings |
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
=head1 SYNOPSIS |
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
use Data::Omap; |
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
# Simple OO style |
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
my $omap = Data::Omap->new( [{a=>1},{b=>2},{c=>3}] ); |
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
$omap->set( a => 0 ); |
18
|
|
|
|
|
|
|
$omap->add( b2 => 2.5, 2 ); # insert at position 2 (between b and c) |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
my $value = $omap->get_values( 'c' ); # 3 |
21
|
|
|
|
|
|
|
my @keys = $omap->get_keys(); # (a, b, b2, c) |
22
|
|
|
|
|
|
|
my @values = $omap->get_values(); # (0, 2, 2.5, 3) |
23
|
|
|
|
|
|
|
my @subset = $omap->get_values(qw(c b)); # (2, 3) (values are data-ordered) |
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
# Tied style |
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
my %omap; |
28
|
|
|
|
|
|
|
# recommend saving an object reference, too. |
29
|
|
|
|
|
|
|
my $omap = tie %omap, 'Data::Omap', [{a=>1},{b=>2},{c=>3}]; |
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
$omap{ a } = 0; |
32
|
|
|
|
|
|
|
$omap->add( b2 => 2.5, 2 ); # there's no tied hash equivalent |
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
my $value = $omap{ c }; |
35
|
|
|
|
|
|
|
my @keys = keys %omap; # $omap->get_keys() is faster |
36
|
|
|
|
|
|
|
my @values = values %omap; # $omap->get_values() is faster |
37
|
|
|
|
|
|
|
my @slice = @omap{qw(c b)}; # (3, 2) (slice values are parameter-ordered) |
38
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
# Non-OO style |
40
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
use Data::Omap ':ALL'; |
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
my $omap = [{a=>1},{b=>2},{c=>3}]; # new-ish, but not blessed |
44
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
omap_set( $omap, a => 0 ); # (pass omap as first parameter) |
46
|
|
|
|
|
|
|
omap_add( $omap, b2 => 2.5, 2 ); # insert at position 2 (between b and c) |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
my $value = omap_get_values( $omap, 'c' ); # 3 |
49
|
|
|
|
|
|
|
my @keys = omap_get_keys( $omap ); # (a, b, b2, c) |
50
|
|
|
|
|
|
|
my @values = omap_get_values( $omap ); # (0, 2, 2.5, 3) |
51
|
|
|
|
|
|
|
my @subset = omap_get_values( $omap, qw(c b) ); # (2, 3) (values are data-ordered) |
52
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
# There are more methods/options, see below. |
54
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
=head1 DESCRIPTION |
56
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
This module implements the Data::Omap class. Objects in this class |
58
|
|
|
|
|
|
|
are ordered mappings, i.e., they are hashes in which the key/value |
59
|
|
|
|
|
|
|
pairs are in order. This is defined in shorthand as C in the |
60
|
|
|
|
|
|
|
YAML tag repository: http://yaml.org/type/omap.html. |
61
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
The keys in Data::Omap objects are unique, like regular hashes. |
63
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
A closely related class, Data::Pairs, implements the YAML C |
65
|
|
|
|
|
|
|
data type, http://yaml.org/type/pairs.html. Data::Pairs objects are |
66
|
|
|
|
|
|
|
also ordered sequences of key:value pairs but they allow duplicate |
67
|
|
|
|
|
|
|
keys. |
68
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
While ordered mappings are in order, they are not necessarily in a |
70
|
|
|
|
|
|
|
I order, i.e., they are not necessarily sorted in any |
71
|
|
|
|
|
|
|
way. They simply have a predictable set order (unlike regular hashes |
72
|
|
|
|
|
|
|
whose key/value pairs are in no set order). |
73
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
By default, Data::Omap will add new key/value pairs at the end of the |
75
|
|
|
|
|
|
|
mapping, but you may request that they be merged in a particular |
76
|
|
|
|
|
|
|
order with the C class method. |
77
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
However, even though Data::Omap will honor the requested order, it |
79
|
|
|
|
|
|
|
will not attempt to I the mapping in that order. By passing |
80
|
|
|
|
|
|
|
position values to the C and C methods, you may insert |
81
|
|
|
|
|
|
|
new pairs anywhere in the mapping and Data::Omap will not complain. |
82
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
=head1 IMPLEMENTATION |
84
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
Normally, the underlying structure of an OO object is encapsulated |
86
|
|
|
|
|
|
|
and not directly accessible (when you play nice). One key |
87
|
|
|
|
|
|
|
implementation detail of Data::Omap is the desire that the underlying |
88
|
|
|
|
|
|
|
ordered mapping data structure (an array of single-key hashes) be |
89
|
|
|
|
|
|
|
publically maintained as such and directly accessible if desired. |
90
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
To that end, no attributes but the data itself are stored in the |
92
|
|
|
|
|
|
|
objects. In the current version, that is why C is a class |
93
|
|
|
|
|
|
|
method rather than an object method. In the future, inside-out |
94
|
|
|
|
|
|
|
techniques may be used to enable object-level ordering. |
95
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
This data structure is inefficient in several ways as compared to |
97
|
|
|
|
|
|
|
regular hashes: rather than one hash, it contains a separate hash per |
98
|
|
|
|
|
|
|
key/value pair; because it's an array, key lookups (in the current |
99
|
|
|
|
|
|
|
version) have to loop through it. |
100
|
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
The advantage if using this structure is simply that it "natively" |
102
|
|
|
|
|
|
|
matches the structure defined in YAML. So if the (unblessed) |
103
|
|
|
|
|
|
|
structure is dumped using YAML (or perhaps JSON), it may be read as |
104
|
|
|
|
|
|
|
is by another program, perhaps in another language. It is true that |
105
|
|
|
|
|
|
|
this could be accomplished by passing the object through a formatting |
106
|
|
|
|
|
|
|
routine, but I wanted to see first how this implementation might work. |
107
|
|
|
|
|
|
|
|
108
|
|
|
|
|
|
|
=head1 VERSION |
109
|
|
|
|
|
|
|
|
110
|
|
|
|
|
|
|
Data::Omap version 0.06 |
111
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
=cut |
113
|
|
|
|
|
|
|
|
114
|
8
|
|
|
8
|
|
332722
|
use 5.008003; |
|
8
|
|
|
|
|
37
|
|
|
8
|
|
|
|
|
335
|
|
115
|
8
|
|
|
8
|
|
49
|
use strict; |
|
8
|
|
|
|
|
14
|
|
|
8
|
|
|
|
|
289
|
|
116
|
8
|
|
|
8
|
|
42
|
use warnings; |
|
8
|
|
|
|
|
19
|
|
|
8
|
|
|
|
|
421
|
|
117
|
|
|
|
|
|
|
|
118
|
|
|
|
|
|
|
our $VERSION = '0.06'; |
119
|
|
|
|
|
|
|
|
120
|
8
|
|
|
8
|
|
48
|
use Scalar::Util qw( reftype looks_like_number ); |
|
8
|
|
|
|
|
13
|
|
|
8
|
|
|
|
|
1037
|
|
121
|
8
|
|
|
8
|
|
77
|
use Carp; |
|
8
|
|
|
|
|
99
|
|
|
8
|
|
|
|
|
508
|
|
122
|
8
|
|
|
8
|
|
43
|
use Exporter qw( import ); |
|
8
|
|
|
|
|
888
|
|
|
8
|
|
|
|
|
23828
|
|
123
|
|
|
|
|
|
|
our @EXPORT_OK = qw( |
124
|
|
|
|
|
|
|
omap_set omap_get_values omap_get_keys |
125
|
|
|
|
|
|
|
omap_exists omap_delete omap_clear |
126
|
|
|
|
|
|
|
omap_add omap_order omap_get_pos |
127
|
|
|
|
|
|
|
omap_get_pos_hash omap_get_array |
128
|
|
|
|
|
|
|
omap_is_valid omap_errstr |
129
|
|
|
|
|
|
|
); |
130
|
|
|
|
|
|
|
our %EXPORT_TAGS = ( |
131
|
|
|
|
|
|
|
STD => [qw( |
132
|
|
|
|
|
|
|
omap_set omap_get_values omap_get_keys |
133
|
|
|
|
|
|
|
omap_exists omap_delete omap_clear )], |
134
|
|
|
|
|
|
|
ALL => [qw( |
135
|
|
|
|
|
|
|
omap_set omap_get_values omap_get_keys |
136
|
|
|
|
|
|
|
omap_exists omap_delete omap_clear |
137
|
|
|
|
|
|
|
omap_add omap_order omap_get_pos |
138
|
|
|
|
|
|
|
omap_get_pos_hash omap_get_array |
139
|
|
|
|
|
|
|
omap_is_valid omap_errstr )], |
140
|
|
|
|
|
|
|
); |
141
|
|
|
|
|
|
|
|
142
|
|
|
|
|
|
|
my $order; # package global, see order() accessor |
143
|
|
|
|
|
|
|
our $errstr; # error message |
144
|
|
|
|
|
|
|
|
145
|
|
|
|
|
|
|
#--------------------------------------------------------------------- |
146
|
|
|
|
|
|
|
|
147
|
|
|
|
|
|
|
=head1 CLASS METHODS |
148
|
|
|
|
|
|
|
|
149
|
|
|
|
|
|
|
=head2 Data::Omap->new(); |
150
|
|
|
|
|
|
|
|
151
|
|
|
|
|
|
|
Constructs a new Data::Omap object. |
152
|
|
|
|
|
|
|
|
153
|
|
|
|
|
|
|
Accepts array ref containing single-key hash refs, e.g., |
154
|
|
|
|
|
|
|
|
155
|
|
|
|
|
|
|
my $omap = Data::Omap->new( [ { a => 1 }, { b => 2 }, { c => 3 } ] ); |
156
|
|
|
|
|
|
|
|
157
|
|
|
|
|
|
|
When provided, this data will be loaded into the object. |
158
|
|
|
|
|
|
|
|
159
|
|
|
|
|
|
|
Returns a reference to the Data::Omap object. |
160
|
|
|
|
|
|
|
|
161
|
|
|
|
|
|
|
=cut |
162
|
|
|
|
|
|
|
|
163
|
|
|
|
|
|
|
sub new { |
164
|
22
|
|
|
22
|
1
|
12285
|
my( $class, $aref ) = @_; |
165
|
22
|
100
|
|
|
|
90
|
return bless [], $class unless $aref; |
166
|
|
|
|
|
|
|
|
167
|
19
|
100
|
|
|
|
49
|
croak omap_errstr() unless omap_is_valid( $aref ); |
168
|
12
|
|
|
|
|
71
|
bless $aref, $class; |
169
|
|
|
|
|
|
|
} |
170
|
|
|
|
|
|
|
|
171
|
|
|
|
|
|
|
sub omap_is_valid { |
172
|
19
|
|
|
19
|
0
|
31
|
my( $aref ) = @_; |
173
|
19
|
100
|
66
|
|
|
248
|
unless( $aref and ref( $aref ) and reftype( $aref ) eq 'ARRAY' ) { |
|
|
|
100
|
|
|
|
|
174
|
2
|
|
|
|
|
3
|
$errstr = "Invalid omap: Not an array reference"; |
175
|
2
|
|
|
|
|
10
|
return; |
176
|
|
|
|
|
|
|
} |
177
|
17
|
|
|
|
|
24
|
my %seen; |
178
|
17
|
|
|
|
|
43
|
for my $href ( @$aref ) { |
179
|
40
|
100
|
|
|
|
124
|
unless( ref( $href ) eq 'HASH' ) { |
180
|
3
|
|
|
|
|
5
|
$errstr = "Invalid omap: Not a hash reference"; |
181
|
3
|
|
|
|
|
12
|
return; |
182
|
|
|
|
|
|
|
} |
183
|
37
|
|
|
|
|
109
|
my @keys = keys %$href; |
184
|
37
|
100
|
|
|
|
94
|
if( @keys > 1 ) { |
185
|
1
|
|
|
|
|
2
|
$errstr = "Invalid omap: Not a single-key hash"; |
186
|
1
|
|
|
|
|
4
|
return; |
187
|
|
|
|
|
|
|
} |
188
|
36
|
100
|
|
|
|
163
|
if( $seen{ $keys[0] }++ ) { |
189
|
1
|
|
|
|
|
4
|
$errstr = "Invalid omap: Duplicate key: '$keys[0]'"; |
190
|
1
|
|
|
|
|
4
|
return; |
191
|
|
|
|
|
|
|
} |
192
|
|
|
|
|
|
|
} |
193
|
12
|
|
|
|
|
51
|
return 1; # is valid |
194
|
|
|
|
|
|
|
} |
195
|
|
|
|
|
|
|
|
196
|
|
|
|
|
|
|
sub omap_errstr { |
197
|
7
|
|
|
7
|
0
|
10
|
my $msg = $errstr; |
198
|
7
|
|
|
|
|
10
|
$errstr = ""; |
199
|
7
|
|
|
|
|
778
|
$msg; # returned |
200
|
|
|
|
|
|
|
} |
201
|
|
|
|
|
|
|
|
202
|
|
|
|
|
|
|
#--------------------------------------------------------------------- |
203
|
|
|
|
|
|
|
|
204
|
|
|
|
|
|
|
=head2 Data::Omap->order( [$predefined_ordering | coderef] ); |
205
|
|
|
|
|
|
|
|
206
|
|
|
|
|
|
|
When ordering is ON, new key/value pairs will be added in the |
207
|
|
|
|
|
|
|
specified order. When ordering is OFF (the default), new pairs |
208
|
|
|
|
|
|
|
will be added to the end of the mapping. |
209
|
|
|
|
|
|
|
|
210
|
|
|
|
|
|
|
When called with no parameters, C returns the current code |
211
|
|
|
|
|
|
|
reference (if ordering is ON) or a false value (if ordering is OFF); |
212
|
|
|
|
|
|
|
it does not change the ordering. |
213
|
|
|
|
|
|
|
|
214
|
|
|
|
|
|
|
Data::Omap->order(); # leaves ordering as is |
215
|
|
|
|
|
|
|
|
216
|
|
|
|
|
|
|
When called with the null string, C<''>, ordering is turned OFF. |
217
|
|
|
|
|
|
|
|
218
|
|
|
|
|
|
|
Data::Omap->order( '' ); # turn ordering OFF (the default) |
219
|
|
|
|
|
|
|
|
220
|
|
|
|
|
|
|
Otherwise, accepts the predefined orderings: 'na', 'nd', 'sa', 'sd', |
221
|
|
|
|
|
|
|
'sna', and 'snd', or a custom code reference, e.g. |
222
|
|
|
|
|
|
|
|
223
|
|
|
|
|
|
|
Data::Omap->order( 'na' ); # numeric ascending |
224
|
|
|
|
|
|
|
Data::Omap->order( 'nd' ); # numeric descending |
225
|
|
|
|
|
|
|
Data::Omap->order( 'sa' ); # string ascending |
226
|
|
|
|
|
|
|
Data::Omap->order( 'sd' ); # string descending |
227
|
|
|
|
|
|
|
Data::Omap->order( 'sna' ); # string/numeric ascending |
228
|
|
|
|
|
|
|
Data::Omap->order( 'snd' ); # string/numeric descending |
229
|
|
|
|
|
|
|
Data::Omap->order( sub{ int($_[0]/100) < int($_[1]/100) } ); # code |
230
|
|
|
|
|
|
|
|
231
|
|
|
|
|
|
|
The predefined orderings, 'na' and 'nd', compare keys as numbers. |
232
|
|
|
|
|
|
|
The orderings, 'sa' and 'sd', compare keys as strings. The |
233
|
|
|
|
|
|
|
orderings, 'sna' and 'snd', compare keys as numbers when they are |
234
|
|
|
|
|
|
|
both numbers, as strings otherwise. |
235
|
|
|
|
|
|
|
|
236
|
|
|
|
|
|
|
When defining a custom ordering, the convention is to use the |
237
|
|
|
|
|
|
|
operators C<< < >> or C between (functions of) C<$_[0]> and |
238
|
|
|
|
|
|
|
C<$_[1]> for ascending and between C<$_[1]> and C<$_[0]> for |
239
|
|
|
|
|
|
|
descending. |
240
|
|
|
|
|
|
|
|
241
|
|
|
|
|
|
|
Returns the code reference if ordering is ON, a false value if OFF. |
242
|
|
|
|
|
|
|
|
243
|
|
|
|
|
|
|
Note, when object-level ordering is implemented, it is expected that |
244
|
|
|
|
|
|
|
the class-level option will still be available. In that case, any |
245
|
|
|
|
|
|
|
new objects will inherit the class-level ordering unless overridden |
246
|
|
|
|
|
|
|
at the object level. |
247
|
|
|
|
|
|
|
|
248
|
|
|
|
|
|
|
=cut |
249
|
|
|
|
|
|
|
|
250
|
|
|
|
|
|
|
*omap_order = \ℴ |
251
|
|
|
|
|
|
|
sub order { |
252
|
48
|
|
|
48
|
1
|
2366
|
my( $class, $spec ) = @_; # class not actually used ... |
253
|
48
|
100
|
|
|
|
189
|
return $order unless defined $spec; |
254
|
|
|
|
|
|
|
|
255
|
36
|
100
|
|
|
|
90
|
if( ref( $spec ) eq 'CODE' ) { |
256
|
4
|
|
|
|
|
11
|
$order = $spec; |
257
|
|
|
|
|
|
|
} |
258
|
|
|
|
|
|
|
else { |
259
|
|
|
|
|
|
|
$order = { |
260
|
|
|
|
|
|
|
'' => '', # turn off ordering |
261
|
18
|
|
|
18
|
|
62
|
na => sub{ $_[0] < $_[1] }, # number ascending |
262
|
15
|
|
|
15
|
|
45
|
nd => sub{ $_[1] < $_[0] }, # number descending |
263
|
33
|
|
|
33
|
|
95
|
sa => sub{ $_[0] lt $_[1] }, # string ascending |
264
|
30
|
|
|
30
|
|
86
|
sd => sub{ $_[1] lt $_[0] }, # string descending |
265
|
|
|
|
|
|
|
sna => sub{ # either ascending |
266
|
30
|
100
|
100
|
30
|
|
214
|
looks_like_number($_[0])&&looks_like_number($_[1])? |
267
|
|
|
|
|
|
|
$_[0] < $_[1]: $_[0] lt $_[1] }, |
268
|
|
|
|
|
|
|
snd => sub{ # either descending |
269
|
45
|
100
|
100
|
45
|
|
308
|
looks_like_number($_[0])&&looks_like_number($_[1])? |
270
|
|
|
|
|
|
|
$_[1] < $_[0]: $_[1] lt $_[0] }, |
271
|
32
|
|
|
|
|
454
|
}->{ $spec }; |
272
|
32
|
50
|
|
|
|
409
|
croak "\$spec($spec) not recognized" unless defined $order; |
273
|
|
|
|
|
|
|
} |
274
|
36
|
|
|
|
|
98
|
return $order; |
275
|
|
|
|
|
|
|
} |
276
|
|
|
|
|
|
|
|
277
|
|
|
|
|
|
|
#--------------------------------------------------------------------- |
278
|
|
|
|
|
|
|
|
279
|
|
|
|
|
|
|
=head1 OBJECT METHODS |
280
|
|
|
|
|
|
|
|
281
|
|
|
|
|
|
|
=head2 $omap->set( $key => $value[, $pos] ); |
282
|
|
|
|
|
|
|
|
283
|
|
|
|
|
|
|
Sets the value if C<$key> exists; adds a new key/value pair if not. |
284
|
|
|
|
|
|
|
|
285
|
|
|
|
|
|
|
Accepts C<$key>, C<$value>, and optionally, C<$pos>. |
286
|
|
|
|
|
|
|
|
287
|
|
|
|
|
|
|
If C<$pos> is given, and there is a key/value pair at that position, |
288
|
|
|
|
|
|
|
it will be set to C<$key> and C<$value>, I
|
289
|
|
|
|
|
|
|
different>. For example: |
290
|
|
|
|
|
|
|
|
291
|
|
|
|
|
|
|
my $omap = Data::Omap->new( [{a=>1},{b=>2}] ); |
292
|
|
|
|
|
|
|
$omap->set( c => 3, 0 ); # omap is now [{c=>3},{b=>2}] |
293
|
|
|
|
|
|
|
|
294
|
|
|
|
|
|
|
(As implied by the example, positions start at 0.) |
295
|
|
|
|
|
|
|
|
296
|
|
|
|
|
|
|
If C<$pos> is given, and there isn't a pair there, a new pair is |
297
|
|
|
|
|
|
|
added there (perhaps overriding a defined ordering). |
298
|
|
|
|
|
|
|
|
299
|
|
|
|
|
|
|
If C<$pos> is not given, the key will be located and if found, |
300
|
|
|
|
|
|
|
the value set. If the key is not found, a new pair is added to the |
301
|
|
|
|
|
|
|
end or merged according to the defined C. |
302
|
|
|
|
|
|
|
|
303
|
|
|
|
|
|
|
Note that C will croak if a duplicate key would result. This |
304
|
|
|
|
|
|
|
would only happen if C<$pos> is given and the C<$key> is found--but |
305
|
|
|
|
|
|
|
not at that position. |
306
|
|
|
|
|
|
|
|
307
|
|
|
|
|
|
|
Returns C<$value> (as a nod toward $hash{$key}=$value, which |
308
|
|
|
|
|
|
|
"returns" $value). |
309
|
|
|
|
|
|
|
|
310
|
|
|
|
|
|
|
=cut |
311
|
|
|
|
|
|
|
|
312
|
|
|
|
|
|
|
*omap_set = \&set; |
313
|
|
|
|
|
|
|
sub set { |
314
|
131
|
|
|
131
|
1
|
7363
|
my( $self, $key, $value, $pos ) = @_; |
315
|
131
|
50
|
|
|
|
297
|
return unless defined $key; |
316
|
|
|
|
|
|
|
|
317
|
|
|
|
|
|
|
# you can give a $pos to change a member including changing its key |
318
|
|
|
|
|
|
|
# ... but not if doing so would duplicate a key in the object |
319
|
|
|
|
|
|
|
|
320
|
|
|
|
|
|
|
# pos found action |
321
|
|
|
|
|
|
|
# ----- ----- ------ |
322
|
|
|
|
|
|
|
# def def -> set key/value at pos (if pos == found) |
323
|
|
|
|
|
|
|
# def undef -> set key/value at pos |
324
|
|
|
|
|
|
|
# undef def -> set key/value at found |
325
|
|
|
|
|
|
|
# undef undef -> add key/value (according to order) |
326
|
|
|
|
|
|
|
|
327
|
131
|
|
|
|
|
227
|
my $found = omap_get_pos( $self, $key ); |
328
|
131
|
|
|
|
|
299
|
my $elem = { $key => $value }; |
329
|
|
|
|
|
|
|
|
330
|
131
|
50
|
66
|
|
|
525
|
if( defined $pos and defined $found ) { |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
331
|
0
|
0
|
|
|
|
0
|
croak "\$pos($pos) too large" if $pos > $#$self+1; |
332
|
0
|
0
|
|
|
|
0
|
croak "\$key($key) found, but not at \$pos($pos): duplicate keys not allowed" |
333
|
|
|
|
|
|
|
if $found != $pos; |
334
|
0
|
|
|
|
|
0
|
$self->[ $pos ] = $elem; # pos == found |
335
|
|
|
|
|
|
|
} |
336
|
|
|
|
|
|
|
elsif( defined $pos ) { |
337
|
6
|
100
|
|
|
|
571
|
croak "\$pos($pos) too large" if $pos > $#$self+1; |
338
|
4
|
|
|
|
|
10
|
$self->[ $pos ] = $elem; |
339
|
|
|
|
|
|
|
} |
340
|
7
|
|
|
|
|
15
|
elsif( defined $found ) { $self->[ $found ] = $elem } |
341
|
118
|
|
|
|
|
200
|
else { omap_add_ordered( $self, $key, $value ) } |
342
|
|
|
|
|
|
|
|
343
|
129
|
|
|
|
|
472
|
$value; # returned |
344
|
|
|
|
|
|
|
} |
345
|
|
|
|
|
|
|
|
346
|
|
|
|
|
|
|
#--------------------------------------------------------------------- |
347
|
|
|
|
|
|
|
|
348
|
|
|
|
|
|
|
=head2 $omap->get_values( [$key[, @keys]] ); |
349
|
|
|
|
|
|
|
|
350
|
|
|
|
|
|
|
Get a value or values. |
351
|
|
|
|
|
|
|
|
352
|
|
|
|
|
|
|
Regardless of parameters, if the object is empty, undef is returned in |
353
|
|
|
|
|
|
|
scalar context, an empty list in list context. |
354
|
|
|
|
|
|
|
|
355
|
|
|
|
|
|
|
If no parameters, gets all the values. In scalar context, gives |
356
|
|
|
|
|
|
|
number of values in the object. |
357
|
|
|
|
|
|
|
|
358
|
|
|
|
|
|
|
my $omap = Data::Omap->new( [{a=>1},{b=>2},{c=>3}] ); |
359
|
|
|
|
|
|
|
my @values = $omap->get_values(); # (1, 2, 3) |
360
|
|
|
|
|
|
|
my $howmany = $omap->get_values(); # 3 |
361
|
|
|
|
|
|
|
|
362
|
|
|
|
|
|
|
If one key is given, that value is returned--regardless of |
363
|
|
|
|
|
|
|
context--or if not found, C. |
364
|
|
|
|
|
|
|
|
365
|
|
|
|
|
|
|
@values = $omap->get_values( 'b' ); # (2) |
366
|
|
|
|
|
|
|
my $value = $omap->get_values( 'b' ); # 2 |
367
|
|
|
|
|
|
|
|
368
|
|
|
|
|
|
|
If multiple keys given, their values are returned in the order found |
369
|
|
|
|
|
|
|
in the object, not the order of the given keys (unlike hash slices |
370
|
|
|
|
|
|
|
which return values in the order requested). |
371
|
|
|
|
|
|
|
|
372
|
|
|
|
|
|
|
In scalar context, gives the number of values found, e.g., |
373
|
|
|
|
|
|
|
|
374
|
|
|
|
|
|
|
@values = $omap->get_values( 'c', 'b', 'A' ); # (2, 3) |
375
|
|
|
|
|
|
|
$howmany = $omap->get_values( 'c', 'b', 'A' ); # 2 |
376
|
|
|
|
|
|
|
|
377
|
|
|
|
|
|
|
The hash slice behavior is available if you use C, see below. |
378
|
|
|
|
|
|
|
|
379
|
|
|
|
|
|
|
=cut |
380
|
|
|
|
|
|
|
|
381
|
|
|
|
|
|
|
*omap_get_values = \&get_values; |
382
|
|
|
|
|
|
|
sub get_values { |
383
|
51
|
|
|
51
|
1
|
11585
|
my( $self, @keys ) = @_; |
384
|
51
|
100
|
|
|
|
139
|
return unless @$self; |
385
|
|
|
|
|
|
|
|
386
|
50
|
100
|
|
|
|
146
|
if( @keys == 1 ) { # most common case |
|
|
100
|
|
|
|
|
|
387
|
26
|
|
|
|
|
32
|
my $wantkey = $keys[0]; |
388
|
26
|
|
|
|
|
43
|
for my $href ( @$self ) { |
389
|
62
|
|
|
|
|
103
|
my ( $key ) = keys %$href; |
390
|
62
|
100
|
|
|
|
138
|
if( $key eq $wantkey ) { |
391
|
26
|
|
|
|
|
34
|
my ( $value ) = values %$href; |
392
|
26
|
|
|
|
|
110
|
return $value; |
393
|
|
|
|
|
|
|
} |
394
|
|
|
|
|
|
|
} |
395
|
0
|
|
|
|
|
0
|
return; # key not found |
396
|
|
|
|
|
|
|
} |
397
|
|
|
|
|
|
|
|
398
|
|
|
|
|
|
|
elsif( @keys ) { |
399
|
16
|
|
|
|
|
24
|
my @ret; |
400
|
16
|
|
|
|
|
32
|
for my $href ( @$self ) { |
401
|
56
|
|
|
|
|
90
|
my ( $key ) = keys %$href; |
402
|
56
|
|
|
|
|
87
|
for ( @keys ) { |
403
|
124
|
100
|
|
|
|
235
|
if( $key eq $_ ) { |
404
|
48
|
|
|
|
|
62
|
my ( $value ) = values %$href; |
405
|
48
|
|
|
|
|
53
|
push @ret, $value; |
406
|
48
|
|
|
|
|
81
|
last; |
407
|
|
|
|
|
|
|
} |
408
|
|
|
|
|
|
|
} |
409
|
|
|
|
|
|
|
} |
410
|
16
|
|
|
|
|
74
|
return @ret; |
411
|
|
|
|
|
|
|
} |
412
|
|
|
|
|
|
|
|
413
|
|
|
|
|
|
|
else { |
414
|
8
|
|
|
|
|
11
|
my @ret; |
415
|
8
|
|
|
|
|
18
|
for my $href ( @$self ) { |
416
|
26
|
|
|
|
|
41
|
my ( $value ) = values %$href; |
417
|
26
|
|
|
|
|
45
|
push @ret, $value; |
418
|
|
|
|
|
|
|
} |
419
|
8
|
|
|
|
|
35
|
return @ret; |
420
|
|
|
|
|
|
|
} |
421
|
|
|
|
|
|
|
} |
422
|
|
|
|
|
|
|
|
423
|
|
|
|
|
|
|
#--------------------------------------------------------------------- |
424
|
|
|
|
|
|
|
|
425
|
|
|
|
|
|
|
=head2 $omap->add( $key => $value[, $pos] ); |
426
|
|
|
|
|
|
|
|
427
|
|
|
|
|
|
|
Adds a key/value pair to the object. |
428
|
|
|
|
|
|
|
|
429
|
|
|
|
|
|
|
Accepts C<$key>, C<$value>, and optionally, C<$pos>. |
430
|
|
|
|
|
|
|
|
431
|
|
|
|
|
|
|
If C<$pos> is given, the key/value pair will be added (inserted) |
432
|
|
|
|
|
|
|
there (possibly overriding a defined order), e.g., |
433
|
|
|
|
|
|
|
|
434
|
|
|
|
|
|
|
my $omap = Data::Omap->new( [{a=>1},{b=>2}] ); |
435
|
|
|
|
|
|
|
$omap->add( c => 3, 1 ); # omap is now [{a=>1},{c=>3},{b=>2}] |
436
|
|
|
|
|
|
|
|
437
|
|
|
|
|
|
|
(Positions start at 0.) |
438
|
|
|
|
|
|
|
|
439
|
|
|
|
|
|
|
If C<$pos> is not given, a new pair is added to the end or merged |
440
|
|
|
|
|
|
|
according to the defined C. |
441
|
|
|
|
|
|
|
|
442
|
|
|
|
|
|
|
Note that C will croak if a duplicate key would result, i.e., |
443
|
|
|
|
|
|
|
if the key being added is already in the object. |
444
|
|
|
|
|
|
|
|
445
|
|
|
|
|
|
|
Returns C<$value>. |
446
|
|
|
|
|
|
|
|
447
|
|
|
|
|
|
|
=cut |
448
|
|
|
|
|
|
|
|
449
|
|
|
|
|
|
|
*omap_add = \&add; |
450
|
|
|
|
|
|
|
sub add { |
451
|
33
|
|
|
33
|
1
|
12509
|
my( $self, $key, $value, $pos ) = @_; |
452
|
33
|
50
|
|
|
|
92
|
return unless defined $key; |
453
|
|
|
|
|
|
|
|
454
|
33
|
|
|
|
|
67
|
my $found = omap_get_pos( $self, $key ); |
455
|
33
|
50
|
|
|
|
71
|
croak "\$key($key) found: duplicate keys not allowed" if defined $found; |
456
|
|
|
|
|
|
|
|
457
|
33
|
|
|
|
|
79
|
my $elem = { $key => $value }; |
458
|
33
|
100
|
|
|
|
65
|
if( defined $pos ) { |
459
|
9
|
100
|
|
|
|
220
|
croak "\$pos($pos) too large" if $pos > $#$self+1; |
460
|
7
|
|
|
|
|
108
|
splice @$self, $pos, 0, $elem; |
461
|
|
|
|
|
|
|
} |
462
|
|
|
|
|
|
|
else { |
463
|
24
|
|
|
|
|
49
|
omap_add_ordered( $self, $key, $value ); |
464
|
|
|
|
|
|
|
} |
465
|
|
|
|
|
|
|
|
466
|
31
|
|
|
|
|
84
|
$value; # returned |
467
|
|
|
|
|
|
|
} |
468
|
|
|
|
|
|
|
|
469
|
|
|
|
|
|
|
#--------------------------------------------------------------------- |
470
|
|
|
|
|
|
|
|
471
|
|
|
|
|
|
|
=head2 omap_add_ordered( $omap, $key => $value ); |
472
|
|
|
|
|
|
|
|
473
|
|
|
|
|
|
|
Private routine used by C and C. |
474
|
|
|
|
|
|
|
|
475
|
|
|
|
|
|
|
Accepts C<$key> and C<$value>. |
476
|
|
|
|
|
|
|
|
477
|
|
|
|
|
|
|
Adds a new key/value pair to the end or merged according to the |
478
|
|
|
|
|
|
|
defined C. |
479
|
|
|
|
|
|
|
|
480
|
|
|
|
|
|
|
This routine should not be called directly, because it does not |
481
|
|
|
|
|
|
|
check for duplicates. |
482
|
|
|
|
|
|
|
|
483
|
|
|
|
|
|
|
Has no defined return value. |
484
|
|
|
|
|
|
|
|
485
|
|
|
|
|
|
|
=cut |
486
|
|
|
|
|
|
|
|
487
|
|
|
|
|
|
|
sub omap_add_ordered { |
488
|
142
|
|
|
142
|
1
|
187
|
my( $self, $key, $value ) = @_; |
489
|
142
|
|
|
|
|
256
|
my $elem = { $key => $value }; |
490
|
|
|
|
|
|
|
|
491
|
142
|
100
|
|
|
|
317
|
unless( $order ) { push @$self, $elem; return } |
|
10
|
|
|
|
|
24
|
|
|
10
|
|
|
|
|
24
|
|
492
|
|
|
|
|
|
|
|
493
|
|
|
|
|
|
|
# optimization for when members are added in order |
494
|
132
|
100
|
|
|
|
236
|
if( @$self ) { |
495
|
105
|
|
|
|
|
97
|
my ( $key2 ) = keys %{$self->[-1]}; # at the end |
|
105
|
|
|
|
|
203
|
|
496
|
105
|
100
|
|
|
|
198
|
unless( $order->( $key, $key2 ) ) { |
497
|
33
|
|
|
|
|
107
|
push @$self, $elem; |
498
|
33
|
|
|
|
|
61
|
return; |
499
|
|
|
|
|
|
|
} |
500
|
|
|
|
|
|
|
} |
501
|
|
|
|
|
|
|
|
502
|
|
|
|
|
|
|
# else start comparing at the beginning |
503
|
99
|
|
|
|
|
242
|
for my $i ( 0 .. $#$self ) { |
504
|
93
|
|
|
|
|
98
|
my ( $key2 ) = keys %{$self->[ $i ]}; |
|
93
|
|
|
|
|
170
|
|
505
|
93
|
100
|
|
|
|
164
|
if( $order->( $key, $key2 ) ) { # XXX can we memoize $key in $order->()? |
506
|
72
|
|
|
|
|
144
|
splice @$self, $i, 0, $elem; |
507
|
72
|
|
|
|
|
137
|
return; |
508
|
|
|
|
|
|
|
} |
509
|
|
|
|
|
|
|
} |
510
|
|
|
|
|
|
|
|
511
|
27
|
|
|
|
|
62
|
push @$self, $elem; |
512
|
|
|
|
|
|
|
} |
513
|
|
|
|
|
|
|
|
514
|
|
|
|
|
|
|
#--------------------------------------------------------------------- |
515
|
|
|
|
|
|
|
|
516
|
|
|
|
|
|
|
=head2 $omap->get_pos( $key ); |
517
|
|
|
|
|
|
|
|
518
|
|
|
|
|
|
|
Gets position where a key is found. |
519
|
|
|
|
|
|
|
|
520
|
|
|
|
|
|
|
Accepts one key (any extras are silently ignored). |
521
|
|
|
|
|
|
|
|
522
|
|
|
|
|
|
|
Returns the position or undef (if key not found), regardless of context, e.g., |
523
|
|
|
|
|
|
|
|
524
|
|
|
|
|
|
|
my $omap = Data::Omap->new( [{a=>1},{b=>2},{c=>3}] ); |
525
|
|
|
|
|
|
|
my @pos = $omap->get_pos( 'b' ); # (1) |
526
|
|
|
|
|
|
|
my $pos = $omap->get_pos( 'b' ); # 1 |
527
|
|
|
|
|
|
|
|
528
|
|
|
|
|
|
|
Returns C if no key given or object is empty. |
529
|
|
|
|
|
|
|
|
530
|
|
|
|
|
|
|
=cut |
531
|
|
|
|
|
|
|
|
532
|
|
|
|
|
|
|
*omap_get_pos = \&get_pos; |
533
|
|
|
|
|
|
|
sub get_pos { |
534
|
180
|
|
|
180
|
1
|
2893
|
my( $self, $wantkey ) = @_; |
535
|
180
|
50
|
|
|
|
339
|
return unless $wantkey; |
536
|
180
|
100
|
|
|
|
359
|
return unless @$self; |
537
|
152
|
|
|
|
|
326
|
for my $i ( 0 .. $#$self ) { |
538
|
398
|
|
|
|
|
386
|
my ( $key ) = keys %{$self->[ $i ]}; |
|
398
|
|
|
|
|
840
|
|
539
|
398
|
100
|
|
|
|
1060
|
if( $key eq $wantkey ) { |
540
|
21
|
|
|
|
|
86
|
return $i; |
541
|
|
|
|
|
|
|
} |
542
|
|
|
|
|
|
|
} |
543
|
131
|
|
|
|
|
257
|
return; # key not found |
544
|
|
|
|
|
|
|
} |
545
|
|
|
|
|
|
|
|
546
|
|
|
|
|
|
|
#--------------------------------------------------------------------- |
547
|
|
|
|
|
|
|
|
548
|
|
|
|
|
|
|
=head2 $omap->get_pos_hash( @keys ); |
549
|
|
|
|
|
|
|
|
550
|
|
|
|
|
|
|
Gets positions where keys are found. |
551
|
|
|
|
|
|
|
|
552
|
|
|
|
|
|
|
Accepts zero or more keys. |
553
|
|
|
|
|
|
|
|
554
|
|
|
|
|
|
|
In list context, returns a hash of keys/positions found. In scalar |
555
|
|
|
|
|
|
|
context, returns a hash ref to this hash. If no keys given, all the |
556
|
|
|
|
|
|
|
positions are mapped in the hash. |
557
|
|
|
|
|
|
|
|
558
|
|
|
|
|
|
|
my $omap = Data::Omap->new( [{a=>1},{b=>2},{c=>3}] ); |
559
|
|
|
|
|
|
|
my %pos = $omap->get_pos_hash( 'c', 'b' ); # %pos is (b=>1,c=>2) |
560
|
|
|
|
|
|
|
my $pos_href = $omap->get_pos_hash( 'c', 'b' ); # $pos_href is {b=>1,c=>2} |
561
|
|
|
|
|
|
|
|
562
|
|
|
|
|
|
|
If a given key is not found, it will not appear in the returned hash. |
563
|
|
|
|
|
|
|
|
564
|
|
|
|
|
|
|
Returns C if object is empty. |
565
|
|
|
|
|
|
|
|
566
|
|
|
|
|
|
|
=cut |
567
|
|
|
|
|
|
|
|
568
|
|
|
|
|
|
|
*omap_get_pos_hash = \&get_pos_hash; |
569
|
|
|
|
|
|
|
sub get_pos_hash { |
570
|
10
|
|
|
10
|
1
|
5906
|
my( $self, @keys ) = @_; |
571
|
10
|
50
|
|
|
|
32
|
return unless @$self; |
572
|
10
|
|
|
|
|
15
|
my %ret; |
573
|
10
|
100
|
|
|
|
28
|
if( @keys ) { |
574
|
8
|
|
|
|
|
26
|
for my $i ( 0 .. $#$self ) { |
575
|
24
|
|
|
|
|
29
|
my ( $key ) = keys %{$self->[ $i ]}; |
|
24
|
|
|
|
|
52
|
|
576
|
24
|
|
|
|
|
38
|
for ( @keys ) { |
577
|
36
|
100
|
|
|
|
89
|
if( $key eq $_ ) { |
578
|
14
|
|
|
|
|
24
|
$ret{ $key } = $i; |
579
|
14
|
|
|
|
|
30
|
last; |
580
|
|
|
|
|
|
|
} |
581
|
|
|
|
|
|
|
} |
582
|
|
|
|
|
|
|
} |
583
|
|
|
|
|
|
|
} |
584
|
|
|
|
|
|
|
else { |
585
|
2
|
|
|
|
|
7
|
for my $i ( 0 .. $#$self ) { |
586
|
6
|
|
|
|
|
9
|
my ( $key ) = keys %{$self->[ $i ]}; |
|
6
|
|
|
|
|
13
|
|
587
|
6
|
|
|
|
|
17
|
$ret{ $key } = $i; |
588
|
|
|
|
|
|
|
} |
589
|
|
|
|
|
|
|
} |
590
|
10
|
100
|
|
|
|
65
|
return %ret if wantarray; |
591
|
2
|
|
|
|
|
6
|
\%ret; # returned |
592
|
|
|
|
|
|
|
} |
593
|
|
|
|
|
|
|
|
594
|
|
|
|
|
|
|
#--------------------------------------------------------------------- |
595
|
|
|
|
|
|
|
|
596
|
|
|
|
|
|
|
=head2 $omap->get_keys( @keys ); |
597
|
|
|
|
|
|
|
|
598
|
|
|
|
|
|
|
Gets keys. |
599
|
|
|
|
|
|
|
|
600
|
|
|
|
|
|
|
Accepts zero or more keys. If no keys are given, returns all the |
601
|
|
|
|
|
|
|
keys in the object (list context) or the number of keys (scalar |
602
|
|
|
|
|
|
|
context), e.g., |
603
|
|
|
|
|
|
|
|
604
|
|
|
|
|
|
|
my $omap = Data::Omap->new( [{a=>1},{b=>2},{c=>3}] ); |
605
|
|
|
|
|
|
|
my @keys = $omap->get_keys(); # @keys is (a, b, c) |
606
|
|
|
|
|
|
|
my $howmany = $omap->get_keys(); # $howmany is 3 |
607
|
|
|
|
|
|
|
|
608
|
|
|
|
|
|
|
If one or more keys are given, returns all the keys that are found |
609
|
|
|
|
|
|
|
(list) or the number found (scalar). Keys returned are listed in the |
610
|
|
|
|
|
|
|
order found in the object, e.g., |
611
|
|
|
|
|
|
|
|
612
|
|
|
|
|
|
|
@keys = $omap->get_keys( 'c', 'b', 'A' ); # @keys is (b, c) |
613
|
|
|
|
|
|
|
$howmany = $omap->get_keys( 'c', 'b', 'A' ); # $howmany is 2 |
614
|
|
|
|
|
|
|
|
615
|
|
|
|
|
|
|
=cut |
616
|
|
|
|
|
|
|
|
617
|
|
|
|
|
|
|
*omap_get_keys = \&get_keys; |
618
|
|
|
|
|
|
|
sub get_keys { |
619
|
16
|
|
|
16
|
1
|
6984
|
my( $self, @keys ) = @_; |
620
|
16
|
100
|
|
|
|
54
|
return unless @$self; |
621
|
15
|
|
|
|
|
21
|
my @ret; |
622
|
15
|
100
|
|
|
|
36
|
if( @keys ) { |
623
|
6
|
|
|
|
|
46
|
for my $href ( @$self ) { |
624
|
18
|
|
|
|
|
33
|
my ( $key ) = keys %$href; |
625
|
18
|
|
|
|
|
23
|
for ( @keys ) { |
626
|
36
|
100
|
|
|
|
81
|
if( $key eq $_ ) { |
627
|
14
|
|
|
|
|
17
|
push @ret, $key; |
628
|
14
|
|
|
|
|
30
|
last; |
629
|
|
|
|
|
|
|
} |
630
|
|
|
|
|
|
|
} |
631
|
|
|
|
|
|
|
} |
632
|
|
|
|
|
|
|
} |
633
|
|
|
|
|
|
|
else { |
634
|
9
|
|
|
|
|
53
|
for my $href ( @$self ) { |
635
|
30
|
|
|
|
|
70
|
my ( $key ) = keys %$href; |
636
|
30
|
|
|
|
|
109
|
push @ret, $key; |
637
|
|
|
|
|
|
|
} |
638
|
|
|
|
|
|
|
} |
639
|
15
|
|
|
|
|
62
|
@ret; # returned |
640
|
|
|
|
|
|
|
} |
641
|
|
|
|
|
|
|
|
642
|
|
|
|
|
|
|
#--------------------------------------------------------------------- |
643
|
|
|
|
|
|
|
|
644
|
|
|
|
|
|
|
=head2 $omap->get_array( @keys ); |
645
|
|
|
|
|
|
|
|
646
|
|
|
|
|
|
|
Gets an array of key/value pairs. |
647
|
|
|
|
|
|
|
|
648
|
|
|
|
|
|
|
Accepts zero or more keys. If no keys are given, returns a list of |
649
|
|
|
|
|
|
|
all the key/value pairs in the object (list context) or an array |
650
|
|
|
|
|
|
|
reference to that list (scalar context), e.g., |
651
|
|
|
|
|
|
|
|
652
|
|
|
|
|
|
|
my $omap = Data::Omap->new( [{a=>1},{b=>2},{c=>3}] ); |
653
|
|
|
|
|
|
|
my @array = $omap->get_array(); # @array is ({a=>1}, {b=>2}, {c=>3}) |
654
|
|
|
|
|
|
|
my $aref = $omap->get_array(); # $aref is [{a=>1}, {b=>2}, {c=>3}] |
655
|
|
|
|
|
|
|
|
656
|
|
|
|
|
|
|
If one or more keys are given, returns a list of key/value pairs for |
657
|
|
|
|
|
|
|
all the keys that are found (list) or an aref to that list (scalar). |
658
|
|
|
|
|
|
|
Pairs returned are in the order found in the object, e.g., |
659
|
|
|
|
|
|
|
|
660
|
|
|
|
|
|
|
@array = $omap->get_array( 'c', 'b', 'A' ); # @array is ({b->2}, {c=>3}) |
661
|
|
|
|
|
|
|
$aref = $omap->get_array( 'c', 'b', 'A' ); # @aref is [{b->2}, {c=>3}] |
662
|
|
|
|
|
|
|
|
663
|
|
|
|
|
|
|
Note, conceivably this method might be used to make a copy |
664
|
|
|
|
|
|
|
(unblessed) of the object, but it would not be a deep copy (if values |
665
|
|
|
|
|
|
|
are references, the references would be copied, not the referents). |
666
|
|
|
|
|
|
|
|
667
|
|
|
|
|
|
|
=cut |
668
|
|
|
|
|
|
|
|
669
|
|
|
|
|
|
|
*omap_get_array = \&get_array; |
670
|
|
|
|
|
|
|
sub get_array { |
671
|
14
|
|
|
14
|
1
|
13884
|
my( $self, @keys ) = @_; |
672
|
14
|
50
|
|
|
|
552
|
return unless @$self; |
673
|
14
|
|
|
|
|
23
|
my @ret; |
674
|
14
|
100
|
|
|
|
39
|
if( @keys ) { |
675
|
6
|
|
|
|
|
16
|
for my $href ( @$self ) { |
676
|
18
|
|
|
|
|
43
|
my ( $key ) = keys %$href; |
677
|
18
|
|
|
|
|
36
|
for ( @keys ) { |
678
|
34
|
100
|
|
|
|
159
|
if( $key eq $_ ) { |
679
|
12
|
|
|
|
|
36
|
push @ret, { %$href }; |
680
|
12
|
|
|
|
|
36
|
last; |
681
|
|
|
|
|
|
|
} |
682
|
|
|
|
|
|
|
} |
683
|
|
|
|
|
|
|
} |
684
|
|
|
|
|
|
|
} |
685
|
|
|
|
|
|
|
else { |
686
|
8
|
|
|
|
|
20
|
for my $href ( @$self ) { |
687
|
24
|
|
|
|
|
57
|
my ( $key ) = keys %$href; |
688
|
24
|
|
|
|
|
92
|
push @ret, { %$href }; |
689
|
|
|
|
|
|
|
} |
690
|
|
|
|
|
|
|
} |
691
|
14
|
100
|
|
|
|
89
|
return wantarray? @ret: [ @ret ]; |
692
|
|
|
|
|
|
|
} |
693
|
|
|
|
|
|
|
|
694
|
|
|
|
|
|
|
#--------------------------------------------------------------------- |
695
|
|
|
|
|
|
|
|
696
|
|
|
|
|
|
|
=head2 $omap->firstkey(); |
697
|
|
|
|
|
|
|
|
698
|
|
|
|
|
|
|
Expects no parameters. Returns the first key in the object (or undef |
699
|
|
|
|
|
|
|
if object is empty). |
700
|
|
|
|
|
|
|
|
701
|
|
|
|
|
|
|
This routine supports the tied hash FIRSTKEY method. |
702
|
|
|
|
|
|
|
|
703
|
|
|
|
|
|
|
=cut |
704
|
|
|
|
|
|
|
|
705
|
|
|
|
|
|
|
sub firstkey { |
706
|
8
|
|
|
8
|
1
|
366
|
my( $self ) = @_; |
707
|
8
|
100
|
|
|
|
34
|
return unless @$self; |
708
|
6
|
|
|
|
|
9
|
my ( $firstkey ) = keys %{$self->[0]}; |
|
6
|
|
|
|
|
16
|
|
709
|
6
|
|
|
|
|
29
|
$firstkey; # returned |
710
|
|
|
|
|
|
|
} |
711
|
|
|
|
|
|
|
|
712
|
|
|
|
|
|
|
#--------------------------------------------------------------------- |
713
|
|
|
|
|
|
|
|
714
|
|
|
|
|
|
|
=head2 $omap->nextkey( $lastkey ); |
715
|
|
|
|
|
|
|
|
716
|
|
|
|
|
|
|
Accepts one parameter, the last key gotten from FIRSTKEY or NEXTKEY. |
717
|
|
|
|
|
|
|
|
718
|
|
|
|
|
|
|
Returns the next key in the object. |
719
|
|
|
|
|
|
|
|
720
|
|
|
|
|
|
|
This routine supports the tied hash NEXTKEY method. |
721
|
|
|
|
|
|
|
|
722
|
|
|
|
|
|
|
=cut |
723
|
|
|
|
|
|
|
|
724
|
|
|
|
|
|
|
# XXX want a more efficient solution, always loops through the array |
725
|
|
|
|
|
|
|
|
726
|
|
|
|
|
|
|
sub nextkey { |
727
|
22
|
|
|
22
|
1
|
28
|
my( $self, $lastkey ) = @_; |
728
|
22
|
50
|
|
|
|
44
|
return unless @$self; |
729
|
22
|
|
|
|
|
39
|
for my $i ( 0 .. $#$self ) { |
730
|
55
|
|
|
|
|
52
|
my ( $key ) = keys %{$self->[ $i ]}; |
|
55
|
|
|
|
|
96
|
|
731
|
55
|
100
|
|
|
|
120
|
if( $key eq $lastkey ) { |
732
|
22
|
100
|
|
|
|
65
|
return unless defined $self->[ $i+1 ]; |
733
|
17
|
|
|
|
|
19
|
my ( $nextkey ) = keys %{$self->[ $i+1 ]}; |
|
17
|
|
|
|
|
33
|
|
734
|
17
|
|
|
|
|
66
|
return $nextkey; |
735
|
|
|
|
|
|
|
} |
736
|
|
|
|
|
|
|
} |
737
|
|
|
|
|
|
|
} |
738
|
|
|
|
|
|
|
|
739
|
|
|
|
|
|
|
#--------------------------------------------------------------------- |
740
|
|
|
|
|
|
|
|
741
|
|
|
|
|
|
|
=head2 $omap->exists( $key ); |
742
|
|
|
|
|
|
|
|
743
|
|
|
|
|
|
|
Accepts one key. |
744
|
|
|
|
|
|
|
|
745
|
|
|
|
|
|
|
Returns true if key is found in object, false if not. |
746
|
|
|
|
|
|
|
|
747
|
|
|
|
|
|
|
This routine supports the tied hash EXISTS method, but may reasonably |
748
|
|
|
|
|
|
|
be called directly, too. |
749
|
|
|
|
|
|
|
|
750
|
|
|
|
|
|
|
=cut |
751
|
|
|
|
|
|
|
|
752
|
|
|
|
|
|
|
*omap_exists = \&exists; |
753
|
|
|
|
|
|
|
sub exists { |
754
|
7
|
|
|
7
|
1
|
1879
|
my( $self, $key ) = @_; |
755
|
7
|
100
|
|
|
|
25
|
return unless @$self; |
756
|
6
|
|
|
|
|
16
|
return defined omap_get_pos( $self, $key ); |
757
|
|
|
|
|
|
|
} |
758
|
|
|
|
|
|
|
|
759
|
|
|
|
|
|
|
#--------------------------------------------------------------------- |
760
|
|
|
|
|
|
|
|
761
|
|
|
|
|
|
|
=head2 $omap->delete( $key ); |
762
|
|
|
|
|
|
|
|
763
|
|
|
|
|
|
|
Accepts one key. If key is found, removes the key/value pair from |
764
|
|
|
|
|
|
|
the object. |
765
|
|
|
|
|
|
|
|
766
|
|
|
|
|
|
|
Returns the value from the deleted pair. |
767
|
|
|
|
|
|
|
|
768
|
|
|
|
|
|
|
This routine supports the tied hash DELETE method, but may be called |
769
|
|
|
|
|
|
|
directly, too. |
770
|
|
|
|
|
|
|
|
771
|
|
|
|
|
|
|
=cut |
772
|
|
|
|
|
|
|
|
773
|
|
|
|
|
|
|
*omap_delete = \&delete; |
774
|
|
|
|
|
|
|
sub delete { |
775
|
5
|
|
|
5
|
1
|
619
|
my( $self, $key ) = @_; |
776
|
5
|
50
|
|
|
|
18
|
return unless defined $key; |
777
|
5
|
100
|
|
|
|
20
|
return unless @$self; |
778
|
|
|
|
|
|
|
|
779
|
4
|
|
|
|
|
12
|
my $found = omap_get_pos( $self, $key ); |
780
|
4
|
50
|
|
|
|
16
|
return unless defined $found; |
781
|
|
|
|
|
|
|
|
782
|
4
|
|
|
|
|
10
|
my $value = $self->[ $found ]->{ $key }; |
783
|
4
|
|
|
|
|
11
|
splice @$self, $found, 1; # delete it |
784
|
|
|
|
|
|
|
|
785
|
4
|
|
|
|
|
16
|
$value; # returned |
786
|
|
|
|
|
|
|
} |
787
|
|
|
|
|
|
|
|
788
|
|
|
|
|
|
|
#--------------------------------------------------------------------- |
789
|
|
|
|
|
|
|
|
790
|
|
|
|
|
|
|
=head2 $omap->clear(); |
791
|
|
|
|
|
|
|
|
792
|
|
|
|
|
|
|
Expects no parameters. Removes all key/value pairs from the object. |
793
|
|
|
|
|
|
|
|
794
|
|
|
|
|
|
|
Returns an empty list. |
795
|
|
|
|
|
|
|
|
796
|
|
|
|
|
|
|
This routine supports the tied hash CLEAR method, but may be called |
797
|
|
|
|
|
|
|
directly, too. |
798
|
|
|
|
|
|
|
|
799
|
|
|
|
|
|
|
=cut |
800
|
|
|
|
|
|
|
|
801
|
|
|
|
|
|
|
*omap_clear = \&clear; |
802
|
|
|
|
|
|
|
sub clear { |
803
|
29
|
|
|
29
|
1
|
9611
|
my( $self ) = @_; |
804
|
29
|
|
|
|
|
156
|
@$self = (); |
805
|
|
|
|
|
|
|
} |
806
|
|
|
|
|
|
|
|
807
|
|
|
|
|
|
|
#--------------------------------------------------------------------- |
808
|
|
|
|
|
|
|
# perltie methods |
809
|
|
|
|
|
|
|
#--------------------------------------------------------------------- |
810
|
|
|
|
|
|
|
|
811
|
|
|
|
|
|
|
# XXX Because of the inefficiencies in nextkey(), keys %hash and |
812
|
|
|
|
|
|
|
# values %hash # may be very slow. |
813
|
|
|
|
|
|
|
# Consider using (tied %hash)->get_keys() or ->get_values() instead |
814
|
|
|
|
|
|
|
|
815
|
|
|
|
|
|
|
# TIEHASH classname, LIST |
816
|
|
|
|
|
|
|
# This is the constructor for the class. That means it is expected to |
817
|
|
|
|
|
|
|
# return a blessed reference through which the new object (probably but |
818
|
|
|
|
|
|
|
# not necessarily an anonymous hash) will be accessed. |
819
|
|
|
|
|
|
|
|
820
|
|
|
|
|
|
|
sub TIEHASH { |
821
|
3
|
|
|
3
|
|
563
|
my $class = shift; |
822
|
3
|
|
|
|
|
19
|
$class->new( @_ ); |
823
|
|
|
|
|
|
|
} |
824
|
|
|
|
|
|
|
|
825
|
|
|
|
|
|
|
#--------------------------------------------------------------------- |
826
|
|
|
|
|
|
|
# FETCH this, key |
827
|
|
|
|
|
|
|
# This method will be triggered every time an element in the tied hash |
828
|
|
|
|
|
|
|
# is accessed (read). |
829
|
|
|
|
|
|
|
|
830
|
|
|
|
|
|
|
sub FETCH { |
831
|
20
|
|
|
20
|
|
2902
|
my $self = shift; |
832
|
20
|
|
|
|
|
62
|
$self->get_values( @_ ); |
833
|
|
|
|
|
|
|
} |
834
|
|
|
|
|
|
|
|
835
|
|
|
|
|
|
|
#--------------------------------------------------------------------- |
836
|
|
|
|
|
|
|
# STORE this, key, value |
837
|
|
|
|
|
|
|
# This method will be triggered every time an element in the tied hash |
838
|
|
|
|
|
|
|
# is set (written). |
839
|
|
|
|
|
|
|
|
840
|
|
|
|
|
|
|
sub STORE { |
841
|
53
|
|
|
53
|
|
6642
|
my $self = shift; |
842
|
53
|
|
|
|
|
123
|
$self->set( @_ ); |
843
|
|
|
|
|
|
|
} |
844
|
|
|
|
|
|
|
|
845
|
|
|
|
|
|
|
#--------------------------------------------------------------------- |
846
|
|
|
|
|
|
|
# DELETE this, key |
847
|
|
|
|
|
|
|
# This method is triggered when we remove an element from the hash, |
848
|
|
|
|
|
|
|
# typically by using the delete() function. |
849
|
|
|
|
|
|
|
# If you want to emulate the normal behavior of delete(), you should |
850
|
|
|
|
|
|
|
# return whatever FETCH would have returned for this key. |
851
|
|
|
|
|
|
|
|
852
|
|
|
|
|
|
|
sub DELETE { |
853
|
2
|
|
|
2
|
|
1196
|
my $self = shift; |
854
|
2
|
|
|
|
|
10
|
$self->delete( @_ ); |
855
|
|
|
|
|
|
|
} |
856
|
|
|
|
|
|
|
|
857
|
|
|
|
|
|
|
#--------------------------------------------------------------------- |
858
|
|
|
|
|
|
|
# CLEAR this |
859
|
|
|
|
|
|
|
# This method is triggered when the whole hash is to be cleared, |
860
|
|
|
|
|
|
|
# usually by assigning the empty list to it. |
861
|
|
|
|
|
|
|
|
862
|
|
|
|
|
|
|
sub CLEAR { |
863
|
10
|
|
|
10
|
|
6008
|
my $self = shift; |
864
|
10
|
|
|
|
|
27
|
$self->clear(); |
865
|
|
|
|
|
|
|
} |
866
|
|
|
|
|
|
|
|
867
|
|
|
|
|
|
|
#--------------------------------------------------------------------- |
868
|
|
|
|
|
|
|
# EXISTS this, key |
869
|
|
|
|
|
|
|
# This method is triggered when the user uses the exists() function |
870
|
|
|
|
|
|
|
# on a particular hash. |
871
|
|
|
|
|
|
|
|
872
|
|
|
|
|
|
|
sub EXISTS { |
873
|
2
|
|
|
2
|
|
1241
|
my $self = shift; |
874
|
2
|
|
|
|
|
9
|
$self->exists( @_ ); |
875
|
|
|
|
|
|
|
} |
876
|
|
|
|
|
|
|
|
877
|
|
|
|
|
|
|
#--------------------------------------------------------------------- |
878
|
|
|
|
|
|
|
# FIRSTKEY this |
879
|
|
|
|
|
|
|
# This method will be triggered when the user is going to iterate |
880
|
|
|
|
|
|
|
# through the hash, such as via a keys() or each() call. |
881
|
|
|
|
|
|
|
|
882
|
|
|
|
|
|
|
sub FIRSTKEY { |
883
|
7
|
|
|
7
|
|
3982
|
my $self = shift; |
884
|
7
|
|
|
|
|
21
|
$self->firstkey(); |
885
|
|
|
|
|
|
|
} |
886
|
|
|
|
|
|
|
|
887
|
|
|
|
|
|
|
#--------------------------------------------------------------------- |
888
|
|
|
|
|
|
|
# NEXTKEY this, lastkey |
889
|
|
|
|
|
|
|
# This method gets triggered during a keys() or each() iteration. |
890
|
|
|
|
|
|
|
# It has a second argument which is the last key that had been accessed. |
891
|
|
|
|
|
|
|
|
892
|
|
|
|
|
|
|
sub NEXTKEY { |
893
|
20
|
|
|
20
|
|
43
|
my $self = shift; |
894
|
20
|
|
|
|
|
39
|
$self->nextkey( @_ ); |
895
|
|
|
|
|
|
|
} |
896
|
|
|
|
|
|
|
|
897
|
|
|
|
|
|
|
#--------------------------------------------------------------------- |
898
|
|
|
|
|
|
|
# SCALAR this |
899
|
|
|
|
|
|
|
# This is called when the hash is evaluated in scalar context. |
900
|
|
|
|
|
|
|
# In order to mimic the behavior of untied hashes, this method should |
901
|
|
|
|
|
|
|
# return a false value when the tied hash is considered empty. |
902
|
|
|
|
|
|
|
|
903
|
|
|
|
|
|
|
sub SCALAR { |
904
|
2
|
|
|
2
|
|
981
|
my $self = shift; |
905
|
2
|
|
|
|
|
8
|
$self->get_keys(); # number of keys or undef (scalar context) |
906
|
|
|
|
|
|
|
} |
907
|
|
|
|
|
|
|
|
908
|
|
|
|
|
|
|
#--------------------------------------------------------------------- |
909
|
|
|
|
|
|
|
# UNTIE this |
910
|
|
|
|
|
|
|
# This is called when untie occurs. See "The untie Gotcha". |
911
|
|
|
|
|
|
|
|
912
|
|
|
|
|
|
|
# sub UNTIE { |
913
|
|
|
|
|
|
|
# } |
914
|
|
|
|
|
|
|
|
915
|
|
|
|
|
|
|
#--------------------------------------------------------------------- |
916
|
|
|
|
|
|
|
# DESTROY this |
917
|
|
|
|
|
|
|
# This method is triggered when a tied hash is about to go out of scope. |
918
|
|
|
|
|
|
|
|
919
|
|
|
|
|
|
|
# sub DESTROY { |
920
|
|
|
|
|
|
|
# } |
921
|
|
|
|
|
|
|
|
922
|
|
|
|
|
|
|
#--------------------------------------------------------------------- |
923
|
|
|
|
|
|
|
|
924
|
|
|
|
|
|
|
1; # 'use module' return value |
925
|
|
|
|
|
|
|
|
926
|
|
|
|
|
|
|
__END__ |