File Coverage

blib/lib/Tie/InsertOrderHash.pm
Criterion Covered Total %
statement 34 45 75.5
branch 8 18 44.4
condition n/a
subroutine 9 12 75.0
pod n/a
total 51 75 68.0


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__