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