From: rkinyon Date: Thu, 23 Feb 2006 00:50:46 +0000 (+0000) Subject: Negative indices all work and all the array methods are correctly locked X-Git-Tag: 0-97~19 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=9281d66bfa5467677e13e312e163a57f10a23c18;p=dbsrgits%2FDBM-Deep.git Negative indices all work and all the array methods are correctly locked --- diff --git a/MANIFEST b/MANIFEST index 4c5a94a..64212fb 100644 --- a/MANIFEST +++ b/MANIFEST @@ -32,4 +32,3 @@ t/22_internal_copy.t t/23_misc.t t/24_autobless.t t/25_tie_return_value.t -t/26_scalar_ref.t diff --git a/lib/DBM/Deep.pm b/lib/DBM/Deep.pm index 1f81f8d..8644eed 100644 --- a/lib/DBM/Deep.pm +++ b/lib/DBM/Deep.pm @@ -1387,8 +1387,6 @@ sub DELETE { my $self = $_[0]->_get_self; my $key = $_[1]; - my $unpacked_key = $key; - if (($self->type eq TYPE_ARRAY) && ($key =~ /^\d+$/)) { $key = pack($LONG_PACK, $key); } my $md5 = $DIGEST_FUNC->($key); ## @@ -1421,9 +1419,6 @@ sub DELETE { # If this object is an array and the key deleted was on the end of the stack, # decrement the length variable. ## - if ($result && ($self->type eq TYPE_ARRAY) && ($unpacked_key == $self->FETCHSIZE() - 1)) { - $self->STORESIZE( $unpacked_key ); - } $self->unlock(); diff --git a/lib/DBM/Deep/Array.pm b/lib/DBM/Deep/Array.pm index 6c7d7d4..1a0ec8e 100644 --- a/lib/DBM/Deep/Array.pm +++ b/lib/DBM/Deep/Array.pm @@ -28,22 +28,33 @@ sub FETCH { my $self = $_[0]->_get_self; my $key = $_[1]; + $self->lock( $self->LOCK_SH ); + if ( $key =~ /^-?\d+$/ ) { if ( $key < 0 ) { $key += $self->FETCHSIZE; - return unless $key >= 0; + unless ( $key >= 0 ) { + $self->unlock; + return; + } } $key = pack($DBM::Deep::LONG_PACK, $key); } - return $self->SUPER::FETCH( $key ); + my $rv = $self->SUPER::FETCH( $key ); + + $self->unlock; + + return $rv; } sub STORE { my $self = shift->_get_self; my ($key, $value) = @_; + $self->lock( $self->LOCK_EX ); + my $orig = $key; my $size = $self->FETCHSIZE; @@ -66,6 +77,8 @@ sub STORE { $self->STORESIZE( $orig + 1 ); } + $self->unlock; + return $rv; } @@ -73,24 +86,67 @@ sub EXISTS { my $self = $_[0]->_get_self; my $key = $_[1]; + $self->lock( $self->LOCK_SH ); + if ( $key =~ /^-?\d+$/ ) { if ( $key < 0 ) { $key += $self->FETCHSIZE; - return unless $key >= 0; + unless ( $key >= 0 ) { + $self->unlock; + return; + } + } + + $key = pack($DBM::Deep::LONG_PACK, $key); + } + + my $rv = $self->SUPER::EXISTS( $key ); + + $self->unlock; + + return $rv; +} + +sub DELETE { + my $self = $_[0]->_get_self; + my $key = $_[1]; + + my $unpacked_key = $key; + + $self->lock( $self->LOCK_EX ); + + my $size = $self->FETCHSIZE; + if ( $key =~ /^-?\d+$/ ) { + if ( $key < 0 ) { + $key += $size; + unless ( $key >= 0 ) { + $self->unlock; + return; + } } $key = pack($DBM::Deep::LONG_PACK, $key); } - return $self->SUPER::EXISTS( $key ); + my $rv = $self->SUPER::DELETE( $key ); + + if ($rv && $unpacked_key == $size - 1) { + $self->STORESIZE( $unpacked_key ); + } + + $self->unlock; + + return $rv; } sub FETCHSIZE { ## # Return the length of the array ## - my $self = $_[0]->_get_self; - + my $self = shift->_get_self; + + $self->lock( $self->LOCK_SH ); + my $SAVE_FILTER = $self->root->{filter_fetch_value}; $self->root->{filter_fetch_value} = undef; @@ -98,6 +154,8 @@ sub FETCHSIZE { $self->root->{filter_fetch_value} = $SAVE_FILTER; + $self->unlock; + if ($packed_size) { return int(unpack($DBM::Deep::LONG_PACK, $packed_size)); } @@ -112,6 +170,8 @@ sub STORESIZE { my $self = $_[0]->_get_self; my $new_length = $_[1]; + $self->lock( $self->LOCK_EX ); + my $SAVE_FILTER = $self->root->{filter_store_value}; $self->root->{filter_store_value} = undef; @@ -119,6 +179,8 @@ sub STORESIZE { $self->root->{filter_store_value} = $SAVE_FILTER; + $self->unlock; + return $result; } @@ -127,14 +189,21 @@ sub POP { # Remove and return the last element on the array ## my $self = $_[0]->_get_self; + + $self->lock( $self->LOCK_EX ); + my $length = $self->FETCHSIZE(); if ($length) { my $content = $self->FETCH( $length - 1 ); $self->DELETE( $length - 1 ); + + $self->unlock; + return $content; } else { + $self->unlock; return; } } @@ -144,13 +213,18 @@ sub PUSH { # Add new element(s) to the end of the array ## my $self = shift->_get_self; - my $length = $self->FETCHSIZE(); + $self->lock( $self->LOCK_EX ); + + my $length = $self->FETCHSIZE(); + while (my $content = shift @_) { $self->STORE( $length, $content ); $length++; } + $self->unlock; + return $length; } @@ -160,6 +234,9 @@ sub SHIFT { # Shift over remaining elements to take up space. ## my $self = $_[0]->_get_self; + + $self->lock( $self->LOCK_EX ); + my $length = $self->FETCHSIZE(); if ($length) { @@ -172,10 +249,13 @@ sub SHIFT { $self->STORE( $i, $self->FETCH($i + 1) ); } $self->DELETE( $length - 1 ); + + $self->unlock; return $content; } else { + $self->unlock; return; } } @@ -187,6 +267,9 @@ sub UNSHIFT { ## my $self = shift->_get_self; my @new_elements = @_; + + $self->lock( $self->LOCK_EX ); + my $length = $self->FETCHSIZE(); my $new_size = scalar @new_elements; @@ -200,6 +283,8 @@ sub UNSHIFT { $self->STORE( $i, $new_elements[$i] ); } + $self->unlock; + return $length + $new_size; } @@ -209,6 +294,9 @@ sub SPLICE { # Returns deleted section, or last element deleted in scalar context. ## my $self = shift->_get_self; + + $self->lock( $self->LOCK_EX ); + my $length = $self->FETCHSIZE(); ## @@ -260,13 +348,15 @@ sub SPLICE { $self->STORE( $i, shift @new_elements ); } + $self->unlock; + ## # Return deleted section, or last element in scalar context. ## return wantarray ? @old_elements : $old_elements[-1]; } -#XXX We don't need to define it. +#XXX We don't need to define it, yet. #XXX It will be useful, though, when we split out HASH and ARRAY #sub EXTEND { ## diff --git a/t/04_array.t b/t/04_array.t index 3017714..c765cd5 100644 --- a/t/04_array.t +++ b/t/04_array.t @@ -111,15 +111,9 @@ is( $db->length, 3, "... and we still have three after a DELETE on an out-of-ran $deleted = $db->delete(-2); is( $db->length, 3, "... and we still have three after deleting" ); is( $db->[0], undef, "0th element still undef" ); -TODO: { - local $TODO = "delete on a negative array element should work"; - is( $db->[1], undef, "1st element now undef" ); -} +is( $db->[1], undef, "1st element now undef" ); is( $db->[2], 'elem3', "2nd element still there after deleting" ); -TODO: { - local $TODO = "delete on a negative array element should return the deleted value"; - is( $deleted, 'elem2', "Deleted value is correct" ); -} +is( $deleted, 'elem2', "Deleted value is correct" ); $db->[1] = 'elem2';