line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
# |
2
|
|
|
|
|
|
|
# InsertOrderHash.pm - insert-order-preserving tied hash |
3
|
|
|
|
|
|
|
# |
4
|
|
|
|
|
|
|
# $Id$ |
5
|
|
|
|
|
|
|
# |
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
package Tie::InsertOrderHash; |
8
|
|
|
|
|
|
|
|
9
|
1
|
|
|
1
|
|
692
|
use v5.6.1; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
161
|
|
10
|
1
|
|
|
1
|
|
5
|
use strict; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
31
|
|
11
|
1
|
|
|
1
|
|
12
|
use warnings; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
55
|
|
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
our $VERSION = '0.01'; |
14
|
|
|
|
|
|
|
|
15
|
1
|
|
|
1
|
|
14
|
use base qw(Tie::Hash); |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
952
|
|
16
|
|
|
|
|
|
|
|
17
|
2
|
|
|
2
|
|
1880
|
sub TIEHASH { my $c = shift; |
18
|
2
|
|
|
|
|
15
|
bless [[@_[grep { $_ % 2 == 0 } (0..$#_)]], {@_}, 0], $c } |
|
10
|
|
|
|
|
45
|
|
19
|
|
|
|
|
|
|
|
20
|
1
|
|
|
1
|
|
445
|
sub STORE { @{$_[0]->[0]} = grep { $_ ne $_[1] } @{$_[0]->[0]}; |
|
1
|
|
|
|
|
4
|
|
|
0
|
|
|
|
|
0
|
|
|
1
|
|
|
|
|
9
|
|
21
|
1
|
|
|
|
|
2
|
push @{$_[0]->[0]}, $_[1]; |
|
1
|
|
|
|
|
4
|
|
22
|
1
|
|
|
|
|
2
|
$_[0]->[2] = -1; |
23
|
1
|
|
|
|
|
11
|
$_[0]->[1]->{$_[1]} = $_[2] } |
24
|
|
|
|
|
|
|
|
25
|
1
|
|
|
1
|
|
522
|
sub FETCH { $_[0]->[1]->{$_[1]} } |
26
|
|
|
|
|
|
|
|
27
|
1
|
0
|
|
1
|
|
411
|
sub FIRSTKEY { return wantarray ? () : undef |
|
|
50
|
|
|
|
|
|
28
|
|
|
|
|
|
|
unless exists $_[0]->[0]->[$_[0]->[2] = 0]; |
29
|
1
|
|
|
|
|
5
|
my $key = $_[0]->[0]->[0]; |
30
|
1
|
50
|
|
|
|
66
|
return wantarray ? ($key, $_[0]->[1]->{$key}) : $key } |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
# Guard against deletion (see perldoc -f each) |
33
|
5
|
|
|
5
|
|
7
|
sub NEXTKEY { my $i = $_[0]->[2]; |
34
|
5
|
0
|
|
|
|
11
|
return wantarray ? () : undef unless exists $_[0]->[0]->[$i]; |
|
|
50
|
|
|
|
|
|
35
|
5
|
50
|
|
|
|
22
|
if ($_[0]->[0]->[$i] eq $_[1]) { |
36
|
5
|
|
|
|
|
6
|
$i = ++$_[0]->[2] ; |
37
|
5
|
50
|
|
|
|
19
|
return wantarray ? () : undef |
|
|
100
|
|
|
|
|
|
38
|
|
|
|
|
|
|
unless exists $_[0]->[0]->[$i]; |
39
|
|
|
|
|
|
|
} |
40
|
4
|
|
|
|
|
4
|
my $key = ${$_[0]->[0]}[$i]; |
|
4
|
|
|
|
|
44
|
|
41
|
4
|
50
|
|
|
|
13
|
return wantarray ? ($key, $_[0]->[1]->{$key}) : $key } |
42
|
|
|
|
|
|
|
|
43
|
0
|
|
|
0
|
|
|
sub EXISTS { exists $_[0]->[1]->{$_[1]} } |
44
|
|
|
|
|
|
|
|
45
|
0
|
|
|
0
|
|
|
sub DELETE { @{$_[0]->[0]} = grep { $_ ne $_[1] } @{$_[0]->[0]}; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
46
|
0
|
|
|
|
|
|
delete $_[0]->[1]->{$_[1]} } |
47
|
|
|
|
|
|
|
|
48
|
0
|
|
|
0
|
|
|
sub CLEAR { @{$_[0]->[0]} = (); |
|
0
|
|
|
|
|
|
|
49
|
0
|
|
|
|
|
|
%{$_[0]->[1]} = () } |
|
0
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
1; |
52
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
__END__ |