File Coverage

blib/lib/Hash/ExtendedKeys/Tie.pm
Criterion Covered Total %
statement 40 44 90.9
branch 9 18 50.0
condition n/a
subroutine 12 14 85.7
pod 0 1 0.0
total 61 77 79.2


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