Can actually store more than one keyval pair at a time

diff --git a/lib/DBM/Deep/Engine3.pm b/lib/DBM/Deep/Engine3.pm
index 2d1a916..cb9fd0e 100644 (file)
--- a/lib/DBM/Deep/Engine3.pm
+++ b/lib/DBM/Deep/Engine3.pm
@@ -126,6 +126,20 @@ sub read_value {
 sub key_exists {
     my $self = shift;
     my ($trans_id, $base_offset, $key) = @_;
+
+    # This will be a Reference sector
+    my $sector = $self->_load_sector( $base_offset );
+    die "How did this fail (no sector for '$base_offset')?!\n" unless $sector;
+
+    my $key_md5 = $self->_apply_digest( $key );
+
+    # XXX What should happen if this fails?
+    my $blist = $sector->get_bucket_list({
+        key_md5 => $key_md5,
+    });
+    die "How did this fail (no blist)?!\n" unless $blist;
+
+    my $value_sector = $blist->get_data_for( $key_md5 );
 }
 
 sub delete_key {
@@ -181,7 +195,6 @@ sub setup_fh {
     # We're opening the file.
     unless ( $obj->_base_offset ) {
         my $bytes_read = $self->_read_file_header;
-        $self->_calculate_sizes;
 
         # Creating a new file
         unless ( $bytes_read ) {
@@ -209,9 +222,6 @@ sub setup_fh {
             }
         }
     }
-    else {
-        $self->_calculate_sizes;
-    }
 
     # We have to make sure we don't mess up when autoflush isn't turned on
     $self->storage->set_inode;
@@ -221,18 +231,6 @@ sub setup_fh {
 
 ################################################################################
 
-sub _calculate_sizes {
-    my $self = shift;
-
-    # The 2**8 here indicates the number of different characters in the
-    # current hashing algorithm
-    #XXX Does this need to be updated with different hashing algorithms?
-    $self->{hash_chars_used}  = (2**8);
-    $self->{index_size}       = $self->{hash_chars_used} * $self->byte_size;
-
-    return;
-}
-
 sub _write_file_header {
     my $self = shift;
 
@@ -303,52 +301,6 @@ sub _read_file_header {
     return length($buffer) + length($buffer2);
 }
 
-sub _write_tag {
-    my $self = shift;
-    my ($offset, $sig, $content) = @_;
-    my $size = length( $content );
-
-    $self->storage->print_at(
-        $offset, 
-        $sig, pack($self->{byte_pack}, $size), $content,
-    );
-
-    return unless defined $offset;
-
-    return {
-        signature => $sig,
-        start     => $offset,
-        offset    => $offset + SIG_SIZE + $self->byte_size,
-        content   => $content,
-        is_new    => 1,
-    };
-}
-
-sub _load_tag {
-    my $self = shift;
-    my ($offset) = @_;
-    my $storage = $self->storage;
-
-    my ($sig, $size) = unpack(
-        "A $self->{byte_pack}",
-        $storage->read_at( $offset, SIG_SIZE + $self->byte_size ),
-    );
-
-    return {
-        signature => $sig,
-        start     => $offset,
-        offset    => $offset + SIG_SIZE + $self->byte_size,
-        content   => $storage->read_at( undef, $size ),
-        is_new    => 0,
-    };
-}
-
-sub _tag_size {
-    my $self = shift;
-    my ($size) = @_;
-    return SIG_SIZE + $self->byte_size + $size;
-}
-
 sub _load_sector {
     my $self = shift;
     my ($offset) = @_;
@@ -398,6 +350,7 @@ sub byte_size   { $_[0]{byte_size} }
 sub hash_size   { $_[0]{hash_size} }
 sub num_txns    { $_[0]{num_txns} }
 sub max_buckets { $_[0]{max_buckets} }
+sub blank_md5   { chr(0) x $_[0]->hash_size }
 
 ################################################################################
 
@@ -575,7 +528,7 @@ sub _init {
     my $engine = $self->engine;
 
     unless ( $self->offset ) {
-        my $leftover = $self->size - 2;
+        my $leftover = $self->size - $self->base_size;
 
         $self->{offset} = $engine->storage->request_space( $self->size );
         $engine->storage->print_at( $self->offset,
@@ -588,17 +541,42 @@ sub _init {
     return $self;
 }
 
+sub base_size { 2 } # Sig + recycled counter
+
 sub size {
     my $self = shift;
     my $engine = $self->engine;
-    my $base_size = 2;                                                    # Sig + recycled counter
-    my $txn_size = $engine->byte_size;                                    # Pointer to data with magic values to indicate status
-    my $bucket_size = $engine->hash_size + $engine->num_txns * $txn_size; # Hash + txn holders
-    return $base_size + $engine->max_buckets * $bucket_size;
+    return $self->base_size + $engine->max_buckets * $self->bucket_size; # Base + numbuckets * bucketsize
+}
+
+sub bucket_size {
+    my $self = shift;
+    my $e = $self->engine;
+    my $locs_size = $e->num_txns * $e->byte_size; # Pointer to data with magic values to indicate status
+    return $e->hash_size + $locs_size;       # Hash + txn holders
 }
 
 sub has_md5 {
-    return 0;
+    my $self = shift;
+    my ($found, $idx) = $self->find_md5( @_ );
+    return $found;
+}
+
+sub find_md5 {
+    my $self = shift;
+    my ($md5) = @_;
+
+    # Make sure we don't hit the fencepost error
+    foreach my $idx ( 0 .. $self->engine->max_buckets - 1 ) {
+        my $potential = $self->engine->storage->read_at(
+            $self->offset + $self->base_size + $idx * $self->bucket_size, $self->engine->hash_size,
+        );
+
+        return (undef, $idx) if $potential eq $self->engine->blank_md5;
+        return (1, $idx) if $md5 eq $potential;
+    }
+
+    return;
 }
 
 sub write_md5 {
@@ -606,7 +584,8 @@ sub write_md5 {
     my ($md5, $value_loc) = @_;
 
     my $engine = $self->engine;
-    $engine->storage->print_at( $self->offset + 2,
+    my ($found, $idx) = $self->find_md5( $md5 );
+    $engine->storage->print_at( $self->offset + $self->base_size + $idx * $self->bucket_size,
         $md5,                                         # The actual MD5
         pack( $StP{$engine->byte_size}, $value_loc ), # The pointer to the data in the HEAD
     );
@@ -616,8 +595,10 @@ sub get_data_for {
     my $self = shift;
     my ($md5) = @_;
 
+    my ($found, $idx) = $self->find_md5( $md5 );
+    return unless $found;
     my $location = $self->engine->storage->read_at(
-        $self->offset + 2 + $self->engine->hash_size, $self->engine->byte_size,
+        $self->offset + $self->base_size + $idx * $self->bucket_size + $self->engine->hash_size, $self->engine->byte_size,
     );
     $location = unpack( $StP{$self->engine->byte_size}, $location );
     return $self->engine->_load_sector( $location );

diff --git a/t/02_hash.t b/t/02_hash.t
index cdaf0c9..da9f221 100644 (file)
--- a/t/02_hash.t
+++ b/t/02_hash.t
@@ -2,7 +2,7 @@
 # DBM::Deep Test
 ##
 use strict;
-use Test::More tests => 38;
+use Test::More tests => 41;
 use Test::Exception;
 use t::common qw( new_fh );
 
@@ -18,6 +18,7 @@ $db->{key1} = "value1";
 is( $db->get("key1"), "value1", "get() works with hash assignment" );
 is( $db->fetch("key1"), "value1", "... fetch() works with hash assignment" );
 is( $db->{key1}, "value1", "... and hash-access also works" );
+
 $db->put("key2", undef);
 is( $db->get("key2"), undef, "get() works with put()" );
 is( $db->fetch("key2"), undef, "... fetch() works with put()" );
@@ -27,6 +28,11 @@ $db->store( "key3", "value3" );
 is( $db->get("key3"), "value3", "get() works with store()" );
 is( $db->fetch("key3"), "value3", "... fetch() works with put()" );
 is( $db->{key3}, 'value3', "... and hash-access also works" );
+
+# Verify that the keyval pairs are still correct.
+is( $db->{key1}, "value1", "Key1 is still correct" );
+is( $db->{key2}, undef, "Key2 is still correct" );
+is( $db->{key3}, 'value3', "Key3 is still correct" );
 __END__
 
 ok( $db->exists("key1"), "exists() function works" );