← Index
NYTProf Performance Profile   « block view • line view • sub view »
For mentat.storage.mongo.pl
  Run on Tue Jun 24 09:58:41 2014
Reported on Tue Jun 24 09:59:12 2014

Filename/usr/local/share/perl/5.14.2/Tie/IxHash.pm
StatementsExecuted 88 statements in 1.73ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
51128µs28µsTie::IxHash::::STORETie::IxHash::STORE
21122µs61µsTie::IxHash::::TIEHASHTie::IxHash::TIEHASH
32219µs47µsTie::IxHash::::PushTie::IxHash::Push
11112µs15µsTie::IxHash::::BEGIN@12Tie::IxHash::BEGIN@12
2227µs68µsTie::IxHash::::newTie::IxHash::new
1116µs34µsTie::IxHash::::BEGIN@15Tie::IxHash::BEGIN@15
1116µs8µsTie::IxHash::::BEGIN@13Tie::IxHash::BEGIN@13
0000s0sTie::IxHash::::ClearTie::IxHash::Clear
0000s0sTie::IxHash::::DELETETie::IxHash::DELETE
0000s0sTie::IxHash::::DeleteTie::IxHash::Delete
0000s0sTie::IxHash::::EXISTSTie::IxHash::EXISTS
0000s0sTie::IxHash::::FETCHTie::IxHash::FETCH
0000s0sTie::IxHash::::FIRSTKEYTie::IxHash::FIRSTKEY
0000s0sTie::IxHash::::IndicesTie::IxHash::Indices
0000s0sTie::IxHash::::KeysTie::IxHash::Keys
0000s0sTie::IxHash::::LengthTie::IxHash::Length
0000s0sTie::IxHash::::NEXTKEYTie::IxHash::NEXTKEY
0000s0sTie::IxHash::::PopTie::IxHash::Pop
0000s0sTie::IxHash::::Pop2Tie::IxHash::Pop2
0000s0sTie::IxHash::::Push2Tie::IxHash::Push2
0000s0sTie::IxHash::::ReorderTie::IxHash::Reorder
0000s0sTie::IxHash::::ReplaceTie::IxHash::Replace
0000s0sTie::IxHash::::ShiftTie::IxHash::Shift
0000s0sTie::IxHash::::Shift2Tie::IxHash::Shift2
0000s0sTie::IxHash::::SortByKeyTie::IxHash::SortByKey
0000s0sTie::IxHash::::SortByValueTie::IxHash::SortByValue
0000s0sTie::IxHash::::SpliceTie::IxHash::Splice
0000s0sTie::IxHash::::UnshiftTie::IxHash::Unshift
0000s0sTie::IxHash::::Unshift2Tie::IxHash::Unshift2
0000s0sTie::IxHash::::ValuesTie::IxHash::Values
0000s0sTie::IxHash::::_lrangeTie::IxHash::_lrange
Call graph for these subroutines as a Graphviz dot language file.
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
9112µsrequire 5.005;
10
11package Tie::IxHash;
12221µs218µ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
use strict;
# spent 15µs making 1 call to Tie::IxHash::BEGIN@12 # spent 3µs making 1 call to strict::import
13231µs210µ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
use integer;
# spent 8µs making 1 call to Tie::IxHash::BEGIN@13 # spent 2µs making 1 call to integer::import
141500nsrequire Tie::Hash;
1521.58ms261µ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
use vars qw/@ISA $VERSION/;
# spent 34µs making 1 call to Tie::IxHash::BEGIN@15 # spent 27µs making 1 call to vars::import
1616µs@ISA = qw(Tie::Hash);
17
181400ns$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
sub TIEHASH {
251821µ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
34239µ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
41sub 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
sub STORE {
474033µs my($s, $k, $v) = (shift, shift, shift);
48
49 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 push(@{$s->[1]}, $k);
57 push(@{$s->[2]}, $v);
58 $s->[0]{$k} = $#{$s->[1]};
59 }
60}
61
62sub 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
80sub EXISTS {
81 exists $_[0]->[0]{ $_[1] };
82}
83
84sub FIRSTKEY {
85 $_[0][3] = 0;
86 &NEXTKEY;
87}
88
89sub 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
10227µs261µ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
sub new { TIEHASH(@_) }
# spent 61µs making 2 calls to Tie::IxHash::TIEHASH, avg 31µs/call
103
104sub 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
sub Push {
1181718µs my($s) = shift;
119 while (@_) {
120528µs $s->STORE(shift, shift);
# spent 28µs making 5 calls to Tie::IxHash::STORE, avg 6µs/call
121 }
122 return scalar(@{$s->[1]});
123}
124
125sub 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#
134sub 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
146sub Pop2 {
147 return $_[0]->Splice(-1);
148}
149
150#
151# shift
152#
153sub 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
168sub Shift2 {
169 return $_[0]->Splice(0, 1);
170}
171
172#
173# unshift
174# if a supplied key exists, it will not be reordered
175#
176sub 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
208sub 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#
224sub 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#
279sub 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#
301sub 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#
332sub _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#
363sub 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#
376sub 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#
388sub 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#
398sub 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#
408sub 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
427sub SortByKey {
428 my($s) = shift;
429 $s->Reorder(sort $s->Keys);
430}
431
432sub SortByValue {
433 my($s) = shift;
434 $s->Reorder(sort { $s->FETCH($a) cmp $s->FETCH($b) } $s->Keys)
435}
436
43714µs1;
438__END__