Filename | /usr/local/share/perl/5.14.2/Tie/IxHash.pm |
Statements | Executed 88 statements in 1.73ms |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
5 | 1 | 1 | 28µs | 28µs | STORE | Tie::IxHash::
2 | 1 | 1 | 22µs | 61µs | TIEHASH | Tie::IxHash::
3 | 2 | 2 | 19µs | 47µs | Push | Tie::IxHash::
1 | 1 | 1 | 12µs | 15µs | BEGIN@12 | Tie::IxHash::
2 | 2 | 2 | 7µs | 68µs | new | Tie::IxHash::
1 | 1 | 1 | 6µs | 34µs | BEGIN@15 | Tie::IxHash::
1 | 1 | 1 | 6µs | 8µs | BEGIN@13 | Tie::IxHash::
0 | 0 | 0 | 0s | 0s | Clear | Tie::IxHash::
0 | 0 | 0 | 0s | 0s | DELETE | Tie::IxHash::
0 | 0 | 0 | 0s | 0s | Delete | Tie::IxHash::
0 | 0 | 0 | 0s | 0s | EXISTS | Tie::IxHash::
0 | 0 | 0 | 0s | 0s | FETCH | Tie::IxHash::
0 | 0 | 0 | 0s | 0s | FIRSTKEY | Tie::IxHash::
0 | 0 | 0 | 0s | 0s | Indices | Tie::IxHash::
0 | 0 | 0 | 0s | 0s | Keys | Tie::IxHash::
0 | 0 | 0 | 0s | 0s | Length | Tie::IxHash::
0 | 0 | 0 | 0s | 0s | NEXTKEY | Tie::IxHash::
0 | 0 | 0 | 0s | 0s | Pop | Tie::IxHash::
0 | 0 | 0 | 0s | 0s | Pop2 | Tie::IxHash::
0 | 0 | 0 | 0s | 0s | Push2 | Tie::IxHash::
0 | 0 | 0 | 0s | 0s | Reorder | Tie::IxHash::
0 | 0 | 0 | 0s | 0s | Replace | Tie::IxHash::
0 | 0 | 0 | 0s | 0s | Shift | Tie::IxHash::
0 | 0 | 0 | 0s | 0s | Shift2 | Tie::IxHash::
0 | 0 | 0 | 0s | 0s | SortByKey | Tie::IxHash::
0 | 0 | 0 | 0s | 0s | SortByValue | Tie::IxHash::
0 | 0 | 0 | 0s | 0s | Splice | Tie::IxHash::
0 | 0 | 0 | 0s | 0s | Unshift | Tie::IxHash::
0 | 0 | 0 | 0s | 0s | Unshift2 | Tie::IxHash::
0 | 0 | 0 | 0s | 0s | Values | Tie::IxHash::
0 | 0 | 0 | 0s | 0s | _lrange | Tie::IxHash::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | # | ||||
2 | # Tie/IxHash.pm | ||||
3 | # | ||||
4 | # Indexed hash implementation for Perl | ||||
5 | # | ||||
6 | # See below for documentation. | ||||
7 | # | ||||
8 | |||||
9 | 1 | 12µs | require 5.005; | ||
10 | |||||
11 | package Tie::IxHash; | ||||
12 | 2 | 21µs | 2 | 18µs | # spent 15µs (12+3) within Tie::IxHash::BEGIN@12 which was called:
# once (12µs+3µs) by Mentat::Storage::Mongo::BEGIN@155 at line 12 # spent 15µs making 1 call to Tie::IxHash::BEGIN@12
# spent 3µs making 1 call to strict::import |
13 | 2 | 31µs | 2 | 10µs | # spent 8µs (6+2) within Tie::IxHash::BEGIN@13 which was called:
# once (6µs+2µs) by Mentat::Storage::Mongo::BEGIN@155 at line 13 # spent 8µs making 1 call to Tie::IxHash::BEGIN@13
# spent 2µs making 1 call to integer::import |
14 | 1 | 500ns | require Tie::Hash; | ||
15 | 2 | 1.58ms | 2 | 61µs | # spent 34µs (6+27) within Tie::IxHash::BEGIN@15 which was called:
# once (6µs+27µs) by Mentat::Storage::Mongo::BEGIN@155 at line 15 # spent 34µs making 1 call to Tie::IxHash::BEGIN@15
# spent 27µs making 1 call to vars::import |
16 | 1 | 6µs | @ISA = qw(Tie::Hash); | ||
17 | |||||
18 | 1 | 400ns | $VERSION = $VERSION = '1.23'; | ||
19 | |||||
20 | # | ||||
21 | # standard tie functions | ||||
22 | # | ||||
23 | |||||
24 | # spent 61µs (22+39) within Tie::IxHash::TIEHASH which was called 2 times, avg 31µs/call:
# 2 times (22µs+39µs) by Tie::IxHash::new at line 102, avg 31µs/call | ||||
25 | 18 | 21µs | my($c) = shift; | ||
26 | my($s) = []; | ||||
27 | $s->[0] = {}; # hashkey index | ||||
28 | $s->[1] = []; # array of keys | ||||
29 | $s->[2] = []; # array of data | ||||
30 | $s->[3] = 0; # iter count | ||||
31 | |||||
32 | bless $s, $c; | ||||
33 | |||||
34 | 2 | 39µs | $s->Push(@_) if @_;
# spent 39µs making 2 calls to Tie::IxHash::Push, avg 20µs/call | ||
35 | |||||
36 | return $s; | ||||
37 | } | ||||
38 | |||||
39 | #sub DESTROY {} # costly if there's nothing to do | ||||
40 | |||||
41 | sub FETCH { | ||||
42 | my($s, $k) = (shift, shift); | ||||
43 | return exists( $s->[0]{$k} ) ? $s->[2][ $s->[0]{$k} ] : undef; | ||||
44 | } | ||||
45 | |||||
46 | # spent 28µs within Tie::IxHash::STORE which was called 5 times, avg 6µs/call:
# 5 times (28µs+0s) by Tie::IxHash::Push at line 120, avg 6µs/call | ||||
47 | 10 | 15µs | my($s, $k, $v) = (shift, shift, shift); | ||
48 | |||||
49 | 15 | 13µs | if (exists $s->[0]{$k}) { | ||
50 | my($i) = $s->[0]{$k}; | ||||
51 | $s->[1][$i] = $k; | ||||
52 | $s->[2][$i] = $v; | ||||
53 | $s->[0]{$k} = $i; | ||||
54 | } | ||||
55 | else { | ||||
56 | 5 | 2µs | push(@{$s->[1]}, $k); | ||
57 | 5 | 1µs | push(@{$s->[2]}, $v); | ||
58 | 5 | 1µs | $s->[0]{$k} = $#{$s->[1]}; | ||
59 | } | ||||
60 | } | ||||
61 | |||||
62 | sub DELETE { | ||||
63 | my($s, $k) = (shift, shift); | ||||
64 | |||||
65 | if (exists $s->[0]{$k}) { | ||||
66 | my($i) = $s->[0]{$k}; | ||||
67 | for ($i+1..$#{$s->[1]}) { # reset higher elt indexes | ||||
68 | $s->[0]{ $s->[1][$_] }--; # timeconsuming, is there is better way? | ||||
69 | } | ||||
70 | if ( $i == $s->[3]-1 ) { | ||||
71 | $s->[3]--; | ||||
72 | } | ||||
73 | delete $s->[0]{$k}; | ||||
74 | splice @{$s->[1]}, $i, 1; | ||||
75 | return (splice(@{$s->[2]}, $i, 1))[0]; | ||||
76 | } | ||||
77 | return undef; | ||||
78 | } | ||||
79 | |||||
80 | sub EXISTS { | ||||
81 | exists $_[0]->[0]{ $_[1] }; | ||||
82 | } | ||||
83 | |||||
84 | sub FIRSTKEY { | ||||
85 | $_[0][3] = 0; | ||||
86 | &NEXTKEY; | ||||
87 | } | ||||
88 | |||||
89 | sub NEXTKEY { | ||||
90 | return $_[0][1][ $_[0][3]++ ] if ($_[0][3] <= $#{ $_[0][1] } ); | ||||
91 | return undef; | ||||
92 | } | ||||
93 | |||||
94 | |||||
95 | |||||
96 | # | ||||
97 | # | ||||
98 | # class functions that provide additional capabilities | ||||
99 | # | ||||
100 | # | ||||
101 | |||||
102 | 2 | 7µs | 2 | 61µs | # spent 68µs (7+61) within Tie::IxHash::new which was called 2 times, avg 34µs/call:
# once (4µs+42µs) by Mentat::Storage::Mongo::find_i at line 394 of Mentat/Storage/Mongo.pm
# once (2µs+19µs) by MongoDB::Cursor::count at line 272 of MongoDB/Cursor.pm # spent 61µs making 2 calls to Tie::IxHash::TIEHASH, avg 31µs/call |
103 | |||||
104 | sub Clear { | ||||
105 | my $s = shift; | ||||
106 | $s->[0] = {}; # hashkey index | ||||
107 | $s->[1] = []; # array of keys | ||||
108 | $s->[2] = []; # array of data | ||||
109 | $s->[3] = 0; # iter count | ||||
110 | return; | ||||
111 | } | ||||
112 | |||||
113 | # | ||||
114 | # add pairs to end of indexed hash | ||||
115 | # note that if a supplied key exists, it will not be reordered | ||||
116 | # | ||||
117 | # spent 47µs (19+28) within Tie::IxHash::Push which was called 3 times, avg 16µs/call:
# 2 times (15µs+24µs) by Tie::IxHash::TIEHASH at line 34, avg 20µs/call
# once (4µs+4µs) by MongoDB::Cursor::count at line 278 of MongoDB/Cursor.pm | ||||
118 | 9 | 9µs | my($s) = shift; | ||
119 | while (@_) { | ||||
120 | 5 | 7µs | 5 | 28µs | $s->STORE(shift, shift);
# spent 28µs making 5 calls to Tie::IxHash::STORE, avg 6µs/call |
121 | } | ||||
122 | 3 | 1µs | return scalar(@{$s->[1]}); | ||
123 | } | ||||
124 | |||||
125 | sub Push2 { | ||||
126 | my($s) = shift; | ||||
127 | $s->Splice($#{$s->[1]}+1, 0, @_); | ||||
128 | return scalar(@{$s->[1]}); | ||||
129 | } | ||||
130 | |||||
131 | # | ||||
132 | # pop last k-v pair | ||||
133 | # | ||||
134 | sub Pop { | ||||
135 | my($s) = shift; | ||||
136 | my($k, $v, $i); | ||||
137 | $k = pop(@{$s->[1]}); | ||||
138 | $v = pop(@{$s->[2]}); | ||||
139 | if (defined $k) { | ||||
140 | delete $s->[0]{$k}; | ||||
141 | return ($k, $v); | ||||
142 | } | ||||
143 | return undef; | ||||
144 | } | ||||
145 | |||||
146 | sub Pop2 { | ||||
147 | return $_[0]->Splice(-1); | ||||
148 | } | ||||
149 | |||||
150 | # | ||||
151 | # shift | ||||
152 | # | ||||
153 | sub Shift { | ||||
154 | my($s) = shift; | ||||
155 | my($k, $v, $i); | ||||
156 | $k = shift(@{$s->[1]}); | ||||
157 | $v = shift(@{$s->[2]}); | ||||
158 | if (defined $k) { | ||||
159 | delete $s->[0]{$k}; | ||||
160 | for (keys %{$s->[0]}) { | ||||
161 | $s->[0]{$_}--; | ||||
162 | } | ||||
163 | return ($k, $v); | ||||
164 | } | ||||
165 | return undef; | ||||
166 | } | ||||
167 | |||||
168 | sub Shift2 { | ||||
169 | return $_[0]->Splice(0, 1); | ||||
170 | } | ||||
171 | |||||
172 | # | ||||
173 | # unshift | ||||
174 | # if a supplied key exists, it will not be reordered | ||||
175 | # | ||||
176 | sub Unshift { | ||||
177 | my($s) = shift; | ||||
178 | my($k, $v, @k, @v, $len, $i); | ||||
179 | |||||
180 | while (@_) { | ||||
181 | ($k, $v) = (shift, shift); | ||||
182 | if (exists $s->[0]{$k}) { | ||||
183 | $i = $s->[0]{$k}; | ||||
184 | $s->[1][$i] = $k; | ||||
185 | $s->[2][$i] = $v; | ||||
186 | $s->[0]{$k} = $i; | ||||
187 | } | ||||
188 | else { | ||||
189 | push(@k, $k); | ||||
190 | push(@v, $v); | ||||
191 | $len++; | ||||
192 | } | ||||
193 | } | ||||
194 | if (defined $len) { | ||||
195 | for (keys %{$s->[0]}) { | ||||
196 | $s->[0]{$_} += $len; | ||||
197 | } | ||||
198 | $i = 0; | ||||
199 | for (@k) { | ||||
200 | $s->[0]{$_} = $i++; | ||||
201 | } | ||||
202 | unshift(@{$s->[1]}, @k); | ||||
203 | return unshift(@{$s->[2]}, @v); | ||||
204 | } | ||||
205 | return scalar(@{$s->[1]}); | ||||
206 | } | ||||
207 | |||||
208 | sub Unshift2 { | ||||
209 | my($s) = shift; | ||||
210 | $s->Splice(0,0,@_); | ||||
211 | return scalar(@{$s->[1]}); | ||||
212 | } | ||||
213 | |||||
214 | # | ||||
215 | # splice | ||||
216 | # | ||||
217 | # any existing hash key order is preserved. the value is replaced for | ||||
218 | # such keys, and the new keys are spliced in the regular fashion. | ||||
219 | # | ||||
220 | # supports -ve offsets but only +ve lengths | ||||
221 | # | ||||
222 | # always assumes a 0 start offset | ||||
223 | # | ||||
224 | sub Splice { | ||||
225 | my($s, $start, $len) = (shift, shift, shift); | ||||
226 | my($k, $v, @k, @v, @r, $i, $siz); | ||||
227 | my($end); # inclusive | ||||
228 | |||||
229 | # XXX inline this | ||||
230 | ($start, $end, $len) = $s->_lrange($start, $len); | ||||
231 | |||||
232 | if (defined $start) { | ||||
233 | if ($len > 0) { | ||||
234 | my(@k) = splice(@{$s->[1]}, $start, $len); | ||||
235 | my(@v) = splice(@{$s->[2]}, $start, $len); | ||||
236 | while (@k) { | ||||
237 | $k = shift(@k); | ||||
238 | delete $s->[0]{$k}; | ||||
239 | push(@r, $k, shift(@v)); | ||||
240 | } | ||||
241 | for ($start..$#{$s->[1]}) { | ||||
242 | $s->[0]{$s->[1][$_]} -= $len; | ||||
243 | } | ||||
244 | } | ||||
245 | while (@_) { | ||||
246 | ($k, $v) = (shift, shift); | ||||
247 | if (exists $s->[0]{$k}) { | ||||
248 | # $s->STORE($k, $v); | ||||
249 | $i = $s->[0]{$k}; | ||||
250 | $s->[1][$i] = $k; | ||||
251 | $s->[2][$i] = $v; | ||||
252 | $s->[0]{$k} = $i; | ||||
253 | } | ||||
254 | else { | ||||
255 | push(@k, $k); | ||||
256 | push(@v, $v); | ||||
257 | $siz++; | ||||
258 | } | ||||
259 | } | ||||
260 | if (defined $siz) { | ||||
261 | for ($start..$#{$s->[1]}) { | ||||
262 | $s->[0]{$s->[1][$_]} += $siz; | ||||
263 | } | ||||
264 | $i = $start; | ||||
265 | for (@k) { | ||||
266 | $s->[0]{$_} = $i++; | ||||
267 | } | ||||
268 | splice(@{$s->[1]}, $start, 0, @k); | ||||
269 | splice(@{$s->[2]}, $start, 0, @v); | ||||
270 | } | ||||
271 | } | ||||
272 | return @r; | ||||
273 | } | ||||
274 | |||||
275 | # | ||||
276 | # delete elements specified by key | ||||
277 | # other elements higher than the one deleted "slide" down | ||||
278 | # | ||||
279 | sub Delete { | ||||
280 | my($s) = shift; | ||||
281 | |||||
282 | for (@_) { | ||||
283 | # | ||||
284 | # XXX potential optimization: could do $s->DELETE only if $#_ < 4. | ||||
285 | # otherwise, should reset all the hash indices in one loop | ||||
286 | # | ||||
287 | $s->DELETE($_); | ||||
288 | } | ||||
289 | } | ||||
290 | |||||
291 | # | ||||
292 | # replace hash element at specified index | ||||
293 | # | ||||
294 | # if the optional key is not supplied the value at index will simply be | ||||
295 | # replaced without affecting the order. | ||||
296 | # | ||||
297 | # if an element with the supplied key already exists, it will be deleted first. | ||||
298 | # | ||||
299 | # returns the key of replaced value if it succeeds. | ||||
300 | # | ||||
301 | sub Replace { | ||||
302 | my($s) = shift; | ||||
303 | my($i, $v, $k) = (shift, shift, shift); | ||||
304 | if (defined $i and $i <= $#{$s->[1]} and $i >= 0) { | ||||
305 | if (defined $k) { | ||||
306 | delete $s->[0]{ $s->[1][$i] }; | ||||
307 | $s->DELETE($k) ; #if exists $s->[0]{$k}; | ||||
308 | $s->[1][$i] = $k; | ||||
309 | $s->[2][$i] = $v; | ||||
310 | $s->[0]{$k} = $i; | ||||
311 | return $k; | ||||
312 | } | ||||
313 | else { | ||||
314 | $s->[2][$i] = $v; | ||||
315 | return $s->[1][$i]; | ||||
316 | } | ||||
317 | } | ||||
318 | return undef; | ||||
319 | } | ||||
320 | |||||
321 | # | ||||
322 | # Given an $start and $len, returns a legal start and end (where start <= end) | ||||
323 | # for the current hash. | ||||
324 | # Legal range is defined as 0 to $#s+1 | ||||
325 | # $len defaults to number of elts upto end of list | ||||
326 | # | ||||
327 | # 0 1 2 ... | ||||
328 | # | X | X | X ... X | X | X | | ||||
329 | # -2 -1 (no -0 alas) | ||||
330 | # X's above are the elements | ||||
331 | # | ||||
332 | sub _lrange { | ||||
333 | my($s) = shift; | ||||
334 | my($offset, $len) = @_; | ||||
335 | my($start, $end); # both inclusive | ||||
336 | my($size) = $#{$s->[1]}+1; | ||||
337 | |||||
338 | return undef unless defined $offset; | ||||
339 | if($offset < 0) { | ||||
340 | $start = $offset + $size; | ||||
341 | $start = 0 if $start < 0; | ||||
342 | } | ||||
343 | else { | ||||
344 | ($offset > $size) ? ($start = $size) : ($start = $offset); | ||||
345 | } | ||||
346 | |||||
347 | if (defined $len) { | ||||
348 | $len = -$len if $len < 0; | ||||
349 | $len = $size - $start if $len > $size - $start; | ||||
350 | } | ||||
351 | else { | ||||
352 | $len = $size - $start; | ||||
353 | } | ||||
354 | $end = $start + $len - 1; | ||||
355 | |||||
356 | return ($start, $end, $len); | ||||
357 | } | ||||
358 | |||||
359 | # | ||||
360 | # Return keys at supplied indices | ||||
361 | # Returns all keys if no args. | ||||
362 | # | ||||
363 | sub Keys { | ||||
364 | my($s) = shift; | ||||
365 | return ( @_ == 1 | ||||
366 | ? $s->[1][$_[0]] | ||||
367 | : ( @_ | ||||
368 | ? @{$s->[1]}[@_] | ||||
369 | : @{$s->[1]} ) ); | ||||
370 | } | ||||
371 | |||||
372 | # | ||||
373 | # Returns values at supplied indices | ||||
374 | # Returns all values if no args. | ||||
375 | # | ||||
376 | sub Values { | ||||
377 | my($s) = shift; | ||||
378 | return ( @_ == 1 | ||||
379 | ? $s->[2][$_[0]] | ||||
380 | : ( @_ | ||||
381 | ? @{$s->[2]}[@_] | ||||
382 | : @{$s->[2]} ) ); | ||||
383 | } | ||||
384 | |||||
385 | # | ||||
386 | # get indices of specified hash keys | ||||
387 | # | ||||
388 | sub Indices { | ||||
389 | my($s) = shift; | ||||
390 | return ( @_ == 1 ? $s->[0]{$_[0]} : @{$s->[0]}{@_} ); | ||||
391 | } | ||||
392 | |||||
393 | # | ||||
394 | # number of k-v pairs in the ixhash | ||||
395 | # note that this does not equal the highest index | ||||
396 | # owing to preextended arrays | ||||
397 | # | ||||
398 | sub Length { | ||||
399 | return scalar @{$_[0]->[1]}; | ||||
400 | } | ||||
401 | |||||
402 | # | ||||
403 | # Reorder the hash in the supplied key order | ||||
404 | # | ||||
405 | # warning: any unsupplied keys will be lost from the hash | ||||
406 | # any supplied keys that dont exist in the hash will be ignored | ||||
407 | # | ||||
408 | sub Reorder { | ||||
409 | my($s) = shift; | ||||
410 | my(@k, @v, %x, $i); | ||||
411 | return unless @_; | ||||
412 | |||||
413 | $i = 0; | ||||
414 | for (@_) { | ||||
415 | if (exists $s->[0]{$_}) { | ||||
416 | push(@k, $_); | ||||
417 | push(@v, $s->[2][ $s->[0]{$_} ] ); | ||||
418 | $x{$_} = $i++; | ||||
419 | } | ||||
420 | } | ||||
421 | $s->[1] = \@k; | ||||
422 | $s->[2] = \@v; | ||||
423 | $s->[0] = \%x; | ||||
424 | return $s; | ||||
425 | } | ||||
426 | |||||
427 | sub SortByKey { | ||||
428 | my($s) = shift; | ||||
429 | $s->Reorder(sort $s->Keys); | ||||
430 | } | ||||
431 | |||||
432 | sub SortByValue { | ||||
433 | my($s) = shift; | ||||
434 | $s->Reorder(sort { $s->FETCH($a) cmp $s->FETCH($b) } $s->Keys) | ||||
435 | } | ||||
436 | |||||
437 | 1 | 4µs | 1; | ||
438 | __END__ |