File Coverage

blib/lib/DBM/Deep/Hash.pm
Criterion Covered Total %
statement 66 66 100.0
branch 25 26 96.1
condition 6 6 100.0
subroutine 18 18 100.0
pod 2 2 100.0
total 117 118 99.1


line stmt bran cond sub pod time code
1             package DBM::Deep::Hash;
2              
3 50     50   982 use 5.008_004;
  50         225  
4              
5 50     50   263 use strict;
  50         114  
  50         1379  
6 50     50   304 use warnings FATAL => 'all';
  50         122  
  50         1932  
7 50     50   284 no warnings 'recursion';
  50         100  
  50         2025  
8              
9 50     50   334 use base 'DBM::Deep';
  50         147  
  50         51797  
10              
11             sub _get_self {
12             # See the note in Array.pm as to why this is commented out.
13             # eval { local $SIG{'__DIE__'}; tied( %{$_[0]} ) } || $_[0]
14              
15             # During global destruction %{$_[0]} might get tied to undef, so we
16             # need to check that case if tied returns false.
17 63097 50   63097   88837 tied %{$_[0]} or local *@, eval { exists $_[0]{_}; 1 } ? $_[0] : undef
  61651 100       94332  
  61651         178616  
  63097         200059  
18             }
19              
20 21     21   48 sub _repr { return {} }
21              
22             sub TIEHASH {
23 778     778   1504 my $class = shift;
24 778         2524 my $args = $class->_get_args( @_ );
25            
26 776         2239 $args->{type} = $class->TYPE_HASH;
27              
28 776         2400 return $class->_init($args);
29             }
30              
31             sub FETCH {
32 2619     2619   99505 my $self = shift->_get_self;
33 2619 100       5772 DBM::Deep->_throw_error( "Cannot use an undefined hash key." ) unless defined $_[0];
34             my $key = ($self->_engine->storage->{filter_store_key})
35 2617 100       6288 ? $self->_engine->storage->{filter_store_key}->($_[0])
36             : $_[0];
37              
38 2617         6956 return $self->SUPER::FETCH( $key, $_[0] );
39             }
40              
41             sub STORE {
42 1502     1502   39822 my $self = shift->_get_self;
43 1502 100       3444 DBM::Deep->_throw_error( "Cannot use an undefined hash key." ) unless defined $_[0];
44             my $key = ($self->_engine->storage->{filter_store_key})
45 1500 100       3353 ? $self->_engine->storage->{filter_store_key}->($_[0])
46             : $_[0];
47 1500         2783 my $value = $_[1];
48              
49 1500         4544 return $self->SUPER::STORE( $key, $value, $_[0] );
50             }
51              
52             sub EXISTS {
53 125     125   60621 my $self = shift->_get_self;
54 125 100       362 DBM::Deep->_throw_error( "Cannot use an undefined hash key." ) unless defined $_[0];
55             my $key = ($self->_engine->storage->{filter_store_key})
56 123 100       319 ? $self->_engine->storage->{filter_store_key}->($_[0])
57             : $_[0];
58              
59 123         511 return $self->SUPER::EXISTS( $key );
60             }
61              
62             sub DELETE {
63 46     46   3907 my $self = shift->_get_self;
64 46 100       130 DBM::Deep->_throw_error( "Cannot use an undefined hash key." ) unless defined $_[0];
65             my $key = ($self->_engine->storage->{filter_store_key})
66 44 100       117 ? $self->_engine->storage->{filter_store_key}->($_[0])
67             : $_[0];
68              
69 44         191 return $self->SUPER::DELETE( $key, $_[0] );
70             }
71              
72             # Locate and return first key (in no particular order)
73             sub FIRSTKEY {
74 162     162   113152 my $self = shift->_get_self;
75              
76 162         611 $self->lock_shared;
77            
78 162         590 my $result = $self->_engine->get_next_key( $self );
79            
80 159         657 $self->unlock;
81            
82             return ($result && $self->_engine->storage->{filter_fetch_key})
83 159 100 100     799 ? $self->_engine->storage->{filter_fetch_key}->($result)
84             : $result;
85             }
86              
87             # Return next key (in no particular order), given previous one
88             sub NEXTKEY {
89 383     383   992 my $self = shift->_get_self;
90              
91             my $prev_key = ($self->_engine->storage->{filter_store_key})
92 383 100       860 ? $self->_engine->storage->{filter_store_key}->($_[0])
93             : $_[0];
94              
95 383         1176 $self->lock_shared;
96            
97 383         1228 my $result = $self->_engine->get_next_key( $self, $prev_key );
98            
99 383         1412 $self->unlock;
100            
101             return ($result && $self->_engine->storage->{filter_fetch_key})
102 383 100 100     2682 ? $self->_engine->storage->{filter_fetch_key}->($result)
103             : $result;
104             }
105              
106 33     33 1 3833 sub first_key { (shift)->FIRSTKEY(@_) }
107 52     52 1 3405 sub next_key { (shift)->NEXTKEY(@_) }
108              
109             sub _clear {
110 1     1   2 my $self = shift;
111              
112 1         5 while ( defined(my $key = $self->first_key) ) {
113 1         2 do {
114 2         8 $self->_engine->delete_key( $self, $key, $key );
115             } while defined($key = $self->next_key($key));
116             }
117              
118 1         3 return;
119             }
120              
121             sub _copy_node {
122 23     23   68 my $self = shift;
123 23         51 my ($db_temp) = @_;
124              
125 23         60 my $key = $self->first_key();
126 23         85 while (defined $key) {
127 41         145 my $value = $self->get($key);
128 41         265 $self->_copy_value( \$db_temp->{$key}, $value );
129 41         106 $key = $self->next_key($key);
130             }
131              
132 23         62 return 1;
133             }
134              
135             1;
136             __END__