r14236@Rob-Kinyons-PowerBook: rob | 2006-06-14 23:07:31 -0400

 Engine2 kinda works ...

diff --git a/lib/DBM/Deep.pm b/lib/DBM/Deep.pm
index 97a592f..a8a405f 100644 (file)
--- a/lib/DBM/Deep.pm
+++ b/lib/DBM/Deep.pm
@@ -43,14 +43,14 @@ use Digest::MD5 ();
 use FileHandle::Fmode ();
 use Scalar::Util ();
 
-use DBM::Deep::Engine;
+use DBM::Deep::Engine2;
 use DBM::Deep::File;
 
 ##
 # Setup constants for users to pass to new()
 ##
-sub TYPE_HASH   () { DBM::Deep::Engine->SIG_HASH  }
-sub TYPE_ARRAY  () { DBM::Deep::Engine->SIG_ARRAY }
+sub TYPE_HASH   () { DBM::Deep::Engine2->SIG_HASH  }
+sub TYPE_ARRAY  () { DBM::Deep::Engine2->SIG_ARRAY }
 
 sub _get_args {
     my $proto = shift;
@@ -124,7 +124,7 @@ sub _init {
 
         storage     => undef,
     }, $class;
-    $self->{engine} = DBM::Deep::Engine->new( { %{$args}, obj => $self } );
+    $self->{engine} = DBM::Deep::Engine2->new( { %{$args}, obj => $self } );
 
     # Grab the parameters we want to use
     foreach my $param ( keys %$self ) {

diff --git a/lib/DBM/Deep/Engine.pm b/lib/DBM/Deep/Engine.pm
index c430e6d..b581a1b 100644 (file)
--- a/lib/DBM/Deep/Engine.pm
+++ b/lib/DBM/Deep/Engine.pm
@@ -3,7 +3,6 @@ package DBM::Deep::Engine;
 use 5.6.0;
 
 use strict;
-use warnings;
 
 our $VERSION = q(0.99_03);
 
@@ -501,7 +500,7 @@ sub add_bucket {
 
 sub _write_value {
     my $self = shift;
-    my ($location, $key, $value, $orig_key) = @_;
+    my ($key_loc, $location, $key, $value, $orig_key) = @_;
 
     my $storage = $self->_storage;
 
@@ -568,7 +567,7 @@ sub _write_value {
     if ($r eq 'HASH') {
         my %x = %$value;
         tie %$value, 'DBM::Deep', {
-            base_offset => $location,
+            base_offset => $key_loc,
             storage     => $storage,
             parent      => $self->{obj},
             parent_key  => $orig_key,
@@ -579,7 +578,7 @@ sub _write_value {
     elsif ($r eq 'ARRAY') {
         my @x = @$value;
         tie @$value, 'DBM::Deep', {
-            base_offset => $location,
+            base_offset => $key_loc,
             storage     => $storage,
             parent      => $self->{obj},
             parent_key  => $orig_key,
@@ -668,7 +667,7 @@ sub split_index {
 
 sub read_from_loc {
     my $self = shift;
-    my ($subloc, $orig_key) = @_;
+    my ($key_loc, $subloc, $orig_key) = @_;
 
     my $storage = $self->_storage;
 
@@ -706,7 +705,7 @@ sub read_from_loc {
 
         my $new_obj = DBM::Deep->new({
             type        => $signature,
-            base_offset => $subloc,
+            base_offset => $key_loc,
             storage     => $self->_storage,
             parent      => $self->{obj},
             parent_key  => $orig_key,
@@ -745,7 +744,7 @@ sub read_from_loc {
         if ( $size ) {
             my $new_loc = $storage->read_at( undef, $size );
             $new_loc = unpack( $self->{long_pack}, $new_loc ); 
-            return $self->read_from_loc( $new_loc, $orig_key );
+            return $self->read_from_loc( $key_loc, $new_loc, $orig_key );
         }
         else {
             return;

diff --git a/lib/DBM/Deep/Engine2.pm b/lib/DBM/Deep/Engine2.pm
index bdeb0f1..73ba609 100644 (file)
--- a/lib/DBM/Deep/Engine2.pm
+++ b/lib/DBM/Deep/Engine2.pm
@@ -62,6 +62,7 @@ sub read_value {
     die "Internal error!" if !$val_offset;
 
     return $self->_read_value({
+        keyloc => $key_offset,
         offset => $val_offset,
     });
 }
@@ -82,7 +83,7 @@ sub key_exists {
         offset  => $_val_offset,
         key_md5 => $self->_apply_digest( $key ),
     });
-    return if !$key_offset;
+    return '' if !$key_offset;
 
     my ($val_offset, $is_del) = $self->_find_value_offset({
         offset     => $key_offset,
@@ -90,22 +91,30 @@ sub key_exists {
         allow_head => 1,
     });
 
-    return 1 if $is_del;
+    return '' if $is_del;
 
     die "Internal error!" if !$_val_offset;
-    return '';
+    return 1;
 }
 
 sub get_next_key {
     my $self = shift;
-    my ($offset) = @_;
+    my ($trans_id, $base_offset) = @_;
+
+    my ($_val_offset, $_is_del) = $self->_find_value_offset({
+        offset     => $base_offset,
+        trans_id   => $trans_id,
+        allow_head => 1,
+    });
+    die "Attempt to use a deleted value" if $_is_del;
+    die "Internal error!" if !$_val_offset;
 
     # If the previous key was not specifed, start at the top and
     # return the first one found.
     my $temp;
-    if ( @_ > 1 ) {
+    if ( @_ > 2 ) {
         $temp = {
-            prev_md5    => $self->apply_digest($_[1]),
+            prev_md5    => $self->_apply_digest($_[2]),
             return_next => 0,
         };
     }
@@ -116,7 +125,7 @@ sub get_next_key {
         };
     }
 
-    return $self->traverse_index( $temp, $offset, 0 );
+    return $self->traverse_index( $temp, $_val_offset, 0 );
 }
 
 sub delete_key {
@@ -139,6 +148,7 @@ sub delete_key {
 
     my $key_tag = $self->load_tag( $key_offset );
 
+    my $value = $self->read_value( $trans_id, $base_offset, $key );
     if ( $trans_id ) {
         $self->_mark_as_deleted({
             tag      => $key_tag,
@@ -146,7 +156,6 @@ sub delete_key {
         });
     }
     else {
-        my $value = $self->read_value( $trans_id, $base_offset, $key );
         if ( my @transactions = $self->_storage->current_transactions ) {
             foreach my $other_trans_id ( @transactions ) {
                 next if $self->_has_keyloc_entry({
@@ -156,15 +165,18 @@ sub delete_key {
                 $self->write_value( $other_trans_id, $base_offset, $key, $value );
             }
         }
-        else {
-            $self->_remove_key_offset({
-                offset  => $_val_offset,
-                key_md5 => $self->_apply_digest( $key ),
-            });
-        }
+
+        $self->_mark_as_deleted({
+            tag      => $key_tag,
+            trans_id => $trans_id,
+        });
+#        $self->_remove_key_offset({
+#            offset  => $_val_offset,
+#            key_md5 => $self->_apply_digest( $key ),
+#        });
     }
 
-    return 1;
+    return $value;
 }
 
 sub write_value {
@@ -237,7 +249,7 @@ sub write_value {
         loc      => $value_loc,
     });
 
-    $self->_write_value( $value_loc, $key, $value, $key );
+    $self->_write_value( $key_offset, $value_loc, $key, $value, $key );
 
     return 1;
 }
@@ -246,8 +258,6 @@ sub _find_value_offset {
     my $self = shift;
     my ($args) = @_;
 
-    use Data::Dumper;warn Dumper $args;
-
     my $key_tag = $self->load_tag( $args->{offset} );
 
     my @head;
@@ -269,7 +279,6 @@ sub _find_value_offset {
     return;
 }
 
-#XXX Need to keep track of $bucket_tag->(ref_loc} and $bucket_tag->{ch}
 sub _find_key_offset {
     my $self = shift;
     my ($args) = @_;
@@ -378,7 +387,7 @@ sub _read_value {
     my $self = shift;
     my ($args) = @_;
 
-    return $self->read_from_loc( $args->{offset} );
+    return $self->read_from_loc( $args->{keyloc}, $args->{offset} );
 }
 
 sub _mark_as_deleted {
@@ -392,12 +401,15 @@ sub _mark_as_deleted {
             substr( $args->{tag}{content}, $i * $self->{key_size}, $self->{key_size} ),
         );
 
+        last unless $loc || $is_deleted;
 
         if ( $trans_id == $args->{trans_id} ) {
             substr( $args->{tag}{content}, $i * $self->{key_size}, $self->{key_size} ) = pack(
                 "$self->{long_pack} C C",
                 $loc, $trans_id, 1,
             );
+            $is_changed = 1;
+            last;
         }
     }
 
@@ -519,8 +531,8 @@ sub setup_fh {
 
             $self->write_tag(
                 $obj->{base_offset}, SIG_KEYS,
-                pack( "$self->{long_pack} C C", $obj->{base_offset}, 0, 0 ),
-                chr(0) x ($self->{index_size} - $self->{long_size} + 2),
+                pack( "$self->{long_pack} C C", $value_spot, HEAD, 0 ),
+                chr(0) x ($self->{index_size} - $self->{key_size}),
             );
 
             $self->write_tag(
@@ -536,10 +548,18 @@ sub setup_fh {
         else {
             $obj->{base_offset} = $bytes_read;
 
+            my ($_val_offset, $_is_del) = $self->_find_value_offset({
+                offset     => $obj->{base_offset},
+                trans_id   => HEAD,
+                allow_head => 1,
+            });
+            die "Attempt to use a deleted value" if $_is_del;
+            die "Internal error!" if !$_val_offset;
+
             ##
             # Get our type from master index header
             ##
-            my $tag = $self->load_tag($obj->_base_offset);
+            my $tag = $self->load_tag($_val_offset);
             unless ( $tag ) {
                 flock $fh, LOCK_UN;
                 $self->_throw_error("Corrupted file, no master index record");

diff --git a/lib/DBM/Deep/Hash.pm b/lib/DBM/Deep/Hash.pm
index 9ce962a..b593ed4 100644 (file)
--- a/lib/DBM/Deep/Hash.pm
+++ b/lib/DBM/Deep/Hash.pm
@@ -5,6 +5,8 @@ use 5.6.0;
 use strict;
 use warnings;
 
+use constant DEBUG => 0;
+
 our $VERSION = q(0.99_03);
 
 use base 'DBM::Deep';
@@ -45,6 +47,7 @@ sub TIEHASH {
 }
 
 sub FETCH {
+    print "FETCH( @_ )\n" if DEBUG;
     my $self = shift->_get_self;
     my $key = ($self->_storage->{filter_store_key})
         ? $self->_storage->{filter_store_key}->($_[0])
@@ -54,6 +57,7 @@ sub FETCH {
 }
 
 sub STORE {
+    print "STORE( @_ )\n" if DEBUG;
     my $self = shift->_get_self;
        my $key = ($self->_storage->{filter_store_key})
         ? $self->_storage->{filter_store_key}->($_[0])
@@ -64,6 +68,7 @@ sub STORE {
 }
 
 sub EXISTS {
+    print "EXISTS( @_ )\n" if DEBUG;
     my $self = shift->_get_self;
        my $key = ($self->_storage->{filter_store_key})
         ? $self->_storage->{filter_store_key}->($_[0])
@@ -82,6 +87,7 @@ sub DELETE {
 }
 
 sub FIRSTKEY {
+    print "FIRSTKEY\n" if DEBUG;
        ##
        # Locate and return first key (in no particular order)
        ##
@@ -102,6 +108,7 @@ sub FIRSTKEY {
 }
 
 sub NEXTKEY {
+    print "NEXTKEY( @_ )\n" if DEBUG;
        ##
        # Return next key (in no particular order), given previous one
        ##

diff --git a/t/02_hash.t b/t/02_hash.t
index 0bd49a7..10e9e5d 100644 (file)
--- a/t/02_hash.t
+++ b/t/02_hash.t
@@ -131,5 +131,5 @@ ok(
 # Test autovivification
 
 $db->{unknown}{bar} = 1;
-ok( $db->{unknown} );
-cmp_ok( $db->{unknown}{bar}, '==', 1 );
+ok( $db->{unknown}, 'Autovivified value exists' );
+cmp_ok( $db->{unknown}{bar}, '==', 1, 'And the value stored is there' );