From: rkinyon Date: Tue, 28 Feb 2006 20:01:57 +0000 (+0000) Subject: Moved _get_bucket_value to Engine X-Git-Tag: 0-99_01~112 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=9020ee8c9d87a1b3cfe66117d0b504b3b39b0952;p=dbsrgits%2FDBM-Deep.git Moved _get_bucket_value to Engine --- diff --git a/lib/DBM/Deep.pm b/lib/DBM/Deep.pm index 86ab96d..884d202 100644 --- a/lib/DBM/Deep.pm +++ b/lib/DBM/Deep.pm @@ -203,99 +203,6 @@ sub TIEARRAY { #sub DESTROY { #} -sub _get_bucket_value { - ## - # Fetch single value given tag and MD5 digested key. - ## - my $self = shift; - my ($tag, $md5) = @_; - my $keys = $tag->{content}; - - my $fh = $self->_fh; - - ## - # Iterate through buckets, looking for a key match - ## - BUCKET: - for (my $i=0; $i<$MAX_BUCKETS; $i++) { - my $key = substr($keys, $i * $BUCKET_SIZE, $HASH_SIZE); - my $subloc = unpack($LONG_PACK, substr($keys, ($i * $BUCKET_SIZE) + $HASH_SIZE, $LONG_SIZE)); - - if (!$subloc) { - ## - # Hit end of list, no match - ## - return; - } - - if ( $md5 ne $key ) { - next BUCKET; - } - - ## - # Found match -- seek to offset and read signature - ## - my $signature; - seek($fh, $subloc + $self->_root->{file_offset}, SEEK_SET); - read( $fh, $signature, SIG_SIZE); - - ## - # If value is a hash or array, return new DBM::Deep object with correct offset - ## - if (($signature eq TYPE_HASH) || ($signature eq TYPE_ARRAY)) { - my $obj = DBM::Deep->new( - type => $signature, - base_offset => $subloc, - root => $self->_root - ); - - if ($self->_root->{autobless}) { - ## - # Skip over value and plain key to see if object needs - # to be re-blessed - ## - seek($fh, $DATA_LENGTH_SIZE + $INDEX_SIZE, SEEK_CUR); - - my $size; - read( $fh, $size, $DATA_LENGTH_SIZE); $size = unpack($DATA_LENGTH_PACK, $size); - if ($size) { seek($fh, $size, SEEK_CUR); } - - my $bless_bit; - read( $fh, $bless_bit, 1); - if (ord($bless_bit)) { - ## - # Yes, object needs to be re-blessed - ## - my $class_name; - read( $fh, $size, $DATA_LENGTH_SIZE); $size = unpack($DATA_LENGTH_PACK, $size); - if ($size) { read( $fh, $class_name, $size); } - if ($class_name) { $obj = bless( $obj, $class_name ); } - } - } - - return $obj; - } - - ## - # Otherwise return actual value - ## - elsif ($signature eq SIG_DATA) { - my $size; - my $value = ''; - read( $fh, $size, $DATA_LENGTH_SIZE); $size = unpack($DATA_LENGTH_PACK, $size); - if ($size) { read( $fh, $value, $size); } - return $value; - } - - ## - # Key exists, but content is null - ## - else { return; } - } # i loop - - return; -} - sub _delete_bucket { ## # Delete single key/value pair given tag and MD5 digested key. @@ -953,7 +860,7 @@ sub FETCH { ## # Get value from bucket list ## - my $result = $self->_get_bucket_value( $tag, $md5 ); + my $result = $self->{engine}->get_bucket_value( $self, $tag, $md5 ); $self->unlock(); @@ -988,7 +895,7 @@ sub DELETE { ## # Delete bucket ## - my $value = $self->_get_bucket_value( $tag, $md5 ); + my $value = $self->{engine}->get_bucket_value($self, $tag, $md5 ); if ($value && !ref($value) && $self->_root->{filter_fetch_value}) { $value = $self->_root->{filter_fetch_value}->($value); } diff --git a/lib/DBM/Deep/Engine.pm b/lib/DBM/Deep/Engine.pm index a03cfe7..6e9df64 100644 --- a/lib/DBM/Deep/Engine.pm +++ b/lib/DBM/Deep/Engine.pm @@ -424,5 +424,97 @@ sub add_bucket { return $obj->_throw_error("Fatal error: indexing failed -- possibly due to corruption in file"); } +sub get_bucket_value { + ## + # Fetch single value given tag and MD5 digested key. + ## + my $self = shift; + my ($obj, $tag, $md5) = @_; + my $keys = $tag->{content}; + + my $fh = $obj->_fh; + + ## + # Iterate through buckets, looking for a key match + ## + BUCKET: + for (my $i=0; $i<$DBM::Deep::MAX_BUCKETS; $i++) { + my $key = substr($keys, $i * $DBM::Deep::BUCKET_SIZE, $DBM::Deep::HASH_SIZE); + my $subloc = unpack($DBM::Deep::LONG_PACK, substr($keys, ($i * $DBM::Deep::BUCKET_SIZE) + $DBM::Deep::HASH_SIZE, $DBM::Deep::LONG_SIZE)); + + if (!$subloc) { + ## + # Hit end of list, no match + ## + return; + } + + if ( $md5 ne $key ) { + next BUCKET; + } + + ## + # Found match -- seek to offset and read signature + ## + my $signature; + seek($fh, $subloc + $obj->_root->{file_offset}, SEEK_SET); + read( $fh, $signature, DBM::Deep->SIG_SIZE); + + ## + # If value is a hash or array, return new DBM::Deep object with correct offset + ## + if (($signature eq DBM::Deep->TYPE_HASH) || ($signature eq DBM::Deep->TYPE_ARRAY)) { + my $obj = DBM::Deep->new( + type => $signature, + base_offset => $subloc, + root => $obj->_root, + ); + + if ($obj->_root->{autobless}) { + ## + # Skip over value and plain key to see if object needs + # to be re-blessed + ## + seek($fh, $DBM::Deep::DATA_LENGTH_SIZE + $DBM::Deep::INDEX_SIZE, SEEK_CUR); + + my $size; + read( $fh, $size, $DBM::Deep::DATA_LENGTH_SIZE); $size = unpack($DBM::Deep::DATA_LENGTH_PACK, $size); + if ($size) { seek($fh, $size, SEEK_CUR); } + + my $bless_bit; + read( $fh, $bless_bit, 1); + if (ord($bless_bit)) { + ## + # Yes, object needs to be re-blessed + ## + my $class_name; + read( $fh, $size, $DBM::Deep::DATA_LENGTH_SIZE); $size = unpack($DBM::Deep::DATA_LENGTH_PACK, $size); + if ($size) { read( $fh, $class_name, $size); } + if ($class_name) { $obj = bless( $obj, $class_name ); } + } + } + + return $obj; + } + + ## + # Otherwise return actual value + ## + elsif ($signature eq DBM::Deep->SIG_DATA) { + my $size; + my $value = ''; + read( $fh, $size, $DBM::Deep::DATA_LENGTH_SIZE); $size = unpack($DBM::Deep::DATA_LENGTH_PACK, $size); + if ($size) { read( $fh, $value, $size); } + return $value; + } + + ## + # Key exists, but content is null + ## + else { return; } + } # i loop + + return; +} 1; __END__