Initial code written for transactional isolation

diff --git a/lib/DBM/Deep.pm b/lib/DBM/Deep.pm
index 7d9801c..60d717e 100644 (file)
--- a/lib/DBM/Deep.pm
+++ b/lib/DBM/Deep.pm
@@ -361,17 +361,17 @@ sub clone {
 
 sub begin_work {
     my $self = shift->_get_self;
-    return $self->_engine->begin_transaction( $self, @_ );
+    return $self->_engine->begin_work( $self, @_ );
 }
 
 sub rollback {
     my $self = shift->_get_self;
-    return $self->_engine->end_transaction( $self, @_ );
+    return $self->_engine->rollback( $self, @_ );
 }
 
 sub commit {
     my $self = shift->_get_self;
-    return $self->_engine->commit_transaction( $self, @_ );
+    return $self->_engine->commit( $self, @_ );
 }
 
 ##

diff --git a/lib/DBM/Deep/Engine3.pm b/lib/DBM/Deep/Engine3.pm
index 48220fc..4e3177f 100644 (file)
--- a/lib/DBM/Deep/Engine3.pm
+++ b/lib/DBM/Deep/Engine3.pm
@@ -49,6 +49,7 @@ sub new {
         hash_size   => 16, # In bytes
         max_buckets => 16,
         num_txns    => 16, # HEAD plus 15 running txns
+        trans_id    => 0,  # Default to the HEAD
 
         storage => undef,
     }, $class;
@@ -113,7 +114,7 @@ sub read_value {
         create  => 1,
     }) or die "How did read_value fail (no blist)?!\n";
 
