X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBM%2FDeep%2FArray.pm;h=d6df2d6dee85b455bc366bd122bf08b735600792;hb=00d9bd0b6498a075c565328bfb031e12072d7001;hp=186817b60c0593fba474c22204709c75019a5148;hpb=1c7a280d149d6f3f96f83aac350d3fd3a6faa3df;p=dbsrgits%2FDBM-Deep.git diff --git a/lib/DBM/Deep/Array.pm b/lib/DBM/Deep/Array.pm index 186817b..d6df2d6 100644 --- a/lib/DBM/Deep/Array.pm +++ b/lib/DBM/Deep/Array.pm @@ -26,12 +26,17 @@ sub TIEARRAY { $args->{type} = $class->TYPE_ARRAY; - return $class->_init($args); + my $self = $class->_init($args); + +# $self->STORESIZE; + + return $self; } sub FETCH { my $self = shift->_get_self; my ($key) = @_; + warn "ARRAY:FETCH( $key )\n" if DBM::Deep::DEBUG; $self->lock_shared; @@ -63,6 +68,7 @@ sub FETCH { sub STORE { my $self = shift->_get_self; my ($key, $value) = @_; + warn "ARRAY::STORE($self, $key)\n" if DBM::Deep::DEBUG; $self->lock_exclusive; @@ -104,6 +110,7 @@ sub STORE { sub EXISTS { my $self = shift->_get_self; my ($key) = @_; + warn "ARRAY::EXISTS($self, $key)\n" if DBM::Deep::DEBUG; $self->lock_shared; @@ -174,24 +181,31 @@ sub DELETE { # going to work. sub FETCHSIZE { my $self = shift->_get_self; + warn "ARRAY::FETCHSIZE($self)\n" if DBM::Deep::DEBUG; $self->lock_shared; my $SAVE_FILTER = $self->_engine->storage->{filter_fetch_value}; $self->_engine->storage->{filter_fetch_value} = undef; + # If there is no flushing, then things get out of sync. +# warn "FETCHSIZE BEG: " . $self->_engine->_dump_file; my $size = $self->FETCH('length') || 0; +# warn "FETCHSIZE AFT: " . $self->_engine->_dump_file; $self->_engine->storage->{filter_fetch_value} = $SAVE_FILTER; $self->unlock; +# warn "FETCHSIZE END: " . $self->_engine->_dump_file; + return $size; } sub STORESIZE { my $self = shift->_get_self; my ($new_length) = @_; + warn "ARRAY::STORESIZE($self, $new_length)\n" if DBM::Deep::DEBUG; $self->lock_exclusive; @@ -209,6 +223,7 @@ sub STORESIZE { sub POP { my $self = shift->_get_self; + warn "ARRAY::POP($self)\n" if DBM::Deep::DEBUG; $self->lock_exclusive; @@ -230,6 +245,7 @@ sub POP { sub PUSH { my $self = shift->_get_self; + warn "ARRAY::PUSH($self)\n" if DBM::Deep::DEBUG; $self->lock_exclusive; @@ -256,7 +272,7 @@ sub _move_value { sub SHIFT { my $self = shift->_get_self; - warn "SHIFT($self)\n" if DBM::Deep::DEBUG; + warn "ARRAY::SHIFT($self)\n" if DBM::Deep::DEBUG; $self->lock_exclusive; @@ -285,6 +301,7 @@ sub SHIFT { sub UNSHIFT { my $self = shift->_get_self; + warn "ARRAY::UNSHIFT($self)\n" if DBM::Deep::DEBUG; my @new_elements = @_; $self->lock_exclusive; @@ -297,12 +314,15 @@ sub UNSHIFT { $self->_move_value( $i, $i+$new_size ); } +# warn "BEFORE: " . $self->_dump_file; $self->STORESIZE( $length + $new_size ); } +# $self->_engine->flush; for (my $i = 0; $i < $new_size; $i++) { $self->STORE( $i, $new_elements[$i] ); } + warn "AFTER : " . $self->_dump_file; $self->unlock; @@ -311,6 +331,7 @@ sub UNSHIFT { sub SPLICE { my $self = shift->_get_self; + warn "ARRAY::SPLICE($self)\n" if DBM::Deep::DEBUG; $self->lock_exclusive; @@ -377,6 +398,7 @@ sub SPLICE { # We don't need to populate it, yet. # It will be useful, though, when we split out HASH and ARRAY sub EXTEND { + warn "ARRAY::EXTEND()\n" if DBM::Deep::DEBUG; ## # Perl will call EXTEND() when the array is likely to grow. # We don't care, but include it because it gets called at times.