File Coverage

blib/lib/Number/Phone/UK/DBM/Deep/Hash.pm
Criterion Covered Total %
statement 20 43 46.5
branch 4 20 20.0
condition 0 6 0.0
subroutine 6 10 60.0
pod n/a
total 30 79 37.9


line stmt bran cond sub pod time code
1             package Number::Phone::UK::DBM::Deep::Hash;
2              
3 1     1   4 use strict;
  1         1  
  1         25  
4              
5 1     1   3 use base 'Number::Phone::UK::DBM::Deep';
  1         1  
  1         471  
6              
7             sub _get_self {
8 517 100   517   328 eval { local $SIG{'__DIE__'}; tied( %{$_[0]} ) } || $_[0]
  517         568  
  517         292  
  517         1332  
9             }
10              
11             sub TIEHASH {
12             ##
13             # Tied hash constructor method, called by Perl's tie() function.
14             ##
15 12     12   8 my $class = shift;
16 12         25 my $args = $class->_get_args( @_ );
17            
18 12         31 $args->{type} = $class->TYPE_HASH;
19              
20 12         25 return $class->_init($args);
21             }
22              
23             sub FETCH {
24 15     15   52 my $self = shift->_get_self;
25             my $key = ($self->_root->{filter_store_key})
26 15 50       25 ? $self->_root->{filter_store_key}->($_[0])
27             : $_[0];
28              
29 15         28 return $self->SUPER::FETCH( $key );
30             }
31              
32             sub STORE {
33 0     0   0 my $self = shift->_get_self;
34             my $key = ($self->_root->{filter_store_key})
35 0 0       0 ? $self->_root->{filter_store_key}->($_[0])
36             : $_[0];
37 0         0 my $value = $_[1];
38              
39 0         0 return $self->SUPER::STORE( $key, $value );
40             }
41              
42             sub EXISTS {
43 5     5   6 my $self = shift->_get_self;
44             my $key = ($self->_root->{filter_store_key})
45 5 50       10 ? $self->_root->{filter_store_key}->($_[0])
46             : $_[0];
47              
48 5         12 return $self->SUPER::EXISTS( $key );
49             }
50              
51             sub DELETE {
52 0     0     my $self = shift->_get_self;
53             my $key = ($self->_root->{filter_store_key})
54 0 0         ? $self->_root->{filter_store_key}->($_[0])
55             : $_[0];
56              
57 0           return $self->SUPER::DELETE( $key );
58             }
59              
60             sub FIRSTKEY {
61             ##
62             # Locate and return first key (in no particular order)
63             ##
64 0     0     my $self = $_[0]->_get_self;
65              
66             ##
67             # Make sure file is open
68             ##
69 0 0         if (!defined($self->_fh)) { $self->_open(); }
  0            
70            
71             ##
72             # Request shared lock for reading
73             ##
74 0           $self->lock( $self->LOCK_SH );
75            
76 0           my $result = $self->_get_next_key();
77            
78 0           $self->unlock();
79            
80             return ($result && $self->_root->{filter_fetch_key})
81 0 0 0       ? $self->_root->{filter_fetch_key}->($result)
82             : $result;
83             }
84              
85             sub NEXTKEY {
86             ##
87             # Return next key (in no particular order), given previous one
88             ##
89 0     0     my $self = $_[0]->_get_self;
90              
91             my $prev_key = ($self->_root->{filter_store_key})
92 0 0         ? $self->_root->{filter_store_key}->($_[1])
93             : $_[1];
94              
95 0           my $prev_md5 = $Number::Phone::UK::DBM::Deep::DIGEST_FUNC->($prev_key);
96              
97             ##
98             # Make sure file is open
99             ##
100 0 0         if (!defined($self->_fh)) { $self->_open(); }
  0            
101            
102             ##
103             # Request shared lock for reading
104             ##
105 0           $self->lock( $self->LOCK_SH );
106            
107 0           my $result = $self->_get_next_key( $prev_md5 );
108            
109 0           $self->unlock();
110            
111             return ($result && $self->_root->{filter_fetch_key})
112 0 0 0       ? $self->_root->{filter_fetch_key}->($result)
113             : $result;
114             }
115              
116             ##
117             # Public method aliases
118             ##
119             *first_key = *FIRSTKEY;
120             *next_key = *NEXTKEY;
121              
122             1;
123             __END__