-    my $value_sector = $blist->get_data_for( $key_md5 );
+    my $value_sector = $blist->get_data_for( $key_md5, { allow_head => 1 } );
     if ( !$value_sector ) {
         # Autovivification
         $value_sector = DBM::Deep::Engine::Sector::Null->new({
@@ -154,7 +155,7 @@ sub key_exists {
     }) or die "How did key_exists fail (no blist)?!\n";
 
     # exists() returns 1 or '' for true/false.
-    return $blist->has_md5( $key_md5 ) ? 1 : '';
+    return $blist->has_md5( $key_md5, { allow_head => 1 } ) ? 1 : '';
 }
 
 sub delete_key {
@@ -220,7 +221,7 @@ sub write_value {
     }
 
     if ( $blist->has_md5( $key_md5 ) ) {
-        $blist->get_data_for( $key_md5 )->free;
+        $blist->get_data_for( $key_md5, { allow_head => 0 } )->free;
     }
 
     my $value_sector = $class->new({
@@ -319,19 +320,58 @@ sub setup_fh {
     return 1;
 }
 
-# begin_work
-sub begin_transaction {
+sub begin_work {
     my $self = shift;
+    my ($obj) = @_;
+
+    if ( $self->trans_id ) {
+        DBM::Deep->throw_error( "Cannot begin_work within a transaction" );
+    }
+
+    my @slots = $self->read_transaction_slots;
+    for my $i ( 1 .. @slots ) {
+        next if $slots[$i];
+        $slots[$i] = 1;
+        $self->set_trans_id( $i );
+        last;
+    }
+    $self->write_transaction_slots( @slots );
+
+    if ( !$self->trans_id ) {
+        DBM::Deep->throw_error( "Cannot begin_work - no available transactions" );
+    }
+
+    return;
 }
 
-# rollback
-sub end_transaction {
+sub rollback {
     my $self = shift;
+    my ($obj) = @_;
+
+    if ( !$self->trans_id ) {
+        DBM::Deep->throw_error( "Cannot rollback without a transaction" );
+    }
 }
 
-# commit
-sub commit_transaction {
+sub commit {
     my $self = shift;
+    my ($obj) = @_;
+
+    if ( !$self->trans_id ) {
+        DBM::Deep->throw_error( "Cannot commit without a transaction" );
+    }
+}
+
+sub read_transaction_slots {
+    my $self = shift;
+    return split '', unpack( "b32", $self->storage->read_at( $self->trans_loc, 4 ) );
+}
+
+sub write_transaction_slots {
+    my $self = shift;
+    $self->storage->print_at( $self->trans_loc,
+        pack( "b32", join('', @_) ),
+    );
 }
 
 ################################################################################
@@ -518,6 +558,9 @@ sub num_txns    { $_[0]{num_txns} }
 sub max_buckets { $_[0]{max_buckets} }
 sub blank_md5   { chr(0) x $_[0]->hash_size }
 
+sub trans_id     { $_[0]{trans_id} }
+sub set_trans_id { $_[0]{trans_id} = $_[1] }
+
 sub trans_loc     { $_[0]{trans_loc} }
 sub set_trans_loc { $_[0]{trans_loc} = $_[1] }
 
@@ -921,7 +964,8 @@ sub has_md5 {
 
 sub find_md5 {
     my $self = shift;
-    my ($md5) = @_;
+    my ($md5, $opts) = @_;
+    $opts ||= {};
 
     foreach my $idx ( 0 .. $self->engine->max_buckets - 1 ) {
         my $potential = $self->engine->storage->read_at(
@@ -929,7 +973,17 @@ sub find_md5 {
         );
 
         return (undef, $idx) if $potential eq $self->engine->blank_md5;
-        return (1, $idx) if $md5 eq $potential;
+        if ( $md5 eq $potential ) {
+            my $location = $self->get_data_location_for(
+                $self->engine->trans_id, $idx, $opts,
+            );
+
+            if ( $location > 1 ) {
+                return (1, $idx);
+            }
+
+            return (undef, $idx);
+        }
     }
 
     return;
@@ -940,7 +994,7 @@ sub write_md5 {
     my ($md5, $key, $value_loc) = @_;
 
     my $engine = $self->engine;
-    my ($found, $idx) = $self->find_md5( $md5 );
+    my ($found, $idx) = $self->find_md5( $md5, { allow_head => 0 } );
     my $spot = $self->offset + $self->base_size + $idx * $self->bucket_size;
 
     unless ($found) {
@@ -955,7 +1009,11 @@ sub write_md5 {
         );
     }
 
-    $engine->storage->print_at( $spot + $self->engine->hash_size + $self->engine->byte_size,
+    $engine->storage->print_at(
+        $spot
+      + $self->engine->hash_size
+      + $self->engine->byte_size
+      + $self->engine->trans_id * $self->engine->byte_size,
         pack( $StP{$engine->byte_size}, $value_loc ), # The pointer to the data in the HEAD
     );
 }
@@ -965,11 +1023,11 @@ sub delete_md5 {
     my ($md5) = @_;
 
     my $engine = $self->engine;
-    my ($found, $idx) = $self->find_md5( $md5 );
+    my ($found, $idx) = $self->find_md5( $md5, { allow_head => 0 } );
     return undef unless $found;
 
     # Save the location so that we can free the data
-    my $location = $self->get_data_location_for( $idx );
+    my $location = $self->get_data_location_for( $self->engine->trans_id, $idx, { allow_head => 0 } );
     my $key_sector = $self->get_key_for( $idx );
 
     my $spot = $self->offset + $self->base_size + $idx * $self->bucket_size;
@@ -992,22 +1050,35 @@ sub delete_md5 {
 
 sub get_data_location_for {
     my $self = shift;
-    my ($idx) = @_;
+    my ($trans_id, $idx, $opts) = @_;
+    $opts ||= {};
 
     my $location = $self->engine->storage->read_at(
-        $self->offset + $self->base_size + $idx * $self->bucket_size + $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
+      + $trans_id * $self->engine->byte_size,
         $self->engine->byte_size,
     );
-    return unpack( $StP{$self->engine->byte_size}, $location );
+    my $loc = unpack( $StP{$self->engine->byte_size}, $location );
+
+    # If we're in a transaction and we never wrote to this location, try the
+    # HEAD instead.
+    if ( $trans_id && !$loc && $opts->{allow_head} ) {
+        return $self->get_data_location_for( 0, $idx );
+    }
+    return $loc;
 }
 
 sub get_data_for {
     my $self = shift;
-    my ($md5) = @_;
+    my ($md5, $opts) = @_;
+    $opts ||= {};
 
-    my ($found, $idx) = $self->find_md5( $md5 );
+    my ($found, $idx) = $self->find_md5( $md5, $opts );
     return unless $found;
-    my $location = $self->get_data_location_for( $idx );
+    my $location = $self->get_data_location_for( $self->engine->trans_id, $idx, $opts );
     return $self->engine->_load_sector( $location );
 }
 

diff --git a/t/33_transactions.t b/t/33_transactions.t
index c07bb9d..2b43f68 100644 (file)
--- a/t/33_transactions.t
+++ b/t/33_transactions.t
@@ -1,5 +1,5 @@
 use strict;
-use Test::More tests => 62;
+use Test::More tests => 65;
 use Test::Deep;
 use t::common qw( new_fh );
 
@@ -22,8 +22,17 @@ $db1->{x} = 'y';
 is( $db1->{x}, 'y', "Before transaction, DB1's X is Y" );
 is( $db2->{x}, 'y', "Before transaction, DB2's X is Y" );
 
+eval { $db1->rollback };
+ok( $@, "Attempting to rollback without a transaction throws an error" );
+
+eval { $db1->commit };
+ok( $@, "Attempting to commit without a transaction throws an error" );
+
 $db1->begin_work;
 
+eval { $db1->begin_work };
+ok( $@, "Attempting to begin_work within a transaction throws an error" );
+
     is( $db1->{x}, 'y', "DB1 transaction started, no actions - DB1's X is Y" );
     is( $db2->{x}, 'y', "DB1 transaction started, no actions - DB2's X is Y" );