From: rkinyon Date: Tue, 28 Feb 2006 20:14:41 +0000 (+0000) Subject: Moved find_bucket_list, traverse_index, and get_next_key to Engine X-Git-Tag: 0-99_01~109 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=6736c116ef9e98a3145a13206639ade5efe967ba;p=dbsrgits%2FDBM-Deep.git Moved find_bucket_list, traverse_index, and get_next_key to Engine --- diff --git a/lib/DBM/Deep.pm b/lib/DBM/Deep.pm index e08ba84..5e714d5 100644 --- a/lib/DBM/Deep.pm +++ b/lib/DBM/Deep.pm @@ -203,133 +203,6 @@ sub TIEARRAY { #sub DESTROY { #} -sub _find_bucket_list { - ## - # Locate offset for bucket list, given digested key - ## - my $self = shift; - my $md5 = shift; - - ## - # Locate offset for bucket list using digest index system - ## - my $ch = 0; - my $tag = $self->{engine}->load_tag($self, $self->_base_offset); - if (!$tag) { return; } - - while ($tag->{signature} ne SIG_BLIST) { - $tag = $self->{engine}->index_lookup($self, $tag, ord(substr($md5, $ch, 1))); - if (!$tag) { return; } - $ch++; - } - - return $tag; -} - -sub _traverse_index { - ## - # Scan index and recursively step into deeper levels, looking for next key. - ## - my ($self, $offset, $ch, $force_return_next) = @_; - $force_return_next = undef unless $force_return_next; - - my $tag = $self->{engine}->load_tag($self, $offset ); - - my $fh = $self->_fh; - - if ($tag->{signature} ne SIG_BLIST) { - my $content = $tag->{content}; - my $start; - if ($self->{return_next}) { $start = 0; } - else { $start = ord(substr($self->{prev_md5}, $ch, 1)); } - - for (my $index = $start; $index < 256; $index++) { - my $subloc = unpack($LONG_PACK, substr($content, $index * $LONG_SIZE, $LONG_SIZE) ); - if ($subloc) { - my $result = $self->_traverse_index( $subloc, $ch + 1, $force_return_next ); - if (defined($result)) { return $result; } - } - } # index loop - - $self->{return_next} = 1; - } # tag is an index - - elsif ($tag->{signature} eq SIG_BLIST) { - my $keys = $tag->{content}; - if ($force_return_next) { $self->{return_next} = 1; } - - ## - # Iterate through buckets, looking for a key match - ## - 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) { - ## - # End of bucket list -- return to outer loop - ## - $self->{return_next} = 1; - last; - } - elsif ($key eq $self->{prev_md5}) { - ## - # Located previous key -- return next one found - ## - $self->{return_next} = 1; - next; - } - elsif ($self->{return_next}) { - ## - # Seek to bucket location and skip over signature - ## - seek($fh, $subloc + SIG_SIZE + $self->_root->{file_offset}, SEEK_SET); - - ## - # Skip over value to get to plain key - ## - my $size; - read( $fh, $size, $DATA_LENGTH_SIZE); $size = unpack($DATA_LENGTH_PACK, $size); - if ($size) { seek($fh, $size, SEEK_CUR); } - - ## - # Read in plain key and return as scalar - ## - my $plain_key; - read( $fh, $size, $DATA_LENGTH_SIZE); $size = unpack($DATA_LENGTH_PACK, $size); - if ($size) { read( $fh, $plain_key, $size); } - - return $plain_key; - } - } # bucket loop - - $self->{return_next} = 1; - } # tag is a bucket list - - return; -} - -sub _get_next_key { - ## - # Locate next key, given digested previous one - ## - my $self = $_[0]->_get_self; - - $self->{prev_md5} = $_[1] ? $_[1] : undef; - $self->{return_next} = 0; - - ## - # If the previous key was not specifed, start at the top and - # return the first one found. - ## - if (!$self->{prev_md5}) { - $self->{prev_md5} = chr(0) x $HASH_SIZE; - $self->{return_next} = 1; - } - - return $self->_traverse_index( $self->_base_offset, 0 ); -} - sub lock { ## # If db locking is set, flock() the db file. If called multiple @@ -773,7 +646,7 @@ sub FETCH { ## $self->lock( LOCK_SH ); - my $tag = $self->_find_bucket_list( $md5 ); + my $tag = $self->{engine}->find_bucket_list( $self, $md5 ); if (!$tag) { $self->unlock(); return; @@ -808,7 +681,7 @@ sub DELETE { ## $self->lock( LOCK_EX ); - my $tag = $self->_find_bucket_list( $md5 ); + my $tag = $self->{engine}->find_bucket_list( $self, $md5 ); if (!$tag) { $self->unlock(); return; @@ -848,7 +721,7 @@ sub EXISTS { ## $self->lock( LOCK_SH ); - my $tag = $self->_find_bucket_list( $md5 ); + my $tag = $self->{engine}->find_bucket_list( $self, $md5 ); ## # For some reason, the built-in exists() function returns '' for false diff --git a/lib/DBM/Deep/Engine.pm b/lib/DBM/Deep/Engine.pm index 68d39d8..b47f58d 100644 --- a/lib/DBM/Deep/Engine.pm +++ b/lib/DBM/Deep/Engine.pm @@ -595,5 +595,134 @@ sub bucket_exists { return; } +sub find_bucket_list { + ## + # Locate offset for bucket list, given digested key + ## + my $self = shift; + my ($obj, $md5) = @_; + + ## + # Locate offset for bucket list using digest index system + ## + my $ch = 0; + my $tag = $self->load_tag($obj, $obj->_base_offset); + if (!$tag) { return; } + + while ($tag->{signature} ne DBM::Deep->SIG_BLIST) { + $tag = $self->index_lookup($obj, $tag, ord(substr($md5, $ch, 1))); + if (!$tag) { return; } + $ch++; + } + + return $tag; +} + +sub traverse_index { + ## + # Scan index and recursively step into deeper levels, looking for next key. + ## + my $self = shift; + my ($obj, $offset, $ch, $force_return_next) = @_; + $force_return_next = undef unless $force_return_next; + + my $tag = $self->load_tag($obj, $offset ); + + my $fh = $obj->_fh; + + if ($tag->{signature} ne DBM::Deep->SIG_BLIST) { + my $content = $tag->{content}; + my $start; + if ($obj->{return_next}) { $start = 0; } + else { $start = ord(substr($obj->{prev_md5}, $ch, 1)); } + + for (my $index = $start; $index < 256; $index++) { + my $subloc = unpack($DBM::Deep::LONG_PACK, substr($content, $index * $DBM::Deep::LONG_SIZE, $DBM::Deep::LONG_SIZE) ); + if ($subloc) { + my $result = $self->traverse_index( $obj, $subloc, $ch + 1, $force_return_next ); + if (defined($result)) { return $result; } + } + } # index loop + + $obj->{return_next} = 1; + } # tag is an index + + elsif ($tag->{signature} eq DBM::Deep->SIG_BLIST) { + my $keys = $tag->{content}; + if ($force_return_next) { $obj->{return_next} = 1; } + + ## + # Iterate through buckets, looking for a key match + ## + 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) { + ## + # End of bucket list -- return to outer loop + ## + $obj->{return_next} = 1; + last; + } + elsif ($key eq $obj->{prev_md5}) { + ## + # Located previous key -- return next one found + ## + $obj->{return_next} = 1; + next; + } + elsif ($obj->{return_next}) { + ## + # Seek to bucket location and skip over signature + ## + seek($fh, $subloc + DBM::Deep->SIG_SIZE + $obj->_root->{file_offset}, SEEK_SET); + + ## + # Skip over value to get to plain key + ## + 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); } + + ## + # Read in plain key and return as scalar + ## + my $plain_key; + read( $fh, $size, $DBM::Deep::DATA_LENGTH_SIZE); $size = unpack($DBM::Deep::DATA_LENGTH_PACK, $size); + if ($size) { read( $fh, $plain_key, $size); } + + return $plain_key; + } + } # bucket loop + + $obj->{return_next} = 1; + } # tag is a bucket list + + return; +} + +sub get_next_key { + ## + # Locate next key, given digested previous one + ## + my $self = shift; + my ($obj) = @_; + + $obj->{prev_md5} = $_[1] ? $_[1] : undef; + $obj->{return_next} = 0; + + ## + # If the previous key was not specifed, start at the top and + # return the first one found. + ## + if (!$obj->{prev_md5}) { + $obj->{prev_md5} = chr(0) x $DBM::Deep::HASH_SIZE; + $obj->{return_next} = 1; + } + + return $self->traverse_index( $obj, $obj->_base_offset, 0 ); +} + 1; __END__ diff --git a/lib/DBM/Deep/Hash.pm b/lib/DBM/Deep/Hash.pm index 778c7cc..bdfc0e1 100644 --- a/lib/DBM/Deep/Hash.pm +++ b/lib/DBM/Deep/Hash.pm @@ -68,7 +68,7 @@ sub FIRSTKEY { ## $self->lock( $self->LOCK_SH ); - my $result = $self->_get_next_key(); + my $result = $self->{engine}->get_next_key($self); $self->unlock(); @@ -94,7 +94,7 @@ sub NEXTKEY { ## $self->lock( $self->LOCK_SH ); - my $result = $self->_get_next_key( $prev_md5 ); + my $result = $self->{engine}->get_next_key( $self, $prev_md5 ); $self->unlock();