From: rkinyon Date: Tue, 28 Feb 2006 21:55:25 +0000 (+0000) Subject: Moved all constants into DBM::Deep::Engine X-Git-Tag: 0-99_01~108 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=1bf65be7994492bbe8373ec4167915f304116a37;p=dbsrgits%2FDBM-Deep.git Moved all constants into DBM::Deep::Engine --- diff --git a/lib/DBM/Deep.pm b/lib/DBM/Deep.pm index 5e714d5..9346bb4 100644 --- a/lib/DBM/Deep.pm +++ b/lib/DBM/Deep.pm @@ -40,51 +40,6 @@ use DBM::Deep::Engine; use vars qw( $VERSION ); $VERSION = q(0.99_01); -## -# Set to 4 and 'N' for 32-bit offset tags (default). Theoretical limit of 4 GB per file. -# (Perl must be compiled with largefile support for files > 2 GB) -# -# Set to 8 and 'Q' for 64-bit offsets. Theoretical limit of 16 XB per file. -# (Perl must be compiled with largefile and 64-bit long support) -## -#my $LONG_SIZE = 4; -#my $LONG_PACK = 'N'; - -## -# Set to 4 and 'N' for 32-bit data length prefixes. Limit of 4 GB for each key/value. -# Upgrading this is possible (see above) but probably not necessary. If you need -# more than 4 GB for a single key or value, this module is really not for you :-) -## -#my $DATA_LENGTH_SIZE = 4; -#my $DATA_LENGTH_PACK = 'N'; -our ($LONG_SIZE, $LONG_PACK, $DATA_LENGTH_SIZE, $DATA_LENGTH_PACK); - -## -# Maximum number of buckets per list before another level of indexing is done. -# Increase this value for slightly greater speed, but larger database files. -# DO NOT decrease this value below 16, due to risk of recursive reindex overrun. -## -our $MAX_BUCKETS = 16; - -## -# Better not adjust anything below here, unless you're me :-) -## - -## -# Setup digest function for keys -## -our ($DIGEST_FUNC, $HASH_SIZE); -#my $DIGEST_FUNC = \&Digest::MD5::md5; - -## -# Precalculate index and bucket sizes based on values above. -## -#my $HASH_SIZE = 16; -our ($INDEX_SIZE, $BUCKET_SIZE, $BUCKET_LIST_SIZE); - -set_digest(); -#set_pack(); -#_precalc_sizes(); ## # Setup file and tag signatures. These should never change. @@ -507,46 +462,6 @@ sub _throw_error { die "DBM::Deep: $_[1]\n"; } -sub _precalc_sizes { - ## - # Precalculate index, bucket and bucket list sizes - ## - - #XXX I don't like this ... - set_pack() unless defined $LONG_SIZE; - - $INDEX_SIZE = 256 * $LONG_SIZE; - $BUCKET_SIZE = $HASH_SIZE + $LONG_SIZE; - $BUCKET_LIST_SIZE = $MAX_BUCKETS * $BUCKET_SIZE; -} - -sub set_pack { - ## - # Set pack/unpack modes (see file header for more) - ## - my ($long_s, $long_p, $data_s, $data_p) = @_; - - $LONG_SIZE = $long_s ? $long_s : 4; - $LONG_PACK = $long_p ? $long_p : 'N'; - - $DATA_LENGTH_SIZE = $data_s ? $data_s : 4; - $DATA_LENGTH_PACK = $data_p ? $data_p : 'N'; - - _precalc_sizes(); -} - -sub set_digest { - ## - # Set key digest function (default is MD5) - ## - my ($digest_func, $hash_size) = @_; - - $DIGEST_FUNC = $digest_func ? $digest_func : \&Digest::MD5::md5; - $HASH_SIZE = $hash_size ? $hash_size : 16; - - _precalc_sizes(); -} - sub _is_writable { my $fh = shift; (O_WRONLY | O_RDWR) & fcntl( $fh, F_GETFL, my $slush = 0); @@ -574,7 +489,7 @@ sub STORE { ? $self->_root->{filter_store_value}->($_[2]) : $_[2]; - my $md5 = $DIGEST_FUNC->($key); + my $md5 = $DBM::Deep::Engine::DIGEST_FUNC->($key); unless ( _is_writable( $self->_fh ) ) { $self->_throw_error( 'Cannot write to a readonly filehandle' ); @@ -592,21 +507,21 @@ sub STORE { ## my $tag = $self->{engine}->load_tag($self, $self->_base_offset); if (!$tag) { - $tag = $self->{engine}->create_tag($self, $self->_base_offset, SIG_INDEX, chr(0) x $INDEX_SIZE); + $tag = $self->{engine}->create_tag($self, $self->_base_offset, SIG_INDEX, chr(0) x $DBM::Deep::Engine::INDEX_SIZE); } my $ch = 0; while ($tag->{signature} ne SIG_BLIST) { my $num = ord(substr($md5, $ch, 1)); - my $ref_loc = $tag->{offset} + ($num * $LONG_SIZE); + my $ref_loc = $tag->{offset} + ($num * $DBM::Deep::Engine::LONG_SIZE); my $new_tag = $self->{engine}->index_lookup($self, $tag, $num); if (!$new_tag) { seek($fh, $ref_loc + $self->_root->{file_offset}, SEEK_SET); - print( $fh pack($LONG_PACK, $self->_root->{end}) ); + print( $fh pack($DBM::Deep::Engine::LONG_PACK, $self->_root->{end}) ); - $tag = $self->{engine}->create_tag($self, $self->_root->{end}, SIG_BLIST, chr(0) x $BUCKET_LIST_SIZE); + $tag = $self->{engine}->create_tag($self, $self->_root->{end}, SIG_BLIST, chr(0) x $DBM::Deep::Engine::BUCKET_LIST_SIZE); $tag->{ref_loc} = $ref_loc; $tag->{ch} = $ch; @@ -639,7 +554,7 @@ sub FETCH { my $self = shift->_get_self; my $key = shift; - my $md5 = $DIGEST_FUNC->($key); + my $md5 = $DBM::Deep::Engine::DIGEST_FUNC->($key); ## # Request shared lock for reading @@ -674,7 +589,7 @@ sub DELETE { my $self = $_[0]->_get_self; my $key = $_[1]; - my $md5 = $DIGEST_FUNC->($key); + my $md5 = $DBM::Deep::Engine::DIGEST_FUNC->($key); ## # Request exclusive lock for writing @@ -714,7 +629,7 @@ sub EXISTS { my $self = $_[0]->_get_self; my $key = $_[1]; - my $md5 = $DIGEST_FUNC->($key); + my $md5 = $DBM::Deep::Engine::DIGEST_FUNC->($key); ## # Request shared lock for reading @@ -760,7 +675,7 @@ sub CLEAR { return; } - $self->{engine}->create_tag($self, $self->_base_offset, $self->_type, chr(0) x $INDEX_SIZE); + $self->{engine}->create_tag($self, $self->_base_offset, $self->_type, chr(0) x $DBM::Deep::Engine::INDEX_SIZE); $self->unlock(); diff --git a/lib/DBM/Deep/Array.pm b/lib/DBM/Deep/Array.pm index 4c24806..0087ccc 100644 --- a/lib/DBM/Deep/Array.pm +++ b/lib/DBM/Deep/Array.pm @@ -43,7 +43,7 @@ sub FETCH { } } - $key = pack($DBM::Deep::LONG_PACK, $key); + $key = pack($DBM::Deep::Engine::LONG_PACK, $key); } my $rv = $self->SUPER::FETCH( $key ); @@ -73,7 +73,7 @@ sub STORE { } } - $key = pack($DBM::Deep::LONG_PACK, $key); + $key = pack($DBM::Deep::Engine::LONG_PACK, $key); } my $rv = $self->SUPER::STORE( $key, $value ); @@ -105,7 +105,7 @@ sub EXISTS { } } - $key = pack($DBM::Deep::LONG_PACK, $key); + $key = pack($DBM::Deep::Engine::LONG_PACK, $key); } my $rv = $self->SUPER::EXISTS( $key ); @@ -133,7 +133,7 @@ sub DELETE { } } - $key = pack($DBM::Deep::LONG_PACK, $key); + $key = pack($DBM::Deep::Engine::LONG_PACK, $key); } my $rv = $self->SUPER::DELETE( $key ); @@ -165,7 +165,7 @@ sub FETCHSIZE { $self->unlock; if ($packed_size) { - return int(unpack($DBM::Deep::LONG_PACK, $packed_size)); + return int(unpack($DBM::Deep::Engine::LONG_PACK, $packed_size)); } return 0; @@ -183,7 +183,7 @@ sub STORESIZE { my $SAVE_FILTER = $self->_root->{filter_store_value}; $self->_root->{filter_store_value} = undef; - my $result = $self->STORE('length', pack($DBM::Deep::LONG_PACK, $new_length)); + my $result = $self->STORE('length', pack($DBM::Deep::Engine::LONG_PACK, $new_length)); $self->_root->{filter_store_value} = $SAVE_FILTER; diff --git a/lib/DBM/Deep/Engine.pm b/lib/DBM/Deep/Engine.pm index b47f58d..5bf80b6 100644 --- a/lib/DBM/Deep/Engine.pm +++ b/lib/DBM/Deep/Engine.pm @@ -4,6 +4,69 @@ use strict; use Fcntl qw( :DEFAULT :flock :seek ); +## +# Set to 4 and 'N' for 32-bit offset tags (default). Theoretical limit of 4 GB per file. +# (Perl must be compiled with largefile support for files > 2 GB) +# +# Set to 8 and 'Q' for 64-bit offsets. Theoretical limit of 16 XB per file. +# (Perl must be compiled with largefile and 64-bit long support) +## +## +# Set to 4 and 'N' for 32-bit data length prefixes. Limit of 4 GB for each key/value. +# Upgrading this is possible (see above) but probably not necessary. If you need +# more than 4 GB for a single key or value, this module is really not for you :-) +## +our ($LONG_SIZE, $LONG_PACK, $DATA_LENGTH_SIZE, $DATA_LENGTH_PACK); +## +# Maximum number of buckets per list before another level of indexing is done. +# Increase this value for slightly greater speed, but larger database files. +# DO NOT decrease this value below 16, due to risk of recursive reindex overrun. +## +our $MAX_BUCKETS = 16; +our ($DIGEST_FUNC, $HASH_SIZE); +our ($INDEX_SIZE, $BUCKET_SIZE, $BUCKET_LIST_SIZE); +set_digest(); + +sub _precalc_sizes { + ## + # Precalculate index, bucket and bucket list sizes + ## + + #XXX I don't like this ... + set_pack() unless defined $LONG_SIZE; + + $INDEX_SIZE = 256 * $LONG_SIZE; + $BUCKET_SIZE = $HASH_SIZE + $LONG_SIZE; + $BUCKET_LIST_SIZE = $MAX_BUCKETS * $BUCKET_SIZE; +} + +sub set_pack { + ## + # Set pack/unpack modes (see file header for more) + ## + my ($long_s, $long_p, $data_s, $data_p) = @_; + + $LONG_SIZE = $long_s ? $long_s : 4; + $LONG_PACK = $long_p ? $long_p : 'N'; + + $DATA_LENGTH_SIZE = $data_s ? $data_s : 4; + $DATA_LENGTH_PACK = $data_p ? $data_p : 'N'; + + _precalc_sizes(); +} + +sub set_digest { + ## + # Set key digest function (default is MD5) + ## + my ($digest_func, $hash_size) = @_; + + $DIGEST_FUNC = $digest_func ? $digest_func : \&Digest::MD5::md5; + $HASH_SIZE = $hash_size ? $hash_size : 16; + + _precalc_sizes(); +} + sub open { ## # Open a fh to the database, create if nonexistent. @@ -52,10 +115,10 @@ sub open { if (!$bytes_read) { seek($fh, 0 + $obj->_root->{file_offset}, SEEK_SET); print( $fh DBM::Deep->SIG_FILE); - $self->create_tag($obj, $obj->_base_offset, $obj->_type, chr(0) x $DBM::Deep::INDEX_SIZE); + $self->create_tag($obj, $obj->_base_offset, $obj->_type, chr(0) x $INDEX_SIZE); my $plain_key = "[base]"; - print( $fh pack($DBM::Deep::DATA_LENGTH_PACK, length($plain_key)) . $plain_key ); + print( $fh pack($DATA_LENGTH_PACK, length($plain_key)) . $plain_key ); # Flush the filehandle my $old_fh = select $fh; @@ -122,16 +185,16 @@ sub create_tag { my $fh = $obj->_fh; seek($fh, $offset + $obj->_root->{file_offset}, SEEK_SET); - print( $fh $sig . pack($DBM::Deep::DATA_LENGTH_PACK, $size) . $content ); + print( $fh $sig . pack($DATA_LENGTH_PACK, $size) . $content ); if ($offset == $obj->_root->{end}) { - $obj->_root->{end} += DBM::Deep->SIG_SIZE + $DBM::Deep::DATA_LENGTH_SIZE + $size; + $obj->_root->{end} += DBM::Deep->SIG_SIZE + $DATA_LENGTH_SIZE + $size; } return { signature => $sig, size => $size, - offset => $offset + DBM::Deep->SIG_SIZE + $DBM::Deep::DATA_LENGTH_SIZE, + offset => $offset + DBM::Deep->SIG_SIZE + $DATA_LENGTH_SIZE, content => $content }; } @@ -149,8 +212,8 @@ sub load_tag { if (eof $fh) { return undef; } my $b; - read( $fh, $b, DBM::Deep->SIG_SIZE + $DBM::Deep::DATA_LENGTH_SIZE ); - my ($sig, $size) = unpack( "A $DBM::Deep::DATA_LENGTH_PACK", $b ); + read( $fh, $b, DBM::Deep->SIG_SIZE + $DATA_LENGTH_SIZE ); + my ($sig, $size) = unpack( "A $DATA_LENGTH_PACK", $b ); my $buffer; read( $fh, $buffer, $size); @@ -158,7 +221,7 @@ sub load_tag { return { signature => $sig, size => $size, - offset => $offset + DBM::Deep->SIG_SIZE + $DBM::Deep::DATA_LENGTH_SIZE, + offset => $offset + DBM::Deep->SIG_SIZE + $DATA_LENGTH_SIZE, content => $buffer }; } @@ -170,7 +233,7 @@ sub index_lookup { my $self = shift; my ($obj, $tag, $index) = @_; - my $location = unpack($DBM::Deep::LONG_PACK, substr($tag->{content}, $index * $DBM::Deep::LONG_SIZE, $DBM::Deep::LONG_SIZE) ); + my $location = unpack($LONG_PACK, substr($tag->{content}, $index * $LONG_SIZE, $LONG_SIZE) ); if (!$location) { return; } return $self->load_tag( $obj, $location ); @@ -197,8 +260,8 @@ sub add_bucket { ## # Iterate through buckets, seeing if this is a new entry or a replace. ## - for (my $i=0; $i<$DBM::Deep::MAX_BUCKETS; $i++) { - my $subloc = unpack($DBM::Deep::LONG_PACK, substr($keys, ($i * $DBM::Deep::BUCKET_SIZE) + $DBM::Deep::HASH_SIZE, $DBM::Deep::LONG_SIZE)); + for (my $i=0; $i<$MAX_BUCKETS; $i++) { + my $subloc = unpack($LONG_PACK, substr($keys, ($i * $BUCKET_SIZE) + $HASH_SIZE, $LONG_SIZE)); if (!$subloc) { ## # Found empty bucket (end of list). Populate and exit loop. @@ -209,12 +272,12 @@ sub add_bucket { ? $value->_base_offset : $root->{end}; - seek($fh, $tag->{offset} + ($i * $DBM::Deep::BUCKET_SIZE) + $root->{file_offset}, SEEK_SET); - print( $fh $md5 . pack($DBM::Deep::LONG_PACK, $location) ); + seek($fh, $tag->{offset} + ($i * $BUCKET_SIZE) + $root->{file_offset}, SEEK_SET); + print( $fh $md5 . pack($LONG_PACK, $location) ); last; } - my $key = substr($keys, $i * $DBM::Deep::BUCKET_SIZE, $DBM::Deep::HASH_SIZE); + my $key = substr($keys, $i * $BUCKET_SIZE, $HASH_SIZE); if ($md5 eq $key) { ## # Found existing bucket with same key. Replace with new value. @@ -223,14 +286,14 @@ sub add_bucket { if ($internal_ref) { $location = $value->_base_offset; - seek($fh, $tag->{offset} + ($i * $DBM::Deep::BUCKET_SIZE) + $root->{file_offset}, SEEK_SET); - print( $fh $md5 . pack($DBM::Deep::LONG_PACK, $location) ); + seek($fh, $tag->{offset} + ($i * $BUCKET_SIZE) + $root->{file_offset}, SEEK_SET); + print( $fh $md5 . pack($LONG_PACK, $location) ); return $result; } seek($fh, $subloc + DBM::Deep->SIG_SIZE + $root->{file_offset}, SEEK_SET); my $size; - read( $fh, $size, $DBM::Deep::DATA_LENGTH_SIZE); $size = unpack($DBM::Deep::DATA_LENGTH_PACK, $size); + read( $fh, $size, $DATA_LENGTH_SIZE); $size = unpack($DATA_LENGTH_PACK, $size); ## # If value is a hash, array, or raw value with equal or less size, we can @@ -240,7 +303,7 @@ sub add_bucket { my $actual_length; my $r = Scalar::Util::reftype( $value ) || ''; if ( $r eq 'HASH' || $r eq 'ARRAY' ) { - $actual_length = $DBM::Deep::INDEX_SIZE; + $actual_length = $INDEX_SIZE; # if autobless is enabled, must also take into consideration # the class name, as it is stored along with key/value. @@ -258,8 +321,8 @@ sub add_bucket { } else { $location = $root->{end}; - seek($fh, $tag->{offset} + ($i * $DBM::Deep::BUCKET_SIZE) + $DBM::Deep::HASH_SIZE + $root->{file_offset}, SEEK_SET); - print( $fh pack($DBM::Deep::LONG_PACK, $location) ); + seek($fh, $tag->{offset} + ($i * $BUCKET_SIZE) + $HASH_SIZE + $root->{file_offset}, SEEK_SET); + print( $fh pack($LONG_PACK, $location) ); } last; @@ -279,45 +342,45 @@ sub add_bucket { ## if (!$location) { seek($fh, $tag->{ref_loc} + $root->{file_offset}, SEEK_SET); - print( $fh pack($DBM::Deep::LONG_PACK, $root->{end}) ); + print( $fh pack($LONG_PACK, $root->{end}) ); - my $index_tag = $self->create_tag($obj, $root->{end}, DBM::Deep->SIG_INDEX, chr(0) x $DBM::Deep::INDEX_SIZE); + my $index_tag = $self->create_tag($obj, $root->{end}, DBM::Deep->SIG_INDEX, chr(0) x $INDEX_SIZE); my @offsets = (); - $keys .= $md5 . pack($DBM::Deep::LONG_PACK, 0); + $keys .= $md5 . pack($LONG_PACK, 0); - for (my $i=0; $i<=$DBM::Deep::MAX_BUCKETS; $i++) { - my $key = substr($keys, $i * $DBM::Deep::BUCKET_SIZE, $DBM::Deep::HASH_SIZE); + for (my $i=0; $i<=$MAX_BUCKETS; $i++) { + my $key = substr($keys, $i * $BUCKET_SIZE, $HASH_SIZE); if ($key) { - my $old_subloc = unpack($DBM::Deep::LONG_PACK, substr($keys, ($i * $DBM::Deep::BUCKET_SIZE) + - $DBM::Deep::HASH_SIZE, $DBM::Deep::LONG_SIZE)); + my $old_subloc = unpack($LONG_PACK, substr($keys, ($i * $BUCKET_SIZE) + + $HASH_SIZE, $LONG_SIZE)); my $num = ord(substr($key, $tag->{ch} + 1, 1)); if ($offsets[$num]) { - my $offset = $offsets[$num] + DBM::Deep->SIG_SIZE + $DBM::Deep::DATA_LENGTH_SIZE; + my $offset = $offsets[$num] + DBM::Deep->SIG_SIZE + $DATA_LENGTH_SIZE; seek($fh, $offset + $root->{file_offset}, SEEK_SET); my $subkeys; - read( $fh, $subkeys, $DBM::Deep::BUCKET_LIST_SIZE); + read( $fh, $subkeys, $BUCKET_LIST_SIZE); - for (my $k=0; $k<$DBM::Deep::MAX_BUCKETS; $k++) { - my $subloc = unpack($DBM::Deep::LONG_PACK, substr($subkeys, ($k * $DBM::Deep::BUCKET_SIZE) + - $DBM::Deep::HASH_SIZE, $DBM::Deep::LONG_SIZE)); + for (my $k=0; $k<$MAX_BUCKETS; $k++) { + my $subloc = unpack($LONG_PACK, substr($subkeys, ($k * $BUCKET_SIZE) + + $HASH_SIZE, $LONG_SIZE)); if (!$subloc) { - seek($fh, $offset + ($k * $DBM::Deep::BUCKET_SIZE) + $root->{file_offset}, SEEK_SET); - print( $fh $key . pack($DBM::Deep::LONG_PACK, $old_subloc || $root->{end}) ); + seek($fh, $offset + ($k * $BUCKET_SIZE) + $root->{file_offset}, SEEK_SET); + print( $fh $key . pack($LONG_PACK, $old_subloc || $root->{end}) ); last; } } # k loop } else { $offsets[$num] = $root->{end}; - seek($fh, $index_tag->{offset} + ($num * $DBM::Deep::LONG_SIZE) + $root->{file_offset}, SEEK_SET); - print( $fh pack($DBM::Deep::LONG_PACK, $root->{end}) ); + seek($fh, $index_tag->{offset} + ($num * $LONG_SIZE) + $root->{file_offset}, SEEK_SET); + print( $fh pack($LONG_PACK, $root->{end}) ); - my $blist_tag = $self->create_tag($obj, $root->{end}, DBM::Deep->SIG_BLIST, chr(0) x $DBM::Deep::BUCKET_LIST_SIZE); + my $blist_tag = $self->create_tag($obj, $root->{end}, DBM::Deep->SIG_BLIST, chr(0) x $BUCKET_LIST_SIZE); seek($fh, $blist_tag->{offset} + $root->{file_offset}, SEEK_SET); - print( $fh $key . pack($DBM::Deep::LONG_PACK, $old_subloc || $root->{end}) ); + print( $fh $key . pack($LONG_PACK, $old_subloc || $root->{end}) ); } } # key is real } # i loop @@ -338,29 +401,29 @@ sub add_bucket { my $r = Scalar::Util::reftype($value) || ''; if ($r eq 'HASH') { print( $fh DBM::Deep->TYPE_HASH ); - print( $fh pack($DBM::Deep::DATA_LENGTH_PACK, $DBM::Deep::INDEX_SIZE) . chr(0) x $DBM::Deep::INDEX_SIZE ); - $content_length = $DBM::Deep::INDEX_SIZE; + print( $fh pack($DATA_LENGTH_PACK, $INDEX_SIZE) . chr(0) x $INDEX_SIZE ); + $content_length = $INDEX_SIZE; } elsif ($r eq 'ARRAY') { print( $fh DBM::Deep->TYPE_ARRAY ); - print( $fh pack($DBM::Deep::DATA_LENGTH_PACK, $DBM::Deep::INDEX_SIZE) . chr(0) x $DBM::Deep::INDEX_SIZE ); - $content_length = $DBM::Deep::INDEX_SIZE; + print( $fh pack($DATA_LENGTH_PACK, $INDEX_SIZE) . chr(0) x $INDEX_SIZE ); + $content_length = $INDEX_SIZE; } elsif (!defined($value)) { print( $fh DBM::Deep->SIG_NULL ); - print( $fh pack($DBM::Deep::DATA_LENGTH_PACK, 0) ); + print( $fh pack($DATA_LENGTH_PACK, 0) ); $content_length = 0; } else { print( $fh DBM::Deep->SIG_DATA ); - print( $fh pack($DBM::Deep::DATA_LENGTH_PACK, length($value)) . $value ); + print( $fh pack($DATA_LENGTH_PACK, length($value)) . $value ); $content_length = length($value); } ## # Plain key is stored AFTER value, as keys are typically fetched less often. ## - print( $fh pack($DBM::Deep::DATA_LENGTH_PACK, length($plain_key)) . $plain_key ); + print( $fh pack($DATA_LENGTH_PACK, length($plain_key)) . $plain_key ); ## # If value is blessed, preserve class name @@ -372,9 +435,9 @@ sub add_bucket { # Blessed ref -- will restore later ## print( $fh chr(1) ); - print( $fh pack($DBM::Deep::DATA_LENGTH_PACK, length($value_class)) . $value_class ); + print( $fh pack($DATA_LENGTH_PACK, length($value_class)) . $value_class ); $content_length += 1; - $content_length += $DBM::Deep::DATA_LENGTH_SIZE + length($value_class); + $content_length += $DATA_LENGTH_SIZE + length($value_class); } else { print( $fh chr(0) ); @@ -387,8 +450,8 @@ sub add_bucket { ## if ($location == $root->{end}) { $root->{end} += DBM::Deep->SIG_SIZE; - $root->{end} += $DBM::Deep::DATA_LENGTH_SIZE + $content_length; - $root->{end} += $DBM::Deep::DATA_LENGTH_SIZE + length($plain_key); + $root->{end} += $DATA_LENGTH_SIZE + $content_length; + $root->{end} += $DATA_LENGTH_SIZE + length($plain_key); } ## @@ -438,9 +501,9 @@ sub get_bucket_value { # 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)); + 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) { ## @@ -475,10 +538,10 @@ sub get_bucket_value { # 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); + seek($fh, $DATA_LENGTH_SIZE + $INDEX_SIZE, SEEK_CUR); my $size; - read( $fh, $size, $DBM::Deep::DATA_LENGTH_SIZE); $size = unpack($DBM::Deep::DATA_LENGTH_PACK, $size); + read( $fh, $size, $DATA_LENGTH_SIZE); $size = unpack($DATA_LENGTH_PACK, $size); if ($size) { seek($fh, $size, SEEK_CUR); } my $bless_bit; @@ -488,7 +551,7 @@ sub get_bucket_value { # 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); + 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 ); } } @@ -503,7 +566,7 @@ sub get_bucket_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); + read( $fh, $size, $DATA_LENGTH_SIZE); $size = unpack($DATA_LENGTH_PACK, $size); if ($size) { read( $fh, $value, $size); } return $value; } @@ -531,9 +594,9 @@ sub delete_bucket { # 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)); + 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) { ## @@ -549,9 +612,9 @@ sub delete_bucket { ## # Matched key -- delete bucket and return ## - seek($fh, $tag->{offset} + ($i * $DBM::Deep::BUCKET_SIZE) + $obj->_root->{file_offset}, SEEK_SET); - print( $fh substr($keys, ($i+1) * $DBM::Deep::BUCKET_SIZE ) ); - print( $fh chr(0) x $DBM::Deep::BUCKET_SIZE ); + seek($fh, $tag->{offset} + ($i * $BUCKET_SIZE) + $obj->_root->{file_offset}, SEEK_SET); + print( $fh substr($keys, ($i+1) * $BUCKET_SIZE ) ); + print( $fh chr(0) x $BUCKET_SIZE ); return 1; } # i loop @@ -571,9 +634,9 @@ sub bucket_exists { # 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)); + 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) { ## @@ -637,7 +700,7 @@ sub traverse_index { 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) ); + my $subloc = unpack($LONG_PACK, substr($content, $index * $LONG_SIZE, $LONG_SIZE) ); if ($subloc) { my $result = $self->traverse_index( $obj, $subloc, $ch + 1, $force_return_next ); if (defined($result)) { return $result; } @@ -654,9 +717,9 @@ sub traverse_index { ## # 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)); + 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) { ## @@ -682,14 +745,14 @@ sub traverse_index { # 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); + 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, $DBM::Deep::DATA_LENGTH_SIZE); $size = unpack($DBM::Deep::DATA_LENGTH_PACK, $size); + read( $fh, $size, $DATA_LENGTH_SIZE); $size = unpack($DATA_LENGTH_PACK, $size); if ($size) { read( $fh, $plain_key, $size); } return $plain_key; @@ -717,7 +780,7 @@ sub get_next_key { # return the first one found. ## if (!$obj->{prev_md5}) { - $obj->{prev_md5} = chr(0) x $DBM::Deep::HASH_SIZE; + $obj->{prev_md5} = chr(0) x $HASH_SIZE; $obj->{return_next} = 1; } diff --git a/lib/DBM/Deep/Hash.pm b/lib/DBM/Deep/Hash.pm index bdfc0e1..12b9005 100644 --- a/lib/DBM/Deep/Hash.pm +++ b/lib/DBM/Deep/Hash.pm @@ -87,7 +87,7 @@ sub NEXTKEY { ? $self->_root->{filter_store_key}->($_[1]) : $_[1]; - my $prev_md5 = $DBM::Deep::DIGEST_FUNC->($prev_key); + my $prev_md5 = $DBM::Deep::Engine::DIGEST_FUNC->($prev_key); ## # Request shared lock for reading diff --git a/t/13_setpack.t b/t/13_setpack.t index f442f7b..4ab5537 100644 --- a/t/13_setpack.t +++ b/t/13_setpack.t @@ -19,7 +19,7 @@ undef $db; ## # set pack to 2-byte (16-bit) words ## -DBM::Deep::set_pack(2, 'S'); +DBM::Deep::Engine::set_pack(2, 'S'); unlink "t/test.db"; $db = DBM::Deep->new( diff --git a/t/15_digest.t b/t/15_digest.t index 1f3704e..15f9c67 100644 --- a/t/15_digest.t +++ b/t/15_digest.t @@ -20,7 +20,7 @@ my $db = new DBM::Deep( ## # Set digest handler ## -DBM::Deep::set_digest( \&my_digest, 8 ); +DBM::Deep::Engine::set_digest( \&my_digest, 8 ); ## # put/get key