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