From: rkinyon Date: Fri, 3 Mar 2006 16:02:21 +0000 (+0000) Subject: Converted as many max-buckets foreach loops to _find_in_buckets as possible ... 3... X-Git-Tag: 0-99_01~81 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=386bab6ce355d4fcbab68416b57d3f226b48435a;p=dbsrgits%2FDBM-Deep.git Converted as many max-buckets foreach loops to _find_in_buckets as possible ... 3 more to go, but they have a different setup --- diff --git a/lib/DBM/Deep.pm b/lib/DBM/Deep.pm index c6a9c4a..46f1588 100644 --- a/lib/DBM/Deep.pm +++ b/lib/DBM/Deep.pm @@ -1809,15 +1809,15 @@ built-in hashes. We use B to test the code coverage of our tests, below is the B report on this module's test suite. - ---------------------------- ------ ------ ------ ------ ------ ------ ------ - File stmt bran cond sub pod time total - ---------------------------- ------ ------ ------ ------ ------ ------ ------ - blib/lib/DBM/Deep.pm 95.1 81.6 70.3 100.0 100.0 33.4 91.0 - blib/lib/DBM/Deep/Array.pm 100.0 91.1 100.0 100.0 n/a 27.8 98.0 - blib/lib/DBM/Deep/Engine.pm 97.8 85.6 75.0 100.0 0.0 25.8 90.8 - blib/lib/DBM/Deep/Hash.pm 100.0 87.5 100.0 100.0 n/a 13.0 97.2 - Total 97.5 85.4 76.6 100.0 46.9 100.0 92.5 - ---------------------------- ------ ------ ------ ------ ------ ------ ------ + ----------------------------------- ------ ------ ------ ------ ------ ------ + File stmt bran cond sub time total + ----------------------------------- ------ ------ ------ ------ ------ ------ + blib/lib/DBM/Deep.pm 94.9 80.6 73.0 100.0 37.9 90.4 + blib/lib/DBM/Deep/Array.pm 100.0 91.1 100.0 100.0 18.2 98.1 + blib/lib/DBM/Deep/Engine.pm 98.9 87.3 80.0 100.0 34.2 95.2 + blib/lib/DBM/Deep/Hash.pm 100.0 87.5 100.0 100.0 9.7 97.3 + Total 97.9 85.9 79.7 100.0 100.0 94.3 + ----------------------------------- ------ ------ ------ ------ ------ ------ =head1 MORE INFORMATION diff --git a/lib/DBM/Deep/Engine.pm b/lib/DBM/Deep/Engine.pm index 81177e2..81a9ac1 100644 --- a/lib/DBM/Deep/Engine.pm +++ b/lib/DBM/Deep/Engine.pm @@ -275,72 +275,70 @@ sub add_bucket { my $fh = $obj->_fh; - { - my ($subloc, $offset) = $self->_find_in_buckets( $tag, $md5 ); + my ($subloc, $offset) = $self->_find_in_buckets( $tag, $md5 ); - # Updating a known md5 - if ( $subloc ) { - $result = 1; + # Updating a known md5 + if ( $subloc ) { + $result = 1; - seek($fh, $subloc + SIG_SIZE + $root->{file_offset}, SEEK_SET); - my $size; - read( $fh, $size, $self->{data_size}); - $size = unpack($self->{data_pack}, $size); + seek($fh, $subloc + SIG_SIZE + $root->{file_offset}, SEEK_SET); + my $size; + read( $fh, $size, $self->{data_size}); + $size = unpack($self->{data_pack}, $size); - ## - # If value is a hash, array, or raw value with equal or less size, we can - # reuse the same content area of the database. Otherwise, we have to create - # a new content area at the EOF. - ## - my $actual_length; - if ( $internal_ref ) { - $actual_length = $self->{long_size}; - } - else { - my $r = Scalar::Util::reftype( $value ) || ''; - if ( $r eq 'HASH' || $r eq 'ARRAY' ) { - $actual_length = $self->{index_size}; - - # if autobless is enabled, must also take into consideration - # the class name, as it is stored along with key/value. - if ( $root->{autobless} ) { - my $value_class = Scalar::Util::blessed($value); - if ( defined $value_class && !$value->isa('DBM::Deep') ) { - $actual_length += length($value_class); - } + ## + # If value is a hash, array, or raw value with equal or less size, we can + # reuse the same content area of the database. Otherwise, we have to create + # a new content area at the EOF. + ## + my $actual_length; + if ( $internal_ref ) { + $actual_length = $self->{long_size}; + } + else { + my $r = Scalar::Util::reftype( $value ) || ''; + if ( $r eq 'HASH' || $r eq 'ARRAY' ) { + $actual_length = $self->{index_size}; + + # if autobless is enabled, must also take into consideration + # the class name, as it is stored along with key/value. + if ( $root->{autobless} ) { + my $value_class = Scalar::Util::blessed($value); + if ( defined $value_class && !$value->isa('DBM::Deep') ) { + $actual_length += length($value_class); } } - else { $actual_length = length($value); } - } - - if ($actual_length <= $size) { - $location = $subloc; - } - else { - $location = $root->{end}; - seek( - $fh, - $tag->{offset} + $offset + $self->{hash_size} + $root->{file_offset}, - SEEK_SET, - ); - print( $fh pack($self->{long_pack}, $location) ); } + else { $actual_length = length($value); } } - # Adding a new md5 - elsif ( defined $offset ) { - $result = 2; - $location = $root->{end}; - seek( $fh, $tag->{offset} + $offset + $root->{file_offset}, SEEK_SET ); - print( $fh $md5 . pack($self->{long_pack}, $location) ); + if ($actual_length <= $size) { + $location = $subloc; } - # If bucket didn't fit into list, split into a new index level else { - $self->split_index( $obj, $md5, $tag ); - $location = $root->{end}; + seek( + $fh, + $tag->{offset} + $offset + $self->{hash_size} + $root->{file_offset}, + SEEK_SET, + ); + print( $fh pack($self->{long_pack}, $location) ); } } + # Adding a new md5 + elsif ( defined $offset ) { + $result = 2; + $location = $root->{end}; + + seek( $fh, $tag->{offset} + $offset + $root->{file_offset}, SEEK_SET ); + print( $fh $md5 . pack($self->{long_pack}, $location) ); + } + # If bucket didn't fit into list, split into a new index level + else { + $self->split_index( $obj, $md5, $tag ); + + $location = $root->{end}; + } ## # Seek to content area and store signature, value and plaintext key @@ -603,29 +601,11 @@ sub get_bucket_value { ## my $self = shift; my ($obj, $tag, $md5) = @_; - my $keys = $tag->{content}; - - ## - # Iterate through buckets, looking for a key match - ## - BUCKET: - for (my $i = 0; $i < $self->{max_buckets}; $i++) { - my ($key, $subloc) = $self->_get_key_subloc( $keys, $i ); - - if (!$subloc) { - ## - # Hit end of list, no match - ## - return; - } - - if ( $md5 ne $key ) { - next BUCKET; - } + my ($subloc, $offset) = $self->_find_in_buckets( $tag, $md5 ); + if ( $subloc ) { return $self->read_from_loc( $obj, $subloc ); - } # i loop - + } return; } @@ -635,38 +615,16 @@ sub delete_bucket { ## 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<$self->{max_buckets}; $i++) { - my ($key, $subloc) = $self->_get_key_subloc( $keys, $i ); - - if (!$subloc) { - ## - # Hit end of list, no match - ## - return; - } - - if ( $md5 ne $key ) { - next BUCKET; - } - - ## - # Matched key -- delete bucket and return - ## - seek($fh, $tag->{offset} + ($i * $self->{bucket_size}) + $obj->_root->{file_offset}, SEEK_SET); - print( $fh substr($keys, ($i+1) * $self->{bucket_size} ) ); + my ($subloc, $offset) = $self->_find_in_buckets( $tag, $md5 ); + if ( $subloc ) { + my $fh = $obj->_fh; + seek($fh, $tag->{offset} + $offset + $obj->_root->{file_offset}, SEEK_SET); + print( $fh substr($tag->{content}, $offset + $self->{bucket_size} ) ); print( $fh chr(0) x $self->{bucket_size} ); return 1; - } # i loop - + } return; } @@ -676,32 +634,11 @@ sub bucket_exists { ## my $self = shift; my ($obj, $tag, $md5) = @_; - my $keys = $tag->{content}; - - ## - # Iterate through buckets, looking for a key match - ## - BUCKET: - for (my $i=0; $i<$self->{max_buckets}; $i++) { - my ($key, $subloc) = $self->_get_key_subloc( $keys, $i ); - if (!$subloc) { - ## - # Hit end of list, no match - ## - return; - } - - if ( $md5 ne $key ) { - next BUCKET; - } - - ## - # Matched key -- return true - ## + my ($subloc, $offset) = $self->_find_in_buckets( $tag, $md5 ); + if ( $subloc ) { return 1; - } # i loop - + } return; }