Removed one call to reftype
[dbsrgits/DBM-Deep.git] / lib / DBM / Deep / Hash.pm
1 package DBM::Deep::Hash;
2
3 use strict;
4
5 use base 'DBM::Deep';
6
7 sub _get_self {
8     eval { local $SIG{'__DIE__'}; tied( %{$_[0]} ) } || $_[0]
9 }
10
11 sub TIEHASH {
12     ##
13     # Tied hash constructor method, called by Perl's tie() function.
14     ##
15     my $class = shift;
16     my $args = $class->_get_args( @_ );
17     
18     $args->{type} = $class->TYPE_HASH;
19
20     return $class->_init($args);
21 }
22
23 sub FETCH {
24     my $self = shift->_get_self;
25     my $key = ($self->_root->{filter_store_key})
26         ? $self->_root->{filter_store_key}->($_[0])
27         : $_[0];
28
29     return $self->SUPER::FETCH( $key );
30 }
31
32 sub STORE {
33     my $self = shift->_get_self;
34         my $key = ($self->_root->{filter_store_key})
35         ? $self->_root->{filter_store_key}->($_[0])
36         : $_[0];
37     my $value = $_[1];
38
39     return $self->SUPER::STORE( $key, $value );
40 }
41
42 sub EXISTS {
43     my $self = shift->_get_self;
44         my $key = ($self->_root->{filter_store_key})
45         ? $self->_root->{filter_store_key}->($_[0])
46         : $_[0];
47
48     return $self->SUPER::EXISTS( $key );
49 }
50
51 sub DELETE {
52     my $self = shift->_get_self;
53         my $key = ($self->_root->{filter_store_key})
54         ? $self->_root->{filter_store_key}->($_[0])
55         : $_[0];
56
57     return $self->SUPER::DELETE( $key );
58 }
59
60 sub FIRSTKEY {
61         ##
62         # Locate and return first key (in no particular order)
63         ##
64     my $self = $_[0]->_get_self;
65
66         ##
67         # Make sure file is open
68         ##
69         if (!defined($self->_fh)) { $self->_open(); }
70         
71         ##
72         # Request shared lock for reading
73         ##
74         $self->lock( $self->LOCK_SH );
75         
76         my $result = $self->_get_next_key();
77         
78         $self->unlock();
79         
80         return ($result && $self->_root->{filter_fetch_key})
81         ? $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     my $self = $_[0]->_get_self;
90
91         my $prev_key = ($self->_root->{filter_store_key})
92         ? $self->_root->{filter_store_key}->($_[1])
93         : $_[1];
94
95         my $prev_md5 = $DBM::Deep::DIGEST_FUNC->($prev_key);
96
97         ##
98         # Make sure file is open
99         ##
100         if (!defined($self->_fh)) { $self->_open(); }
101         
102         ##
103         # Request shared lock for reading
104         ##
105         $self->lock( $self->LOCK_SH );
106         
107         my $result = $self->_get_next_key( $prev_md5 );
108         
109         $self->unlock();
110         
111         return ($result && $self->_root->{filter_fetch_key})
112         ? $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__