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