Assignment to a negative value within the bounds of the array works

diff --git a/lib/DBM/Deep.pm b/lib/DBM/Deep.pm
index 8ff43f0..669ba3e 100644 (file)
--- a/lib/DBM/Deep.pm
+++ b/lib/DBM/Deep.pm
@@ -1255,9 +1255,6 @@ sub STORE {
         ? $self->root->{filter_store_value}->($_[2])
         : $_[2];
        
-       my $unpacked_key = $key;
-       if (($self->type eq TYPE_ARRAY) && ($key =~ /^\d+$/)) { $key = pack($LONG_PACK, $key); }
-
        my $md5 = $DIGEST_FUNC->($key);
        
        ##
@@ -1319,14 +1316,6 @@ sub STORE {
        ##
        my $result = $self->_add_bucket( $tag, $md5, $key, $value );
        
-       ##
-       # If this object is an array, and bucket was not a replace, and key is numerical,
-       # and index is equal or greater than current length, advance length variable.
-       ##
-       if (($result == 2) && ($self->type eq TYPE_ARRAY) && ($unpacked_key =~ /^\d+$/) && ($unpacked_key >= $self->FETCHSIZE())) {
-               $self->STORESIZE( $unpacked_key + 1 );
-       }
-       
        $self->unlock();
 
        return $result;
@@ -1336,22 +1325,16 @@ sub FETCH {
        ##
        # Fetch single value or element given plain key or array index
        ##
-    my $self = $_[0]->_get_self;
-
-    my $key = $_[1];
-    if ( $self->type eq TYPE_HASH ) {
-        if ( my $filter = $self->root->{filter_store_key} ) {
-            $key = $filter->( $key );
-        }
-    }
-
-       my $md5 = $DIGEST_FUNC->($key);
+    my $self = shift->_get_self;
+    my $key = shift;
 
        ##
        # Make sure file is open
        ##
        if (!defined($self->fh)) { $self->_open(); }
        
+       my $md5 = $DIGEST_FUNC->($key);
+
        ##
        # Request shared lock for reading
        ##
@@ -1371,7 +1354,9 @@ sub FETCH {
        $self->unlock();
        
     #XXX What is ref() checking here?
-       return ($result && !ref($result) && $self->root->{filter_fetch_value}) ? $self->root->{filter_fetch_value}->($result) : $result;
+       return ($result && !ref($result) && $self->root->{filter_fetch_value})
+        ? $self->root->{filter_fetch_value}->($result)
+        : $result;
 }
 
 sub DELETE {

diff --git a/lib/DBM/Deep/Array.pm b/lib/DBM/Deep/Array.pm
index 20c4359..4cb8919 100644 (file)
--- a/lib/DBM/Deep/Array.pm
+++ b/lib/DBM/Deep/Array.pm
@@ -39,10 +39,6 @@ sub TIEARRAY {
        return $class->_init($args);
 }
 
-##
-# The following methods are for arrays only
-##
-
 sub FETCH {
     my $self = $_[0]->_get_self;
     my $key = $_[1];
@@ -59,6 +55,34 @@ sub FETCH {
     return $self->SUPER::FETCH( $key );
 }
 
+sub STORE {
+    my $self = shift->_get_self;
+    my ($key, $value) = @_;
+
+    my $unpacked_key = $key;
+    my $size = $self->FETCHSIZE;
+
+    my $numeric_idx;
+    if ( $key =~ /^-?\d+$/ ) {
+        $numeric_idx = 1;
+        if ( $key < 0 ) {
+            $key += $size;
+            #XXX What to do here?
+#            return unless $key >= 0;
+        }
+
+        $key = pack($DBM::Deep::LONG_PACK, $key);
+    }
+
+    my $rv = $self->SUPER::STORE( $key, $value );
+
+    if ( $numeric_idx && $rv == 2 && $unpacked_key >= $size ) {
+        $self->STORESIZE( $unpacked_key + 1 );
+    }
+
+    return $rv;
+}
+
 sub FETCHSIZE {
        ##
        # Return the length of the array
@@ -75,7 +99,8 @@ sub FETCHSIZE {
        if ($packed_size) {
         return int(unpack($DBM::Deep::LONG_PACK, $packed_size));
     }
-       else { return 0; } 
+
+       return 0;
 }
 
 sub STORESIZE {

diff --git a/lib/DBM/Deep/Hash.pm b/lib/DBM/Deep/Hash.pm
index baceab1..7dc9acd 100644 (file)
--- a/lib/DBM/Deep/Hash.pm
+++ b/lib/DBM/Deep/Hash.pm
@@ -33,6 +33,15 @@ sub TIEHASH {
     return $class->_init($args);
 }
 
+sub FETCH {
+    my $self = shift->_get_self;
+    my $key = ($self->root->{filter_store_key})
+        ? $self->root->{filter_store_key}->($_[0])
+        : $_[0];
+
+    return $self->SUPER::FETCH( $key );
+}
+
 sub STORE {
     my $self = shift->_get_self;
        my $key = ($self->root->{filter_store_key})

diff --git a/t/04_array.t b/t/04_array.t
index c535f2f..fd25f9e 100644 (file)
--- a/t/04_array.t
+++ b/t/04_array.t
@@ -2,7 +2,7 @@
 # DBM::Deep Test
 ##
 use strict;
-use Test::More tests => 90;
+use Test::More tests => 94;
 use Test::Exception;
 
 use_ok( 'DBM::Deep' );
@@ -61,13 +61,19 @@ is( $db->[-5], $db->[0], "-5th index is 0th index" );
 is( $db->[-6], undef, "-6th index is undef" );
 is( $db->length, 5, "... and we have five elements after abortive -6 index lookup" );
 
+$db->[-1] = 'elem4.1';
+is( $db->[-1], 'elem4.1' );
+is( $db->[4], 'elem4.1' );
+is( $db->get(4), 'elem4.1' );
+is( $db->fetch(4), 'elem4.1' );
+
 my $popped = $db->pop;
 is( $db->length, 4, "... and we have four after popping" );
 is( $db->[0], 'elem0', "0th element still there after popping" );
 is( $db->[1], 'elem1', "1st element still there after popping" );
 is( $db->[2], 'elem2', "2nd element still there after popping" );
 is( $db->[3], 'elem3', "3rd element still there after popping" );
-is( $popped, 'elem4', "Popped value is correct" );
+is( $popped, 'elem4.1', "Popped value is correct" );
 
 my $shifted = $db->shift;
 is( $db->length, 3, "... and we have three after shifting" );