lib/DBM/Deep/Hash.pm

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