From: rkinyon <rkinyon@50811bd7-b8ce-0310-adc1-d9db26280581>
Date: Mon, 27 Nov 2006 05:38:40 +0000 (+0000)
Subject: Got a store and a retrieve working
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=3976d8c98e961938dfa9ab314eb68a954f93270e;p=dbsrgits%2FDBM-Deep.git

Got a store and a retrieve working
---

diff --git a/lib/DBM/Deep/Engine3.pm b/lib/DBM/Deep/Engine3.pm
index bef1d7c..f817897 100644
--- a/lib/DBM/Deep/Engine3.pm
+++ b/lib/DBM/Deep/Engine3.pm
@@ -51,6 +51,7 @@ sub new {
         digest      => undef,
         hash_size   => 16, # In bytes
         max_buckets => 16,
+        num_txns    => 16, # HEAD plus 15 running txns
 
         storage => undef,
         obj     => undef,
@@ -104,6 +105,22 @@ sub new {
 sub read_value {
     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 );
+
+    return $value_sector->data;
 }
 
 sub key_exists {
@@ -119,6 +136,26 @@ sub delete_key {
 sub write_value {
     my $self = shift;
     my ($trans_id, $base_offset, $key, $value) = @_;
+
+    # 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,
+        create  => 1,
+    });
+    die "How did this fail (no blist)?!\n" unless $blist;
+
+    my $value_sector = DBM::Deep::Engine::Sector::Scalar->new({
+        engine => $self,
+        data   => $value,
+    });
+
+    $blist->write_md5( $key_md5, $value_sector->offset );
 }
 
 sub get_next_key {
@@ -134,7 +171,6 @@ sub setup_fh {
 
     # We're opening the file.
     unless ( $obj->_base_offset ) {
-        print "1\n";
         my $bytes_read = $self->_read_file_header;
         $self->_calculate_sizes;
 
@@ -185,11 +221,6 @@ sub _calculate_sizes {
     $self->{hash_chars_used}  = (2**8);
     $self->{index_size}       = $self->{hash_chars_used} * $self->byte_size;
 
-    $self->{bucket_size}      = $self->{hash_size} + $self->byte_size * 2;
-    $self->{bucket_list_size} = $self->{max_buckets} * $self->{bucket_size};
-
-    $self->{data_size}        = 256; # In bytes
-
     return;
 }
 
@@ -209,7 +240,7 @@ sub _write_file_header {
         # --- Above is $header_fixed. Below is $header_var
         pack('N4', 0, 0, 0, 0),  # currently running transaction IDs
         pack('n', $self->byte_size),
-        pack('n', $self->{max_buckets}),
+        pack('n', $self->max_buckets),
     );
 
     $self->storage->set_transaction_offset( 13 );
@@ -309,55 +340,239 @@ sub _tag_size {
     return SIG_SIZE + $self->byte_size + $size;
 }
 
+sub _load_sector {
+    my $self = shift;
+    my ($offset) = @_;
+
+    my $type = $self->storage->read_at( $offset, 1 );
+    if ( $type eq $self->SIG_ARRAY || $type eq $self->SIG_HASH ) {
+        return DBM::Deep::Engine::Sector::Reference->new({
+            engine => $self,
+            type   => $type,
+            offset => $offset,
+        });
+    }
+    elsif ( $type eq $self->SIG_BLIST ) {
+        return DBM::Deep::Engine::Sector::BucketList->new({
+            engine => $self,
+            type   => $type,
+            offset => $offset,
+        });
+    }
+
+    die "Don't know what to do with type '$type' at offset '$offset'\n";
+}
+
+sub _apply_digest {
+    my $self = shift;
+    return $self->{digest}->(@_);
+}
+
 ################################################################################
 
-sub storage { $_[0]{storage} }
-sub byte_size { $_[0]{byte_size} }
+sub storage     { $_[0]{storage} }
+sub byte_size   { $_[0]{byte_size} }
+sub hash_size   { $_[0]{hash_size} }
+sub num_txns    { $_[0]{num_txns} }
+sub max_buckets { $_[0]{max_buckets} }
 
 ################################################################################
 
-package DBM::Deep::Engine::Sector::Reference;
+package DBM::Deep::Engine::Sector;
+
+sub new {
+    my $self = bless $_[1], $_[0];
+    Scalar::Util::weaken( $self->{engine} );
+    $self->_init;
+    return $self;
+}
+sub _init {}
+
+sub engine { $_[0]{engine} }
+sub offset { $_[0]{offset} }
+sub type   { $_[0]{type} }
+
+
+package DBM::Deep::Engine::Sector::Data;
 
 our @ISA = qw( DBM::Deep::Engine::Sector );
 
+# This is in bytes
+sub size { return 256 }
+
+package DBM::Deep::Engine::Sector::Scalar;
+
+our @ISA = qw( DBM::Deep::Engine::Sector::Data );
+
+sub type { $_[0]{engine}->SIG_DATA }
 sub _init {
     my $self = shift;
 
     my $engine = $self->engine;
 
-    my $leftover = $self->size - 3 - 2 * $engine->byte_size;
-
-    my $offset = $engine->storage->request_space( $self->size );
-    $engine->storage->print_at( $offset,
-        $self->type,
-        pack( $StP{1}, 0 ),                  # Recycled counter
-        pack( $StP{$engine->byte_size}, 0 ), # Chain loc
-        pack( $StP{$engine->byte_size}, 0 ), # Index/BList loc
-        pack( $StP{1}, 0 ),                  # Blessedness
-        pack( $StP{1}, 0 ),                  # Classname length
-        chr(0) x $leftover,                  # Zero-fill the data
+    unless ( $self->offset ) {
+        my $leftover = $self->size - 3 - 1 * $engine->byte_size;
+
+        my $data = delete $self->{data};
+
+        # XXX Need to build in chaining
+        $leftover -= length( $data );
+
+        $self->{offset} = $engine->storage->request_space( $self->size );
+        $engine->storage->print_at( $self->offset,
+            $self->type,                          # Sector type
+            pack( $StP{1}, 0 ),                   # Recycled counter
+            pack( $StP{$engine->byte_size}, 0 ),  # Chain loc
+            pack( $StP{1}, length($data) ),       # Data length
+            $data,                                # Data to be stored
+            chr(0) x $leftover,                   # Zero-fill the rest
+        );
+
+        return;
+    }
+}
+
+sub data_length {
+    my $self = shift;
+
+    my $data_len = $self->engine->storage->read_at(
+        $self->offset + 2 + $self->engine->byte_size, 1
     );
+    return unpack( $StP{1}, $data_len );
+}
+
+sub data {
+    my $self = shift;
 
-    return $offset;
+    return $self->engine->storage->read_at(
+        $self->offset + 2 + $self->engine->byte_size + 1, $self->data_length,
+    );
 }
 
-sub type { $_[0]{type} }
+package DBM::Deep::Engine::Sector::Reference;
 
-package DBM::Deep::Engine::Sector;
+our @ISA = qw( DBM::Deep::Engine::Sector::Data );
+
+sub _init {
+    my $self = shift;
+
+    my $engine = $self->engine;
+
+    unless ( $self->offset ) {
+        my $leftover = $self->size - 4 - 2 * $engine->byte_size;
+
+        $self->{offset} = $engine->storage->request_space( $self->size );
+        $engine->storage->print_at( $self->offset,
+            $self->type,                         # Sector type
+            pack( $StP{1}, 0 ),                  # Recycled counter
+            pack( $StP{$engine->byte_size}, 0 ), # Chain loc
+            pack( $StP{$engine->byte_size}, 0 ), # Index/BList loc
+            pack( $StP{1}, 0 ),                  # Blessedness
+            pack( $StP{1}, 0 ),                  # Classname length
+            chr(0) x $leftover,                  # Zero-fill the data
+        );
+
+        return;
+    }
+}
+
+sub get_blist_loc {
+    my $self = shift;
+
+    my $engine = $self->engine;
+    my $blist_loc = $engine->storage->read_at( $self->offset + 2 + $engine->byte_size, $engine->byte_size );
+    return unpack( $StP{$engine->byte_size}, $blist_loc );
+}
+
+sub get_bucket_list {
+    my $self = shift;
+    my ($args) = @_;
+
+    # XXX Add in check here for recycling?
+
+    my $engine = $self->engine;
+
+    my $blist_loc = $self->get_blist_loc;
+
+    # There's no index or blist yet
+    unless ( $blist_loc ) {
+        return unless $args->{create};
+
+        my $blist = DBM::Deep::Engine::Sector::BucketList->new({
+            engine => $engine,
+        });
+        $engine->storage->print_at( $self->offset + 2 + $engine->byte_size,
+            pack( $StP{$engine->byte_size}, $blist->offset ),
+        );
+        return $blist;
+    }
+
+    return DBM::Deep::Engine::Sector::BucketList->new({
+        engine => $engine,
+        offset => $blist_loc,
+    });
+}
+
+package DBM::Deep::Engine::Sector::BucketList;
+
+our @ISA = qw( DBM::Deep::Engine::Sector );
+
+sub _init {
+    my $self = shift;
+
+    my $engine = $self->engine;
+
+    unless ( $self->offset ) {
+        my $leftover = $self->size - 2;
+
+        $self->{offset} = $engine->storage->request_space( $self->size );
+        $engine->storage->print_at( $self->offset,
+            $engine->SIG_BLIST, # Sector type
+            pack( $StP{1}, 0 ), # Recycled counter
+            chr(0) x $leftover, # Zero-fill the data
+        );
+    }
 
-sub new {
-    my $self = bless $_[1], $_[0];
-    Scalar::Util::weaken( $self->{engine} );
-    $self->{offset} = $self->_init;
     return $self;
 }
-sub _init {}
 
-sub engine { $_[0]{engine} }
-sub offset { $_[0]{offset} }
+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;
+}
 
-# This is in bytes
-sub size { return 256 }
+sub has_md5 {
+    return 0;
+}
+
+sub write_md5 {
+    my $self = shift;
+    my ($md5, $value_loc) = @_;
+
+    my $engine = $self->engine;
+    $engine->storage->print_at( $self->offset + 2,
+        $md5,                                         # The actual MD5
+        pack( $StP{$engine->byte_size}, $value_loc ), # The pointer to the data in the HEAD
+    );
+}
+
+sub get_data_for {
+    my $self = shift;
+    my ($md5) = @_;
+
+    my $location = $self->engine->storage->read_at(
+        $self->offset + 2 + $self->engine->hash_size, $self->engine->byte_size,
+    );
+    $location = unpack( $StP{$self->engine->byte_size}, $location );
+    return DBM::Deep::Engine::Sector::Scalar->new({
+        engine => $self->engine,
+        offset => $location,
+    });
+}
 
 1;
 __END__
diff --git a/t/02_hash.t b/t/02_hash.t
index 10e9e5d..a71273f 100644
--- a/t/02_hash.t
+++ b/t/02_hash.t
@@ -16,6 +16,7 @@ my $db = DBM::Deep->new( $filename );
 ##
 $db->{key1} = "value1";
 is( $db->get("key1"), "value1", "get() works with hash assignment" );
+__END__
 is( $db->fetch("key1"), "value1", "... fetch() works with hash assignment" );
 is( $db->{key1}, "value1", "... and hash-access also works" );
 $db->put("key2", undef);