File Coverage

blib/lib/Hash/ExtendedKeys/Tie.pm
Criterion Covered Total %
statement 44 44 100.0
branch 18 18 100.0
condition n/a
subroutine 14 14 100.0
pod 0 1 100.0
total 76 77 100.0


line stmt bran cond sub pod time code
1             package Hash::ExtendedKeys::Tie;
2              
3 4     4   58085 use strict;
  4         11  
  4         93  
4 4     4   17 use warnings;
  4         11  
  4         82  
5 4     4   1856 use Hash::Util qw(fieldhash);
  4         9637  
  4         20  
6 4     4   7072 use Struct::Match qw/match/;
  4         67079  
  4         25  
7              
8             sub TIEHASH {
9 3     3   71 my ($class) = @_;
10              
11 3         30 fieldhash my %fieldhash;
12              
13 3         52 my $self = {
14             fieldhash => \%fieldhash,
15             };
16              
17 3         10 bless $self, $class;
18             }
19              
20             sub STORE {
21 12     12   502 my ($self, $key, $value) = @_;
22              
23 12 100       50 my $k = $self->{fieldhash}->{$key} ? $key : $self->FINDKEY($key);;
24 12 100       26 if ($k) {
25 4         14 $self->{fieldhash}->{$k}->{value} = $value;
26             } else {
27 8         41 $self->{fieldhash}->{$key} = {
28             key => $key,
29             value => $value
30             };
31             }
32              
33 12         31 return $self;
34             }
35              
36             sub FETCH {
37 12     12   194 my ($self, $key) = @_;
38 12 100       35 my $k = $self->{fieldhash}->{$key} ? $key : $self->FINDKEY($key);
39 12 100       51 return $k ? $self->{fieldhash}->{$k}->{value} : undef;
40             }
41              
42             sub FINDKEY {
43             # uncoverable pod
44 19     19 0 27 for my $k (keys %{$_[0]->{fieldhash}}) {
  19         47  
45 10 100       32 if (match($_[0]->{fieldhash}->{$k}->{key}, $_[1])) {
46 8         443 return $_[0]->{fieldhash}->{$k}->{key};
47             }
48             }
49 11         168 return undef;
50             }
51              
52             sub FIRSTKEY {
53 4     4   869 my ($key, $value) = each %{$_[0]->{fieldhash}};
  4         12  
54 4         13 return $value->{key};
55             }
56              
57             sub NEXTKEY {
58 4     4   5 my ($key, $value) = each %{$_[0]->{fieldhash}};
  4         10  
59 4         18 return $value->{key};
60             }
61              
62             sub EXISTS {
63 2 100   2   8 my $k = $_[0]->{fieldhash}->{$_[1]} ? $_[1] : $_[0]->FINDKEY($_[1]);
64 2 100       9 $k ? exists $_[0]->{fieldhash}->{$k} : undef;
65             }
66              
67             sub DELETE {
68 4 100   4   17 my $k = $_[0]->{fieldhash}->{$_[1]} ? $_[1] : $_[0]->FINDKEY($_[1]);
69 4 100       18 $k ? delete $_[0]->{fieldhash}->{$k} : undef;
70             }
71              
72             sub CLEAR {
73 3     3   1423 %{$_[0]->{fieldhash}} = ()
  3         13  
74             }
75              
76             sub SCALAR {
77 1     1   2 scalar keys %{$_[0]->{fieldhash}}
  1         5  
78             }
79              
80             1;