The engine object is now a singleton in preparation for transactions being hoisted...

diff --git a/lib/DBM/Deep.pm b/lib/DBM/Deep.pm
index 683d6f9..7d9801c 100644 (file)
--- a/lib/DBM/Deep.pm
+++ b/lib/DBM/Deep.pm
@@ -124,8 +124,11 @@ sub _init {
         parent_key  => undef,
 
         storage     => undef,
+        engine      => undef,
     }, $class;
-    $self->{engine} = DBM::Deep::Engine3->new( { %{$args}, obj => $self } );
+
+    $args->{engine} = DBM::Deep::Engine3->new( { %{$args}, obj => $self } )
+        unless exists $args->{engine};
 
     # Grab the parameters we want to use
     foreach my $param ( keys %$self ) {
@@ -218,7 +221,7 @@ sub export {
     $self->_copy_node( $temp );
     $self->unlock();
 
-    my $classname = $self->_engine->get_classname( $self->_storage->transaction_id, $self->_base_offset );
+    my $classname = $self->_engine->get_classname( $self );
     if ( defined $classname ) {
       bless $temp, $classname;
     }
@@ -325,6 +328,7 @@ sub clone {
         type        => $self->_type,
         base_offset => $self->_base_offset,
         storage     => $self->_storage,
+        engine      => $self->_engine,
         parent      => $self->{parent},
         parent_key  => $self->{parent_key},
     );
@@ -357,17 +361,17 @@ sub clone {
 
 sub begin_work {
     my $self = shift->_get_self;
-    return $self->_storage->begin_transaction;
+    return $self->_engine->begin_transaction( $self, @_ );
 }
 
 sub rollback {
     my $self = shift->_get_self;
-    return $self->_storage->end_transaction;
+    return $self->_engine->end_transaction( $self, @_ );
 }
 
 sub commit {
     my $self = shift->_get_self;
-    return $self->_storage->commit_transaction;
+    return $self->_engine->commit_transaction( $self, @_ );
 }
 
 ##
@@ -498,7 +502,7 @@ sub STORE {
         $value = $self->_storage->{filter_store_value}->( $value );
     }
 
-    $self->_engine->write_value( $self->_storage->transaction_id, $self->_base_offset, $key, $value, $orig_key );
+    $self->_engine->write_value( $self, $key, $value, $orig_key );
 
     $self->unlock();
 
@@ -518,7 +522,7 @@ sub FETCH {
     ##
     $self->lock( LOCK_SH );
 
-    my $result = $self->_engine->read_value( $self->_storage->transaction_id, $self->_base_offset, $key, $orig_key );
+    my $result = $self->_engine->read_value( $self, $key, $orig_key );
 
     $self->unlock();
 
@@ -559,7 +563,7 @@ sub DELETE {
     ##
     # Delete bucket
     ##
-    my $value = $self->_engine->delete_key( $self->_storage->transaction_id, $self->_base_offset, $key, $orig_key );
+    my $value = $self->_engine->delete_key( $self, $key, $orig_key );
 
     if (defined $value && !ref($value) && $self->_storage->{filter_fetch_value}) {
         $value = $self->_storage->{filter_fetch_value}->($value);
@@ -582,7 +586,7 @@ sub EXISTS {
     ##
     $self->lock( LOCK_SH );
 
-    my $result = $self->_engine->key_exists( $self->_storage->transaction_id, $self->_base_offset, $key );
+    my $result = $self->_engine->key_exists( $self, $key );
 
     $self->unlock();
 
@@ -622,14 +626,14 @@ sub CLEAR {
         while ( $key ) {
             # Retrieve the key before deleting because we depend on next_key
             my $next_key = $self->next_key( $key );
-            $self->_engine->delete_key( $self->_storage->transaction_id, $self->_base_offset, $key, $key );
+            $self->_engine->delete_key( $self, $key, $key );
             $key = $next_key;
         }
     }
     else {
         my $size = $self->FETCHSIZE;
         for my $key ( 0 .. $size - 1 ) {
-            $self->_engine->delete_key( $self->_storage->transaction_id, $self->_base_offset, $key, $key );
+            $self->_engine->delete_key( $self, $key, $key );
         }
         $self->STORESIZE( 0 );
     }

diff --git a/lib/DBM/Deep/Engine3.pm b/lib/DBM/Deep/Engine3.pm
index 7e444ff..48220fc 100644 (file)
--- a/lib/DBM/Deep/Engine3.pm
+++ b/lib/DBM/Deep/Engine3.pm
@@ -5,7 +5,6 @@ use 5.6.0;
 use strict;
 
 our $VERSION = q(0.99_03);
-our $DEBUG = 0;
 
 use Scalar::Util ();
 
@@ -52,7 +51,6 @@ sub new {
         num_txns    => 16, # HEAD plus 15 running txns
 
         storage => undef,
-        obj     => undef,
     }, $class;
 
     if ( defined $args->{pack_size} ) {
@@ -75,7 +73,6 @@ sub new {
         next unless exists $args->{$param};
         $self->{$param} = $args->{$param};
     }
-    Scalar::Util::weaken( $self->{obj} ) if $self->{obj};
 
     $self->{byte_pack} = $StP{ $self->byte_size };
 
@@ -95,9 +92,6 @@ sub new {
         $self->{digest} = \&Digest::MD5::md5;
     }
 
-    #XXX HACK
-    $self->{chains_loc} = 15;
-
     return $self;
 }
 
@@ -105,12 +99,11 @@ sub new {
 
 sub read_value {
     my $self = shift;
-    my ($trans_id, $base_offset, $key) = @_;
-    print "read_value( $trans_id, $base_offset, $key )\n" if $DEBUG;
+    my ($obj, $key) = @_;
 
     # This will be a Reference sector
-    my $sector = $self->_load_sector( $base_offset )
-        or die "How did read_value fail (no sector for '$base_offset')?!\n";
+    my $sector = $self->_load_sector( $obj->_base_offset )
+        or die "How did read_value fail (no sector for '$obj')?!\n";
 
     my $key_md5 = $self->_apply_digest( $key );
 
@@ -136,24 +129,22 @@ sub read_value {
 
 sub get_classname {
     my $self = shift;
-    my ($trans_id, $base_offset) = @_;
-    print "get_classname( $trans_id, $base_offset )\n" if $DEBUG;
+    my ($obj) = @_;
 
     # This will be a Reference sector
-    my $sector = $self->_load_sector( $base_offset )
-        or die "How did read_value fail (no sector for '$base_offset')?!\n";
+    my $sector = $self->_load_sector( $obj->_base_offset )
+        or die "How did read_value fail (no sector for '$obj')?!\n";
 
     return $sector->get_classname;
 }
 
 sub key_exists {
     my $self = shift;
-    my ($trans_id, $base_offset, $key) = @_;
-    print "key_exists( $trans_id, $base_offset, $key )\n" if $DEBUG;
+    my ($obj, $key) = @_;
 
     # This will be a Reference sector
-    my $sector = $self->_load_sector( $base_offset )
-        or die "How did key_exists fail (no sector for '$base_offset')?!\n";
+    my $sector = $self->_load_sector( $obj->_base_offset )
+        or die "How did key_exists fail (no sector for '$obj')?!\n";
 
     my $key_md5 = $self->_apply_digest( $key );
 
@@ -168,11 +159,10 @@ sub key_exists {
 
 sub delete_key {
     my $self = shift;
-    my ($trans_id, $base_offset, $key) = @_;
-    print "delete_key( $trans_id, $base_offset, $key )\n" if $DEBUG;
+    my ($obj, $key) = @_;
 
-    my $sector = $self->_load_sector( $base_offset )
-        or die "How did delete_key fail (no sector for '$base_offset')?!\n";
+    my $sector = $self->_load_sector( $obj->_base_offset )
+        or die "How did delete_key fail (no sector for '$obj')?!\n";
 
     my $key_md5 = $self->_apply_digest( $key );
 
@@ -186,12 +176,11 @@ sub delete_key {
 
 sub write_value {
     my $self = shift;
-    my ($trans_id, $base_offset, $key, $value) = @_;
-    print "write_value( $trans_id, $base_offset, $key, $value )\n" if $DEBUG;
+    my ($obj, $key, $value) = @_;
 
     # This will be a Reference sector
-    my $sector = $self->_load_sector( $base_offset )
-        or die "How did write_value fail (no sector for '$base_offset')?!\n";
+    my $sector = $self->_load_sector( $obj->_base_offset )
+        or die "How did write_value fail (no sector for '$obj')?!\n";
 
     my $key_md5 = $self->_apply_digest( $key );
 
@@ -252,6 +241,7 @@ sub write_value {
         tie @$value, 'DBM::Deep', {
             base_offset => $value_sector->offset,
             storage     => $self->storage,
+            engine      => $self,
         };
         @$value = @temp;
         bless $value, 'DBM::Deep::Array' unless Scalar::Util::blessed( $value );
@@ -261,6 +251,7 @@ sub write_value {
         tie %$value, 'DBM::Deep', {
             base_offset => $value_sector->offset,
             storage     => $self->storage,
+            engine      => $self,
         };
 
         %$value = %temp;
@@ -272,19 +263,17 @@ sub write_value {
 
 sub get_next_key {
     my $self = shift;
-    my ($trans_id, $base_offset, $prev_key) = @_;
-    print "get_next_key( $trans_id, $base_offset )\n" if $DEBUG;
+    my ($obj, $prev_key) = @_;
 
     # XXX Need to add logic about resetting the iterator if any key in the reference has changed
     unless ( $prev_key ) {
-        $self->{iterator} = DBM::Deep::Engine::Iterator->new({
-            base_offset => $base_offset,
-            trans_id    => $trans_id,
+        $obj->{iterator} = DBM::Deep::Engine::Iterator->new({
+            base_offset => $obj->_base_offset,
             engine      => $self,
         });
     }
 
-    return $self->iterator->get_next_key;
+    return $obj->{iterator}->get_next_key;
 }
 
 ################################################################################
@@ -330,80 +319,94 @@ sub setup_fh {
     return 1;
 }
 
-################################################################################
+# begin_work
+sub begin_transaction {
+    my $self = shift;
+}
 
-sub _write_file_header {
+# rollback
+sub end_transaction {
     my $self = shift;
+}
 
-    my $header_fixed = length( SIG_FILE ) + 1 + 4 + 4;
-    my $header_var = 1 + 1 + 2 * $self->byte_size;
-
-    my $loc = $self->storage->request_space( $header_fixed + $header_var );
-
-    $self->storage->print_at( $loc,
-        SIG_FILE,
-        SIG_HEADER,
-        pack('N', 1),  # header version - at this point, we're at 9 bytes
-        pack('N', $header_var), # header size
-        # --- Above is $header_fixed. Below is $header_var
-        pack('C', $self->byte_size),
-        pack('C', $self->max_buckets),
-        pack($StP{$self->byte_size}, 0), # Start of free chain (blist size)
-        pack($StP{$self->byte_size}, 0), # Start of free chain (data size)
-    );
+# commit
+sub commit_transaction {
+    my $self = shift;
+}
 
-    $self->set_chains_loc( $header_fixed + 2 );
+################################################################################
 
-#    $self->storage->set_transaction_offset( $header_fixed );
+{
+    my $header_fixed = length( SIG_FILE ) + 1 + 4 + 4;
 
-    return;
-}
+    sub _write_file_header {
+        my $self = shift;
 
-sub _read_file_header {
-    my $self = shift;
+        my $header_var = 1 + 1 + 4 + 2 * $self->byte_size;
 
-    my $header_fixed = length( SIG_FILE ) + 1 + 4 + 4;
+        my $loc = $self->storage->request_space( $header_fixed + $header_var );
 
-    my $buffer = $self->storage->read_at( 0, $header_fixed );
-    return unless length($buffer);
+        $self->storage->print_at( $loc,
+            SIG_FILE,
+            SIG_HEADER,
+            pack('N', 1),           # header version - at this point, we're at 9 bytes
+            pack('N', $header_var), # header size
+            # --- Above is $header_fixed. Below is $header_var
+            pack('C', $self->byte_size),
+            pack('C', $self->max_buckets),
+            pack('N', 0 ),                   # Running transactions
+            pack($StP{$self->byte_size}, 0), # Start of free chain (blist size)
+            pack($StP{$self->byte_size}, 0), # Start of free chain (data size)
+        );
 
-    my ($file_signature, $sig_header, $header_version, $size) = unpack(
-        'A4 A N N', $buffer
-    );
+        $self->set_trans_loc( $header_fixed + 2 );
+        $self->set_chains_loc( $header_fixed + 6 );
 
-    unless ( $file_signature eq SIG_FILE ) {
-        $self->storage->close;
-        DBM::Deep->_throw_error( "Signature not found -- file is not a Deep DB" );
+        return;
     }
 
-    unless ( $sig_header eq SIG_HEADER ) {
-        $self->storage->close;
-        DBM::Deep->_throw_error( "Old file version found." );
-    }
+    sub _read_file_header {
+        my $self = shift;
 
-    my $buffer2 = $self->storage->read_at( undef, $size );
-    my @values = unpack( 'C C', $buffer2 );
+        my $buffer = $self->storage->read_at( 0, $header_fixed );
+        return unless length($buffer);
 
-    $self->set_chains_loc( $header_fixed + 2 );
+        my ($file_signature, $sig_header, $header_version, $size) = unpack(
+            'A4 A N N', $buffer
+        );
 
-    # The transaction offset is the first thing after the fixed header section
-    #$self->storage->set_transaction_offset( $header_fixed );
+        unless ( $file_signature eq SIG_FILE ) {
+            $self->storage->close;
+            DBM::Deep->_throw_error( "Signature not found -- file is not a Deep DB" );
+        }
 
-    if ( @values < 2 || grep { !defined } @values ) {
-        $self->storage->close;
-        DBM::Deep->_throw_error("Corrupted file - bad header");
-    }
+        unless ( $sig_header eq SIG_HEADER ) {
+            $self->storage->close;
+            DBM::Deep->_throw_error( "Old file version found." );
+        }
 
-    #XXX Add warnings if values weren't set right
-    @{$self}{qw(byte_size max_buckets)} = @values;
+        my $buffer2 = $self->storage->read_at( undef, $size );
+        my @values = unpack( 'C C', $buffer2 );
 
-    my $header_var = 1 + 1 + 2 * $self->byte_size;
-    unless ( $size eq $header_var ) {
-        $self->storage->close;
-        DBM::Deep->_throw_error( "Unexpected size found ($size <-> $header_var)." );
-    }
+        $self->set_trans_loc( $header_fixed + 2 );
+        $self->set_chains_loc( $header_fixed + 6 );
+
+        if ( @values < 2 || grep { !defined } @values ) {
+            $self->storage->close;
+            DBM::Deep->_throw_error("Corrupted file - bad header");
+        }
+
+        #XXX Add warnings if values weren't set right
+        @{$self}{qw(byte_size max_buckets)} = @values;
 
-    return length($buffer) + length($buffer2);
+        my $header_var = 1 + 1 + 4 + 2 * $self->byte_size;
+        unless ( $size eq $header_var ) {
+            $self->storage->close;
+            DBM::Deep->_throw_error( "Unexpected size found ($size <-> $header_var)." );
+        }
+
+        return length($buffer) + length($buffer2);
+    }
 }
 
 sub _load_sector {
@@ -513,9 +516,11 @@ 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 iterator    { $_[0]{iterator} }
 sub blank_md5   { chr(0) x $_[0]->hash_size }
 
+sub trans_loc     { $_[0]{trans_loc} }
+sub set_trans_loc { $_[0]{trans_loc} = $_[1] }
+
 sub chains_loc     { $_[0]{chains_loc} }
 sub set_chains_loc { $_[0]{chains_loc} = $_[1] }
 
@@ -854,6 +859,7 @@ sub data {
         type        => $self->type,
         base_offset => $self->offset,
         storage     => $self->engine->storage,
+        engine      => $self->engine,
     });
 
     if ( $self->engine->storage->{autobless} ) {

diff --git a/lib/DBM/Deep/Hash.pm b/lib/DBM/Deep/Hash.pm
index b593ed4..d322665 100644 (file)
--- a/lib/DBM/Deep/Hash.pm
+++ b/lib/DBM/Deep/Hash.pm
@@ -5,8 +5,6 @@ use 5.6.0;
 use strict;
 use warnings;
 
-use constant DEBUG => 0;
-
 our $VERSION = q(0.99_03);
 
 use base 'DBM::Deep';
@@ -47,7 +45,6 @@ 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])
@@ -57,7 +54,6 @@ 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])
@@ -68,7 +64,6 @@ 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])
@@ -87,7 +82,6 @@ sub DELETE {
 }
 
 sub FIRSTKEY {
-    print "FIRSTKEY\n" if DEBUG;
        ##
        # Locate and return first key (in no particular order)
        ##
@@ -98,7 +92,7 @@ sub FIRSTKEY {
        ##
        $self->lock( $self->LOCK_SH );
        
-       my $result = $self->_engine->get_next_key($self->_storage->transaction_id, $self->_base_offset);
+       my $result = $self->_engine->get_next_key( $self );
        
        $self->unlock();
        
@@ -108,7 +102,6 @@ sub FIRSTKEY {
 }
 
 sub NEXTKEY {
-    print "NEXTKEY( @_ )\n" if DEBUG;
        ##
        # Return next key (in no particular order), given previous one
        ##
@@ -123,7 +116,7 @@ sub NEXTKEY {
        ##
        $self->lock( $self->LOCK_SH );
        
-       my $result = $self->_engine->get_next_key( $self->_storage->transaction_id, $self->_base_offset, $prev_key );
+       my $result = $self->_engine->get_next_key( $self, $prev_key );
        
        $self->unlock();
        

diff --git a/t/24_autobless.t b/t/24_autobless.t
index c8bdc21..251fc7e 100644 (file)
--- a/t/24_autobless.t
+++ b/t/24_autobless.t
@@ -71,9 +71,9 @@ my ($fh, $filename) = new_fh();
     is( $obj->{b}[2], 3 );
 
     my $obj2 = $db->{blessed2};
-    isa_ok( $obj, 'Foo' );
-    can_ok( $obj, 'export', 'foo' );
-    ok( !$obj->can( 'STORE' ), "... but it cannot 'STORE'" );
+    isa_ok( $obj2, 'Foo' );
+    can_ok( $obj2, 'export', 'foo' );
+    ok( !$obj2->can( 'STORE' ), "... but it cannot 'STORE'" );
 
     is( $obj2->[0]{a}, 'foo' );
     is( $obj2->[1], '2' );
@@ -97,6 +97,7 @@ my ($fh, $filename) = new_fh();
     is( $db->{blessed}{c}, 'new' );
 
     my $structure = $db->export();
+    use Data::Dumper;print Dumper $structure;
     
     my $obj = $structure->{blessed};
     isa_ok( $obj, 'Foo' );
@@ -109,9 +110,9 @@ my ($fh, $filename) = new_fh();
     is( $obj->{b}[2], 3 );
 
     my $obj2 = $structure->{blessed2};
-    isa_ok( $obj, 'Foo' );
-    can_ok( $obj, 'export', 'foo' );
-    ok( !$obj->can( 'STORE' ), "... but it cannot 'STORE'" );
+    isa_ok( $obj2, 'Foo' );
+    can_ok( $obj2, 'export', 'foo' );
+    ok( !$obj2->can( 'STORE' ), "... but it cannot 'STORE'" );
 
     is( $obj2->[0]{a}, 'foo' );
     is( $obj2->[1], '2' );

diff --git a/t/33_transactions.todo b/t/33_transactions.t
similarity index 99%
rename from t/33_transactions.todo
rename to t/33_transactions.t
index bde1f0e..c07bb9d 100644 (file)
--- a/t/33_transactions.todo
+++ b/t/33_transactions.t
@@ -30,7 +30,7 @@ $db1->begin_work;
     $db1->{x} = 'z';
     is( $db1->{x}, 'z', "Within DB1 transaction, DB1's X is Z" );
     is( $db2->{x}, 'y', "Within DB1 transaction, DB2's X is still Y" );
-
+__END__
     $db2->{other_x} = 'foo';
     is( $db2->{other_x}, 'foo', "DB2 set other_x within DB1's transaction, so DB2 can see it" );
     ok( !exists $db1->{other_x}, "Since other_x was added after the transaction began, DB1 doesn't see it." );