7bca7ce9da80e45b913de5ef4dc7ec5abfbc0235
[dbsrgits/DBM-Deep.git] / lib / DBM / Deep / Hash.pm
1 package DBM::Deep::Hash;
2
3 use 5.006_000;
4
5 use strict;
6 use warnings;
7
8 our $VERSION = q(1.0006);
9
10 use base 'DBM::Deep';
11
12 sub _get_self {
13     eval { local $SIG{'__DIE__'}; tied( %{$_[0]} ) } || $_[0]
14 }
15
16 sub _repr { return {} }
17
18 sub TIEHASH {
19     ##
20     # Tied hash constructor method, called by Perl's tie() function.
21     ##
22     my $class = shift;
23     my $args = $class->_get_args( @_ );
24     
25     $args->{type} = $class->TYPE_HASH;
26
27     return $class->_init($args);
28 }
29
30 sub FETCH {
31     my $self = shift->_get_self;
32     DBM::Deep->_throw_error( "Cannot use an undefined hash key." ) unless defined $_[0];
33     my $key = ($self->_storage->{filter_store_key})
34         ? $self->_storage->{filter_store_key}->($_[0])
35         : $_[0];
36
37     return $self->SUPER::FETCH( $key, $_[0] );
38 }
39
40 sub STORE {
41     my $self = shift->_get_self;
42     DBM::Deep->_throw_error( "Cannot use an undefined hash key." ) unless defined $_[0];
43     my $key = ($self->_storage->{filter_store_key})
44         ? $self->_storage->{filter_store_key}->($_[0])
45         : $_[0];
46     my $value = $_[1];
47
48     return $self->SUPER::STORE( $key, $value, $_[0] );
49 }
50
51 sub EXISTS {
52     my $self = shift->_get_self;
53     DBM::Deep->_throw_error( "Cannot use an undefined hash key." ) unless defined $_[0];
54     my $key = ($self->_storage->{filter_store_key})
55         ? $self->_storage->{filter_store_key}->($_[0])
56         : $_[0];
57
58     return $self->SUPER::EXISTS( $key );
59 }
60
61 sub DELETE {
62     my $self = shift->_get_self;
63     DBM::Deep->_throw_error( "Cannot use an undefined hash key." ) unless defined $_[0];
64     my $key = ($self->_storage->{filter_store_key})
65         ? $self->_storage->{filter_store_key}->($_[0])
66         : $_[0];
67
68     return $self->SUPER::DELETE( $key, $_[0] );
69 }
70
71 sub FIRSTKEY {
72     ##
73     # Locate and return first key (in no particular order)
74     ##
75     my $self = shift->_get_self;
76
77     ##
78     # Request shared lock for reading
79     ##
80     $self->lock( $self->LOCK_SH );
81     
82     my $result = $self->_engine->get_next_key( $self );
83     
84     $self->unlock();
85     
86     return ($result && $self->_storage->{filter_fetch_key})
87         ? $self->_storage->{filter_fetch_key}->($result)
88         : $result;
89 }
90
91 sub NEXTKEY {
92     ##
93     # Return next key (in no particular order), given previous one
94     ##
95     my $self = shift->_get_self;
96
97     my $prev_key = ($self->_storage->{filter_store_key})
98         ? $self->_storage->{filter_store_key}->($_[0])
99         : $_[0];
100
101     ##
102     # Request shared lock for reading
103     ##
104     $self->lock( $self->LOCK_SH );
105     
106     my $result = $self->_engine->get_next_key( $self, $prev_key );
107     
108     $self->unlock();
109     
110     return ($result && $self->_storage->{filter_fetch_key})
111         ? $self->_storage->{filter_fetch_key}->($result)
112         : $result;
113 }
114
115 ##
116 # Public method aliases
117 ##
118 sub first_key { (shift)->FIRSTKEY(@_) }
119 sub next_key { (shift)->NEXTKEY(@_) }
120
121 sub _copy_node {
122     my $self = shift;
123     my ($db_temp) = @_;
124
125     my $key = $self->first_key();
126     while ($key) {
127         my $value = $self->get($key);
128         $self->_copy_value( \$db_temp->{$key}, $value );
129         $key = $self->next_key($key);
130     }
131
132     return 1;
133 }
134
135 1;
136 __END__