From: rkinyon Date: Thu, 20 Apr 2006 15:36:17 +0000 (+0000) Subject: rollback and commit both work. Need to add MORE and MORE tests X-Git-Tag: 0-99_01~10 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=25c7c8d660691a8d4fc15bfe9f47149f47f86884;p=dbsrgits%2FDBM-Deep.git rollback and commit both work. Need to add MORE and MORE tests --- diff --git a/lib/DBM/Deep.pm b/lib/DBM/Deep.pm index deb56d5..29318f6 100644 --- a/lib/DBM/Deep.pm +++ b/lib/DBM/Deep.pm @@ -335,8 +335,7 @@ sub rollback { sub commit { my $self = shift->_get_self; - # At this point, we need to replay the actions taken - $self->_fileobj->end_transaction; + $self->_fileobj->commit_transaction; return 1; } @@ -388,19 +387,28 @@ sub _find_parent { my $base = ''; if ( my $parent = $self->{parent} ) { my $child = $self; - while ( 1 ) { + while ( $parent->{parent} ) { $base = ( $parent->_type eq TYPE_HASH ? "\{$child->{parent_key}\}" : "\[$child->{parent_key}\]" +# "->get('$child->{parent_key}')" ) . $base; $child = $parent; $parent = $parent->{parent}; - last unless $parent; +# last unless $parent; + } + if ( $base ) { + $base = "\$db->get( '$child->{parent_key}' )->" . $base; + } + else { + $base = "\$db->get( '$child->{parent_key}' )"; } } - return '$db->' . $base; +# return '$db->' . $base; +# return '$db' . $base; + return $base; } sub STORE { @@ -416,14 +424,6 @@ sub STORE { } if ( defined $orig_key ) { - my $lhs = $self->_find_parent; - if ( $self->_type eq TYPE_HASH ) { - $lhs .= "\{$orig_key\}"; - } - else { - $lhs .= "\[$orig_key\]"; - } - my $rhs; my $r = Scalar::Util::reftype( $value ) || ''; @@ -444,7 +444,24 @@ sub STORE { $rhs = "bless $rhs, '$c'"; } - $self->_fileobj->audit( "$lhs = $rhs;" ); + my $lhs = $self->_find_parent; + if ( $lhs ) { + if ( $self->_type eq TYPE_HASH ) { + $lhs .= "->\{$orig_key\}"; + } + else { + $lhs .= "->\[$orig_key\]"; + } + + $lhs .= "=$rhs;"; + } + else { + $lhs = "\$db->put('$orig_key',$rhs);"; + } + +# $self->_fileobj->audit( "$lhs = $rhs;" ); +# $self->_fileobj->audit( "$lhs $rhs);" ); + $self->_fileobj->audit($lhs); } ## @@ -519,14 +536,21 @@ sub DELETE { if ( defined $orig_key ) { my $lhs = $self->_find_parent; - if ( $self->_type eq TYPE_HASH ) { - $lhs .= "\{$orig_key\}"; +# if ( $self->_type eq TYPE_HASH ) { +# $lhs .= "\{$orig_key\}"; +# } +# else { +# $lhs .= "\[$orig_key]\]"; +# } + +# $self->_fileobj->audit( "delete $lhs;" ); +# $self->_fileobj->audit( "$lhs->delete('$orig_key');" ); + if ( $lhs ) { + $self->_fileobj->audit( "delete $lhs;" ); } else { - $lhs .= "\[$orig_key]\]"; + $self->_fileobj->audit( "\$db->delete('$orig_key');" ); } - - $self->_fileobj->audit( "delete $lhs;" ); } ## diff --git a/lib/DBM/Deep/File.pm b/lib/DBM/Deep/File.pm index 687a1c3..3c3d6fc 100644 --- a/lib/DBM/Deep/File.pm +++ b/lib/DBM/Deep/File.pm @@ -33,6 +33,7 @@ sub new { # $args. They are here for documentation purposes. transaction_id => 0, transaction_offset => 0, + trans_audit => undef, base_db_obj => undef, }, $class; @@ -68,10 +69,13 @@ sub new { } sub set_db { - unless ( $_[0]{base_db_obj} ) { - $_[0]{base_db_obj} = $_[1]; - Scalar::Util::weaken( $_[0]{base_db_obj} ); + my $self = shift; + unless ( $self->{base_db_obj} ) { + $self->{base_db_obj} = shift; + Scalar::Util::weaken( $self->{base_db_obj} ); } + + return; } sub open { @@ -273,10 +277,9 @@ sub set_transaction_offset { sub audit { my $self = shift; + my ($string) = @_; if ( my $afh = $self->{audit_fh} ) { - my ($string) = @_; - flock( $afh, LOCK_EX ); if ( $string =~ /^#/ ) { @@ -289,6 +292,10 @@ sub audit { flock( $afh, LOCK_UN ); } + if ( $self->{trans_audit} ) { + push @{$self->{trans_audit}}, $string; + } + return 1; } @@ -316,6 +323,8 @@ sub begin_transaction { $self->unlock; + $self->{trans_audit} = []; + return $self->{transaction_id}; } @@ -332,6 +341,7 @@ sub end_transaction { $buffer = unpack( 'N', $buffer ); # Unset $self->{transaction_id} bit + $buffer ^= (1 << $self->{transaction_id}-1); seek( $fh, $self->{transaction_offset} + $self->{file_offset}, SEEK_SET ); print( $fh pack( 'N', $buffer ) ); @@ -339,6 +349,9 @@ sub end_transaction { $self->unlock; $self->{transaction_id} = 0; + $self->{trans_audit} = undef; + + return 1; } sub current_transactions { @@ -367,8 +380,23 @@ sub current_transactions { sub transaction_id { return $_[0]->{transaction_id} } -#sub commit { -#} +sub commit_transaction { + my $self = shift; + + my @audit = @{$self->{trans_audit}}; + + $self->end_transaction; + + { + my $db = $self->{base_db_obj}; + for ( @audit ) { + eval "$_;"; + warn "$_: $@\n" if $@; + } + } + + return 1; +} 1; __END__ diff --git a/t/33_transaction_commit.t b/t/33_transaction_commit.t index a52d930..36f4226 100644 --- a/t/33_transaction_commit.t +++ b/t/33_transaction_commit.t @@ -37,11 +37,8 @@ is( $db1->{other_x}, undef, "Since other_x was added after the transaction began $db1->commit; -TODO: { - local $TODO = 'Need to finish auditing first before commit will work.'; - is( $db1->{x}, 'z', "After commit, DB1's X is Y" ); - is( $db2->{x}, 'z', "After commit, DB2's X is Y" ); -} +is( $db1->{x}, 'z', "After commit, DB1's X is Y" ); +is( $db2->{x}, 'z', "After commit, 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" ); diff --git a/t/50_audit_trail.t b/t/50_audit_trail.t index 7562c14..ef1f5cf 100644 --- a/t/50_audit_trail.t +++ b/t/50_audit_trail.t @@ -49,9 +49,11 @@ sub testit { for ( @$audit ) { eval "$_"; + warn "$_ -> $@\n" if $@; } my $export2 = $db->export; +# use Data::Dumper;warn Dumper $export2; cmp_deeply( $export2, $export, "And recovery works" ); }