Started to make negative array indices work

diff --git a/lib/DBM/Deep.pm b/lib/DBM/Deep.pm
index d127102..8ff43f0 100644 (file)
--- a/lib/DBM/Deep.pm
+++ b/lib/DBM/Deep.pm
@@ -284,6 +284,7 @@ sub _close {
        ##
     my $self = $_[0]->_get_self;
     close $self->root->{fh};
+    $self->root->{fh} = undef;
 }
 
 sub _create_tag {
@@ -894,6 +895,8 @@ sub lock {
        my $type = $_[1];
     $type = LOCK_EX unless defined $type;
        
+       if (!defined($self->fh)) { return; }
+
        if ($self->root->{locking}) {
                if (!$self->root->{locked}) { flock($self->fh, $type); }
                $self->root->{locked}++;
@@ -910,6 +913,8 @@ sub unlock {
        # regarding calling lock() multiple times.
        ##
     my $self = $_[0]->_get_self;
+
+       if (!defined($self->fh)) { return; }
        
        if ($self->root->{locking} && $self->root->{locked} > 0) {
                $self->root->{locked}--;
@@ -1339,11 +1344,6 @@ sub FETCH {
             $key = $filter->( $key );
         }
     }
-    elsif ( $self->type eq TYPE_ARRAY ) { 
-        if ( $key =~ /^\d+$/ ) {
-            $key = pack($LONG_PACK, $key);
-        }
-    }
 
        my $md5 = $DIGEST_FUNC->($key);
 
@@ -1494,8 +1494,10 @@ sub CLEAR {
 ##
 # Public method aliases
 ##
-*put = *store = *STORE;
-*get = *fetch = *FETCH;
+sub put { (shift)->STORE( @_ ) }
+sub store { (shift)->STORE( @_ ) }
+sub get { (shift)->FETCH( @_ ) }
+sub fetch { (shift)->FETCH( @_ ) }
 *delete = *DELETE;
 *exists = *EXISTS;
 *clear = *CLEAR;

diff --git a/lib/DBM/Deep/Array.pm b/lib/DBM/Deep/Array.pm
index 34d6a8c..20c4359 100644 (file)
--- a/lib/DBM/Deep/Array.pm
+++ b/lib/DBM/Deep/Array.pm
@@ -1,5 +1,7 @@
 package DBM::Deep::Array;
 
+$NEGATIVE_INDICES = 1;
+
 use strict;
 
 use base 'DBM::Deep';
@@ -41,6 +43,22 @@ sub TIEARRAY {
 # The following methods are for arrays only
 ##
 
+sub FETCH {
+    my $self = $_[0]->_get_self;
+    my $key = $_[1];
+
+    if ( $key =~ /^-?\d+$/ ) {
+        if ( $key < 0 ) {
+            $key += $self->FETCHSIZE;
+            return unless $key >= 0;
+        }
+
+        $key = pack($DBM::Deep::LONG_PACK, $key);
+    }
+
+    return $self->SUPER::FETCH( $key );
+}
+
 sub FETCHSIZE {
        ##
        # Return the length of the array
@@ -54,7 +72,9 @@ sub FETCHSIZE {
        
        $self->root->{filter_fetch_value} = $SAVE_FILTER;
        
-       if ($packed_size) { return int(unpack($DBM::Deep::LONG_PACK, $packed_size)); }
+       if ($packed_size) {
+        return int(unpack($DBM::Deep::LONG_PACK, $packed_size));
+    }
        else { return 0; } 
 }
 

diff --git a/t/04_array.t b/t/04_array.t
index c75c2dc..c535f2f 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 => 89;
+use Test::More tests => 90;
 use Test::Exception;
 
 use_ok( 'DBM::Deep' );
@@ -53,15 +53,12 @@ is( $db->fetch(4), 'elem4', "fetch() for store() works" );
 
 is( $db->length, 5, "... and we have five elements" );
 
-is( $db->[-1], $db->[4], "-1st index is 4th value" );
-is( $db->[-2], $db->[3], "-2nd index is 3rd value" );
-is( $db->[-3], $db->[2], "-3rd index is 2nd value" );
-is( $db->[-4], $db->[1], "-4th index is 1st value" );
-is( $db->[-5], $db->[0], "-5th index is 0th value" );
-TODO: {
-    local $TODO = "Going off the end of the array from the back is legal";
-    eval { is( $db->[-6], undef, "-6th index is undef" ); };
-}
+is( $db->[-1], $db->[4], "-1st index is 4th index" );
+is( $db->[-2], $db->[3], "-2nd index is 3rd index" );
+is( $db->[-3], $db->[2], "-3rd index is 2nd index" );
+is( $db->[-4], $db->[1], "-4th index is 1st index" );
+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" );
 
 my $popped = $db->pop;

diff --git a/t/23_misc.t b/t/23_misc.t
index ebb9160..9e6944b 100644 (file)
--- a/t/23_misc.t
+++ b/t/23_misc.t
@@ -31,8 +31,7 @@ throws_ok {
     my $db = DBM::Deep->new( __FILE__ );
 } qr/^DBM::Deep: Signature not found -- file is not a Deep DB/, "Only DBM::Deep DB files will be opened";
 
-TODO: {
-    local $TODO = "lock() doesn't check to see if the file is open";
+{
     my $db = DBM::Deep->new(
         file => 't/test.db',
         locking => 1,
@@ -41,8 +40,7 @@ TODO: {
     ok( !$db->lock );
 }
 
-TODO: {
-    local $TODO = "unlock() doesn't check to see if the file is open";
+{
     my $db = DBM::Deep->new(
         file => 't/test.db',
         locking => 1,