lib/DBM/Deep/Hash.pm

   1 package DBM::Deep::Hash;
   2
   3 use 5.006_000;
   4
   5 use strict;
   6 use warnings;
   7
   8 our $VERSION = q(1.0001);
   9
  10 use base 'DBM::Deep';
  11
  12 sub _get_self {
  13     eval { local $SIG{'__DIE__'}; tied( %{$_[0]} ) } || $_[0]
  14 }
  15
  16 #XXX Need to add a check here for @_ % 2
  17 sub _repr { shift;return { @_ } }
  18
  19 sub _import {
  20     my $self = shift;
  21     my ($struct) = @_;
  22
  23     foreach my $key (keys %$struct) {
  24         $self->put($key, $struct->{$key});
  25     }
  26
  27     return 1;
  28 }
  29
  30 sub TIEHASH {
  31     ##
  32     # Tied hash constructor method, called by Perl's tie() function.
  33     ##
  34     my $class = shift;
  35     my $args = $class->_get_args( @_ );
  36
  37     $args->{type} = $class->TYPE_HASH;
  38
  39     return $class->_init($args);
  40 }
  41
  42 sub FETCH {
  43     my $self = shift->_get_self;
  44     DBM::Deep->_throw_error( "Cannot use an undefined hash key." ) unless defined $_[0];
  45     my $key = ($self->_storage->{filter_store_key})
  46         ? $self->_storage->{filter_store_key}->($_[0])
  47         : $_[0];
  48
  49     return $self->SUPER::FETCH( $key, $_[0] );
  50 }
  51
  52 sub STORE {
  53     my $self = shift->_get_self;
  54     DBM::Deep->_throw_error( "Cannot use an undefined hash key." ) unless defined $_[0];
  55         my $key = ($self->_storage->{filter_store_key})
  56         ? $self->_storage->{filter_store_key}->($_[0])
  57         : $_[0];
  58     my $value = $_[1];
  59
  60     return $self->SUPER::STORE( $key, $value, $_[0] );
  61 }
  62
  63 sub EXISTS {
  64     my $self = shift->_get_self;
  65     DBM::Deep->_throw_error( "Cannot use an undefined hash key." ) unless defined $_[0];
  66         my $key = ($self->_storage->{filter_store_key})
  67         ? $self->_storage->{filter_store_key}->($_[0])
  68         : $_[0];
  69
  70     return $self->SUPER::EXISTS( $key );
  71 }
  72
  73 sub DELETE {
  74     my $self = shift->_get_self;
  75     DBM::Deep->_throw_error( "Cannot use an undefined hash key." ) unless defined $_[0];
  76         my $key = ($self->_storage->{filter_store_key})
  77         ? $self->_storage->{filter_store_key}->($_[0])
  78         : $_[0];
  79
  80     return $self->SUPER::DELETE( $key, $_[0] );
  81 }
  82
  83 sub FIRSTKEY {
  84         ##
  85         # Locate and return first key (in no particular order)
  86         ##
  87     my $self = shift->_get_self;
  88
  89         ##
  90         # Request shared lock for reading
  91         ##
  92         $self->lock( $self->LOCK_SH );
  93
  94         my $result = $self->_engine->get_next_key( $self );
  95
  96         $self->unlock();
  97
  98         return ($result && $self->_storage->{filter_fetch_key})
  99         ? $self->_storage->{filter_fetch_key}->($result)
 100         : $result;
 101 }
 102
 103 sub NEXTKEY {
 104         ##
 105         # Return next key (in no particular order), given previous one
 106         ##
 107     my $self = shift->_get_self;
 108
 109         my $prev_key = ($self->_storage->{filter_store_key})
 110         ? $self->_storage->{filter_store_key}->($_[0])
 111         : $_[0];
 112
 113         ##
 114         # Request shared lock for reading
 115         ##
 116         $self->lock( $self->LOCK_SH );
 117
 118         my $result = $self->_engine->get_next_key( $self, $prev_key );
 119
 120         $self->unlock();
 121
 122         return ($result && $self->_storage->{filter_fetch_key})
 123         ? $self->_storage->{filter_fetch_key}->($result)
 124         : $result;
 125 }
 126
 127 ##
 128 # Public method aliases
 129 ##
 130 sub first_key { (shift)->FIRSTKEY(@_) }
 131 sub next_key { (shift)->NEXTKEY(@_) }
 132
 133 sub _copy_node {
 134     my $self = shift;
 135     my ($db_temp) = @_;
 136
 137     my $key = $self->first_key();
 138     while ($key) {
 139         my $value = $self->get($key);
 140         $self->_copy_value( \$db_temp->{$key}, $value );
 141         $key = $self->next_key($key);
 142     }
 143
 144     return 1;
 145 }
 146
 147 1;
 148 __END__