Improved the speed of Array PUT a little ... still needs work
rkinyon [Thu, 23 Feb 2006 05:02:24 +0000 (05:02 +0000)]
lib/DBM/Deep.pm
lib/DBM/Deep/Array.pm
t/05_bigarray.t

index 6eb9540..977fa97 100644 (file)
@@ -1269,9 +1269,8 @@ sub STORE {
     my $self = $_[0]->_get_self;
        my $key = $_[1];
 
-    #XXX What is ref() checking here?
-    #YYY User may be storing a hash, in which case we do not want it run 
-    #YYY through the filtering system
+    # User may be storing a hash, in which case we do not want it run 
+    # through the filtering system
        my $value = ($self->root->{filter_store_value} && !ref($_[2]))
         ? $self->root->{filter_store_value}->($_[2])
         : $_[2];
index 0950a12..c6e9bf7 100644 (file)
@@ -60,12 +60,13 @@ sub STORE {
     $self->lock( $self->LOCK_EX );
 
     my $orig = $key;
-    my $size = $self->FETCHSIZE;
 
+    my $size;
     my $numeric_idx;
-    if ( $key =~ /^-?\d+$/ ) {
+    if ( $key =~ /^\-?\d+$/ ) {
         $numeric_idx = 1;
         if ( $key < 0 ) {
+            $size = $self->FETCHSIZE;
             $key += $size;
             if ( $key < 0 ) {
                 die( "Modification of non-creatable array value attempted, subscript $orig" );
@@ -77,8 +78,11 @@ sub STORE {
 
     my $rv = $self->SUPER::STORE( $key, $value );
 
-    if ( $numeric_idx && $rv == 2 && $orig >= $size ) {
-        $self->STORESIZE( $orig + 1 );
+    if ( $numeric_idx && $rv == 2 ) {
+        $size = $self->FETCHSIZE unless defined $size;
+        if ( $orig >= $size ) {
+            $self->STORESIZE( $orig + 1 );
+        }
     }
 
     $self->unlock;
@@ -92,7 +96,7 @@ sub EXISTS {
 
        $self->lock( $self->LOCK_SH );
 
-    if ( $key =~ /^-?\d+$/ ) {
+    if ( $key =~ /^\-?\d+$/ ) {
         if ( $key < 0 ) {
             $key += $self->FETCHSIZE;
             unless ( $key >= 0 ) {
index be70d93..c729c8d 100644 (file)
@@ -2,10 +2,7 @@
 # DBM::Deep Test
 ##
 use strict;
-use Test::More;
-
-my $max_keys = 4000;
-plan tests => 2;
+use Test::More tests => 2;
 
 use_ok( 'DBM::Deep' );
 
@@ -21,6 +18,8 @@ if ($db->error()) {
 ##
 # put/get many keys
 ##
+my $max_keys = 4000;
+
 for ( 0 .. $max_keys ) {
     $db->put( $_ => $_ * 2 );
 }
@@ -28,7 +27,7 @@ for ( 0 .. $max_keys ) {
 my $count = -1;
 for ( 0 .. $max_keys ) {
     $count = $_;
-    unless( $db->get( $_ ) eq $_ * 2 ) {
+    unless( $db->get( $_ ) == $_ * 2 ) {
         last;
     };
 }