From: rkinyon <rkinyon@50811bd7-b8ce-0310-adc1-d9db26280581>
Date: Wed, 22 Feb 2006 19:23:17 +0000 (+0000)
Subject: Assignment to a negative value within the bounds of the array works
X-Git-Tag: 0-97~26
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=cb79ec8525a4ea1ce20e68a653ab87a419afc474;p=dbsrgits%2FDBM-Deep.git

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
--- 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
--- 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
--- 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
--- 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" );