From: rkinyon Date: Thu, 23 Feb 2006 05:02:24 +0000 (+0000) Subject: Improved the speed of Array PUT a little ... still needs work X-Git-Tag: 0-97~15 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=9ab67b8c49caee0d4b5d4b7da28a0be52372b646;p=dbsrgits%2FDBM-Deep.git Improved the speed of Array PUT a little ... still needs work --- diff --git a/lib/DBM/Deep.pm b/lib/DBM/Deep.pm index 6eb9540..977fa97 100644 --- a/lib/DBM/Deep.pm +++ b/lib/DBM/Deep.pm @@ -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]; diff --git a/lib/DBM/Deep/Array.pm b/lib/DBM/Deep/Array.pm index 0950a12..c6e9bf7 100644 --- a/lib/DBM/Deep/Array.pm +++ b/lib/DBM/Deep/Array.pm @@ -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 ) { diff --git a/t/05_bigarray.t b/t/05_bigarray.t index be70d93..c729c8d 100644 --- a/t/05_bigarray.t +++ b/t/05_bigarray.t @@ -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; }; }