| 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__ |