From: rkinyon <rkinyon@50811bd7-b8ce-0310-adc1-d9db26280581>
Date: Tue, 11 Apr 2006 03:01:11 +0000 (+0000)
Subject: Tagged 0.983 and removed the branch
X-Git-Tag: 0-99_01~26
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=21838116bc9b7cb890fa464ec0eaa907e3a260d3;p=dbsrgits%2FDBM-Deep.git

Tagged 0.983 and removed the branch
---

diff --git a/lib/DBM/Deep/Engine.pm b/lib/DBM/Deep/Engine.pm
index fa04d49..7249fe7 100644
--- a/lib/DBM/Deep/Engine.pm
+++ b/lib/DBM/Deep/Engine.pm
@@ -7,6 +7,9 @@ use warnings;
 
 use Fcntl qw( :DEFAULT :flock :seek );
 
+# File-wide notes:
+# * All the local($/,$\); are to protect read() and print() from -l.
+
 ##
 # Setup file and tag signatures.  These should never change.
 ##
@@ -86,7 +89,6 @@ sub calculate_sizes {
 
     #XXX Does this need to be updated with different hashing algorithms?
     $self->{index_size}       = (2**8) * $self->{long_size};
-#ACID This needs modified - DONE
     $self->{bucket_size}      = $self->{hash_size} + $self->{long_size} * 3;
     $self->{bucket_list_size} = $self->{max_buckets} * $self->{bucket_size};
 
@@ -96,6 +98,8 @@ sub calculate_sizes {
 sub write_file_header {
     my $self = shift;
 
+    local($/,$\);
+
     my $fh = $self->_fh;
 
     my $loc = $self->_request_space( length( SIG_FILE ) + 21 );
@@ -119,6 +123,8 @@ sub write_file_header {
 sub read_file_header {
     my $self = shift;
 
+    local($/,$\);
+
     my $fh = $self->_fh;
 
     seek($fh, 0 + $self->_fileobj->{file_offset}, SEEK_SET);
@@ -230,6 +236,8 @@ sub write_tag {
     my ($offset, $sig, $content) = @_;
     my $size = length( $content );
 
+    local($/,$\);
+
     my $fh = $self->_fh;
 
     if ( defined $offset ) {
@@ -255,6 +263,8 @@ sub load_tag {
     my $self = shift;
     my ($offset) = @_;
 
+    local($/,$\);
+
 #    print join(':',map{$_||''}caller(1)), $/;
 
     my $fh = $self->_fh;
@@ -369,6 +379,8 @@ sub add_bucket {
     my $self = shift;
     my ($tag, $md5, $plain_key, $value) = @_;
 
+    local($/,$\);
+
     # This verifies that only supported values will be stored.
     {
         my $r = Scalar::Util::reftype( $value );
@@ -390,9 +402,9 @@ sub add_bucket {
 
     my $actual_length = $self->_length_needed( $value, $plain_key );
 
-    my ($subloc, $offset, $size) = $self->_find_in_buckets( $tag, $md5 );
+    #ACID - This is a mutation. Must only find the exact transaction
+    my ($subloc, $offset, $size) = $self->_find_in_buckets( $tag, $md5, 1 );
 
-    print "$subloc - $offset - $size\n";
 #    $self->_release_space( $size, $subloc );
     # Updating a known md5
 #XXX This needs updating to use _release_space
@@ -439,6 +451,8 @@ sub write_value {
     my $self = shift;
     my ($location, $key, $value) = @_;
 
+    local($/,$\);
+
     my $fh = $self->_fh;
     my $root = $self->_fileobj;
 
@@ -530,6 +544,8 @@ sub split_index {
     my $self = shift;
     my ($md5, $tag) = @_;
 
+    local($/,$\);
+
     my $fh = $self->_fh;
     my $root = $self->_fileobj;
 
@@ -611,6 +627,8 @@ sub read_from_loc {
     my $self = shift;
     my ($subloc) = @_;
 
+    local($/,$\);
+
     my $fh = $self->_fh;
 
     ##
@@ -700,6 +718,7 @@ sub get_bucket_value {
     my $self = shift;
     my ($tag, $md5) = @_;
 
+    #ACID - This is a read. Can find exact or HEAD
     my ($subloc, $offset, $size) = $self->_find_in_buckets( $tag, $md5 );
     if ( $subloc ) {
         return $self->read_from_loc( $subloc );
@@ -714,7 +733,10 @@ sub delete_bucket {
     my $self = shift;
     my ($tag, $md5) = @_;
 
-    my ($subloc, $offset, $size) = $self->_find_in_buckets( $tag, $md5 );
+    local($/,$\);
+
+    #ACID - This is a mutation. Must only find the exact transaction
+    my ($subloc, $offset, $size) = $self->_find_in_buckets( $tag, $md5, 1 );
 #XXX This needs _release_space()
     if ( $subloc ) {
         my $fh = $self->_fh;
@@ -734,6 +756,7 @@ sub bucket_exists {
     my $self = shift;
     my ($tag, $md5) = @_;
 
+    #ACID - This is a read. Can find exact or HEAD
     my ($subloc, $offset, $size) = $self->_find_in_buckets( $tag, $md5 );
     return $subloc && 1;
 }
@@ -746,6 +769,8 @@ sub find_bucket_list {
     my ($offset, $md5, $args) = @_;
     $args = {} unless $args;
 
+    local($/,$\);
+
     ##
     # Locate offset for bucket list using digest index system
     ##
@@ -816,6 +841,8 @@ sub traverse_index {
     my $self = shift;
     my ($obj, $offset, $ch, $force_return_next) = @_;
 
+    local($/,$\);
+
     my $tag = $self->load_tag( $offset );
 
     my $fh = $self->_fh;
@@ -919,7 +946,6 @@ sub get_next_key {
 
 # Utilities
 
-#ACID This needs modified - DONE
 sub _get_key_subloc {
     my $self = shift;
     my ($keys, $idx) = @_;
@@ -940,21 +966,33 @@ sub _get_key_subloc {
 
 sub _find_in_buckets {
     my $self = shift;
-    my ($tag, $md5) = @_;
+    my ($tag, $md5, $exact) = @_;
 
     my $trans_id = $self->_fileobj->transaction_id;
 
+    my @zero;
+
     BUCKET:
     for ( my $i = 0; $i < $self->{max_buckets}; $i++ ) {
         my ($key, $subloc, $size, $transaction_id) = $self->_get_key_subloc(
             $tag->{content}, $i,
         );
 
-        return ($subloc, $i * $self->{bucket_size}, $size) unless $subloc;
+        my @rv = ($subloc, $i * $self->{bucket_size}, $size);
+
+        unless ( $subloc ) {
+            return @zero if !$exact && @zero and $trans_id;
+            return @rv;
+        }
+
+        next BUCKET if $key ne $md5;
 
-        next BUCKET if $key ne $md5 || $transaction_id != $trans_id;
+        # Save off the HEAD in case we need it.
+        @zero = @rv if $transaction_id == 0;
 
-        return ($subloc, $i * $self->{bucket_size}, $size);
+        next BUCKET if $transaction_id != $trans_id;
+
+        return @rv;
     }
 
     return;
@@ -974,6 +1012,8 @@ sub _release_space {
     my $self = shift;
     my ($size, $loc) = @_;
 
+    local($/,$\);
+
     my $next_loc = 0;
 
     my $fh = $self->_fh;
@@ -999,6 +1039,8 @@ sub _read_at {
     my $self = shift;
     my ($spot, $amount, $unpack) = @_;
 
+    local($/,$\);
+
     my $fh = $self->_fh;
     seek( $fh, $spot + $self->_fileobj->{file_offset}, SEEK_SET );
 
@@ -1021,6 +1063,8 @@ sub _print_at {
     my $self = shift;
     my ($spot, $data) = @_;
 
+    local($/,$\);
+
     my $fh = $self->_fh;
     seek( $fh, $spot, SEEK_SET );
     print( $fh $data );
@@ -1031,6 +1075,8 @@ sub _print_at {
 sub get_file_version {
     my $self = shift;
 
+    local($/,$\);
+
     my $fh = $self->_fh;
 
     seek( $fh, 13 + $self->_fileobj->{file_offset}, SEEK_SET );
@@ -1047,6 +1093,8 @@ sub write_file_version {
     my $self = shift;
     my ($new_version) = @_;
 
+    local($/,$\);
+
     my $fh = $self->_fh;
 
     seek( $fh, 13 + $self->_fileobj->{file_offset}, SEEK_SET );
diff --git a/t/28_transactions.t b/t/28_transactions.t
index f5f567d..736beff 100644
--- a/t/28_transactions.t
+++ b/t/28_transactions.t
@@ -1,25 +1,45 @@
 use strict;
-use Test::More tests => 4;
+use Test::More tests => 13;
 use Test::Exception;
 use t::common qw( new_fh );
 
 use_ok( 'DBM::Deep' );
 
 my ($fh, $filename) = new_fh();
-my $db = DBM::Deep->new(
+my $db1 = DBM::Deep->new(
     file => $filename,
+    locking => 1,
 );
 
-$db->{x} = 'y';
-is( $db->{x}, 'y' );
-$db->begin_work;
-$db->{x} = 'z';
-is( $db->{x}, 'z' );
-$db->rollback;
-TODO: {
-    local $TODO = "Haven't written transaction code yet";
-    is( $db->{x}, 'y' );
-}
+my $db2 = DBM::Deep->new(
+    file => $filename,
+    locking => 1,
+);
+
+$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" );
+
+$db1->begin_work;
+
+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" );
+
+$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" );
+
+$db2->{other_x} = 'foo';
+is( $db2->{other_x}, 'foo', "Set other_x within DB1's transaction, so DB2 can see it" );
+is( $db1->{other_x}, undef, "Since other_x was added after the transaction began, DB1 doesn't see it." );
+
+$db1->rollback;
+
+is( $db1->{x}, 'y', "After rollback, DB1's X is Y" );
+is( $db2->{x}, 'y', "After rollback, DB2's X is Y" );
+
+is( $db1->{other_x}, 'foo', "After DB1 transaction is over, DB1 can see other_x" );
+is( $db2->{other_x}, 'foo', "After DB1 transaction is over, DB2 can still see other_x" );
 
 # Add a commit test (using fork) - we don't have to use fork initially. Since
 # the transaction is in the Engine object and each new() provides a new Engine