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 | |
5c0756fc | 75 | $self->lock_shared; |
1cff45d7 | 76 | |
77 | my $result = $self->_engine->get_next_key( $self ); | |
78 | ||
9c87a079 | 79 | $self->unlock; |
1cff45d7 | 80 | |
f1879fdc | 81 | return ($result && $self->_engine->storage->{filter_fetch_key}) |
82 | ? $self->_engine->storage->{filter_fetch_key}->($result) | |
6fe26b29 | 83 | : $result; |
84 | } | |
85 | ||
86 | sub NEXTKEY { | |
1cff45d7 | 87 | ## |
88 | # Return next key (in no particular order), given previous one | |
89 | ## | |
eea0d863 | 90 | my $self = shift->_get_self; |
6fe26b29 | 91 | |
f1879fdc | 92 | my $prev_key = ($self->_engine->storage->{filter_store_key}) |
93 | ? $self->_engine->storage->{filter_store_key}->($_[0]) | |
eea0d863 | 94 | : $_[0]; |
6fe26b29 | 95 | |
5c0756fc | 96 | $self->lock_shared; |
1cff45d7 | 97 | |
98 | my $result = $self->_engine->get_next_key( $self, $prev_key ); | |
99 | ||
9c87a079 | 100 | $self->unlock; |
101 | ||
f1879fdc | 102 | return ($result && $self->_engine->storage->{filter_fetch_key}) |
103 | ? $self->_engine->storage->{filter_fetch_key}->($result) | |
6fe26b29 | 104 | : $result; |
105 | } | |
106 | ||
107 | ## | |
108 | # Public method aliases | |
109 | ## | |
f9c33187 | 110 | sub first_key { (shift)->FIRSTKEY(@_) } |
111 | sub next_key { (shift)->NEXTKEY(@_) } | |
112 | ||
113 | sub _copy_node { | |
898fd1fd | 114 | my $self = shift; |
f9c33187 | 115 | my ($db_temp) = @_; |
116 | ||
117 | my $key = $self->first_key(); | |
118 | while ($key) { | |
119 | my $value = $self->get($key); | |
120 | $self->_copy_value( \$db_temp->{$key}, $value ); | |
121 | $key = $self->next_key($key); | |
122 | } | |
123 | ||
124 | return 1; | |
125 | } | |
6fe26b29 | 126 | |
127 | 1; | |
128 | __END__ |