Commit | Line | Data |
6fe26b29 |
1 | package DBM::Deep::Hash; |
2 | |
2120a181 |
3 | use 5.006_000; |
460b1067 |
4 | |
6fe26b29 |
5 | use strict; |
065b45be |
6 | use warnings FATAL => 'all'; |
616df1be |
7 | no warnings 'recursion'; |
86867f3a |
8 | |
6fe26b29 |
9 | use base 'DBM::Deep'; |
10 | |
596e9574 |
11 | sub _get_self { |
a4e2db58 |
12 | eval { local $SIG{'__DIE__'}; tied( %{$_[0]} ) } || $_[0] |
596e9574 |
13 | } |
14 | |
e00d0eb3 |
15 | sub _repr { return {} } |
f9c33187 |
16 | |
6fe26b29 |
17 | sub TIEHASH { |
18 | ## |
19 | # Tied hash constructor method, called by Perl's tie() function. |
20 | ## |
21 | my $class = shift; |
0ca7ea98 |
22 | my $args = $class->_get_args( @_ ); |
6fe26b29 |
23 | |
24 | $args->{type} = $class->TYPE_HASH; |
25 | |
26 | return $class->_init($args); |
27 | } |
28 | |
cb79ec85 |
29 | sub FETCH { |
30 | my $self = shift->_get_self; |
2120a181 |
31 | DBM::Deep->_throw_error( "Cannot use an undefined hash key." ) unless defined $_[0]; |
f1879fdc |
32 | my $key = ($self->_engine->storage->{filter_store_key}) |
33 | ? $self->_engine->storage->{filter_store_key}->($_[0]) |
cb79ec85 |
34 | : $_[0]; |
35 | |
359a01ac |
36 | return $self->SUPER::FETCH( $key, $_[0] ); |
cb79ec85 |
37 | } |
38 | |
81d3d316 |
39 | sub STORE { |
40 | my $self = shift->_get_self; |
2120a181 |
41 | DBM::Deep->_throw_error( "Cannot use an undefined hash key." ) unless defined $_[0]; |
f1879fdc |
42 | my $key = ($self->_engine->storage->{filter_store_key}) |
43 | ? $self->_engine->storage->{filter_store_key}->($_[0]) |
81d3d316 |
44 | : $_[0]; |
45 | my $value = $_[1]; |
46 | |
359a01ac |
47 | return $self->SUPER::STORE( $key, $value, $_[0] ); |
81d3d316 |
48 | } |
49 | |
baa27ab6 |
50 | sub EXISTS { |
51 | my $self = shift->_get_self; |
2120a181 |
52 | DBM::Deep->_throw_error( "Cannot use an undefined hash key." ) unless defined $_[0]; |
f1879fdc |
53 | my $key = ($self->_engine->storage->{filter_store_key}) |
54 | ? $self->_engine->storage->{filter_store_key}->($_[0]) |
baa27ab6 |
55 | : $_[0]; |
56 | |
57 | return $self->SUPER::EXISTS( $key ); |
58 | } |
59 | |
feaf1e6f |
60 | sub DELETE { |
61 | my $self = shift->_get_self; |
2120a181 |
62 | DBM::Deep->_throw_error( "Cannot use an undefined hash key." ) unless defined $_[0]; |
f1879fdc |
63 | my $key = ($self->_engine->storage->{filter_store_key}) |
64 | ? $self->_engine->storage->{filter_store_key}->($_[0]) |
feaf1e6f |
65 | : $_[0]; |
66 | |
359a01ac |
67 | return $self->SUPER::DELETE( $key, $_[0] ); |
feaf1e6f |
68 | } |
69 | |
6fe26b29 |
70 | sub FIRSTKEY { |
1cff45d7 |
71 | ## |
72 | # Locate and return first key (in no particular order) |
73 | ## |
eea0d863 |
74 | my $self = shift->_get_self; |
6fe26b29 |
75 | |
5c0756fc |
76 | $self->lock_shared; |
1cff45d7 |
77 | |
78 | my $result = $self->_engine->get_next_key( $self ); |
79 | |
9c87a079 |
80 | $self->unlock; |
1cff45d7 |
81 | |
f1879fdc |
82 | return ($result && $self->_engine->storage->{filter_fetch_key}) |
83 | ? $self->_engine->storage->{filter_fetch_key}->($result) |
6fe26b29 |
84 | : $result; |
85 | } |
86 | |
87 | sub NEXTKEY { |
1cff45d7 |
88 | ## |
89 | # Return next key (in no particular order), given previous one |
90 | ## |
eea0d863 |
91 | my $self = shift->_get_self; |
6fe26b29 |
92 | |
f1879fdc |
93 | my $prev_key = ($self->_engine->storage->{filter_store_key}) |
94 | ? $self->_engine->storage->{filter_store_key}->($_[0]) |
eea0d863 |
95 | : $_[0]; |
6fe26b29 |
96 | |
5c0756fc |
97 | $self->lock_shared; |
1cff45d7 |
98 | |
99 | my $result = $self->_engine->get_next_key( $self, $prev_key ); |
100 | |
9c87a079 |
101 | $self->unlock; |
102 | |
f1879fdc |
103 | return ($result && $self->_engine->storage->{filter_fetch_key}) |
104 | ? $self->_engine->storage->{filter_fetch_key}->($result) |
6fe26b29 |
105 | : $result; |
106 | } |
107 | |
108 | ## |
109 | # Public method aliases |
110 | ## |
f9c33187 |
111 | sub first_key { (shift)->FIRSTKEY(@_) } |
112 | sub next_key { (shift)->NEXTKEY(@_) } |
113 | |
39baa1fd |
114 | sub _clear { |
115 | my $self = shift; |
116 | |
5a755162 |
117 | while ( defined(my $key = $self->first_key) ) { |
d8f1fa98 |
118 | do { |
39baa1fd |
119 | $self->_engine->delete_key( $self, $key, $key ); |
d8f1fa98 |
120 | } while defined($key = $self->next_key($key)); |
39baa1fd |
121 | } |
122 | |
123 | return; |
124 | } |
125 | |
f9c33187 |
126 | sub _copy_node { |
898fd1fd |
127 | my $self = shift; |
f9c33187 |
128 | my ($db_temp) = @_; |
129 | |
130 | my $key = $self->first_key(); |
c11b7bfb |
131 | while (defined $key) { |
f9c33187 |
132 | my $value = $self->get($key); |
133 | $self->_copy_value( \$db_temp->{$key}, $value ); |
134 | $key = $self->next_key($key); |
135 | } |
136 | |
137 | return 1; |
138 | } |
6fe26b29 |
139 | |
140 | 1; |
141 | __END__ |