X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBM%2FDeep.pm;h=29318f6f5dbf3bb585efc80f96058d12d6deb66b;hb=25c7c8d660691a8d4fc15bfe9f47149f47f86884;hp=13259f709cd4415bb1fabf9701e72bfa0b29485b;hpb=aa83bc1e6fccd5f036255776058617f8657c7c08;p=dbsrgits%2FDBM-Deep.git diff --git a/lib/DBM/Deep.pm b/lib/DBM/Deep.pm index 13259f7..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; } @@ -384,14 +383,32 @@ sub _is_writable { sub _find_parent { my $self = shift; - if ( $self->{parent} ) { - my $base = $self->{parent}->_find_parent(); - if ( $self->{parent}->_type eq TYPE_HASH ) { - return $base . "\{$self->{parent_key}\}"; + + my $base = ''; + if ( my $parent = $self->{parent} ) { + my $child = $self; + 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; + } + if ( $base ) { + $base = "\$db->get( '$child->{parent_key}' )->" . $base; + } + else { + $base = "\$db->get( '$child->{parent_key}' )"; } - return $base . "\[$self->{parent_key}\]"; } - return '$db->'; +# return '$db->' . $base; +# return '$db' . $base; + return $base; } sub STORE { @@ -406,38 +423,45 @@ sub STORE { $self->_throw_error( 'Cannot write to a readonly filehandle' ); } - if ( my $afh = $self->_fileobj->{audit_fh} ) { - if ( defined $orig_key ) { - my $lhs = $self->_find_parent; - if ( $self->_type eq TYPE_HASH ) { - $lhs .= "\{$orig_key\}"; - } - else { - $lhs .= "\[$orig_key\]"; - } + if ( defined $orig_key ) { + my $rhs; - my $rhs; + my $r = Scalar::Util::reftype( $value ) || ''; + if ( $r eq 'HASH' ) { + $rhs = '{}'; + } + elsif ( $r eq 'ARRAY' ) { + $rhs = '[]'; + } + elsif ( defined $value ) { + $rhs = "'$value'"; + } + else { + $rhs = "undef"; + } - my $r = Scalar::Util::reftype( $value ) || ''; - if ( $r eq 'HASH' ) { - $rhs = '{}'; - } - elsif ( $r eq 'ARRAY' ) { - $rhs = '[]'; + if ( my $c = Scalar::Util::blessed( $value ) ) { + $rhs = "bless $rhs, '$c'"; + } + + my $lhs = $self->_find_parent; + if ( $lhs ) { + if ( $self->_type eq TYPE_HASH ) { + $lhs .= "->\{$orig_key\}"; } else { - $rhs = "'$value'"; + $lhs .= "->\[$orig_key\]"; } - if ( my $c = Scalar::Util::blessed( $value ) ) { - $rhs = "bless $rhs, '$c'"; - } - - $self->_fileobj->audit( "$lhs = $rhs;" ); -# flock( $afh, LOCK_EX ); -# print( $afh "$lhs = $rhs; # " . localtime(time) . "\n" ); -# flock( $afh, LOCK_UN ); + $lhs .= "=$rhs;"; } + else { + $lhs = "\$db->put('$orig_key',$rhs);"; + } + +# $self->_fileobj->audit( "$lhs = $rhs;" ); +# $self->_fileobj->audit( "$lhs $rhs);" ); + $self->_fileobj->audit($lhs); } ## @@ -510,19 +534,22 @@ sub DELETE { $self->_throw_error( 'Cannot write to a readonly filehandle' ); } - if ( my $afh = $self->_fileobj->{audit_fh} ) { - if ( defined $orig_key ) { - my $lhs = $self->_find_parent; - if ( $self->_type eq TYPE_HASH ) { - $lhs .= "\{$orig_key\}"; - } - else { - $lhs .= "\[$orig_key]\]"; - } - - flock( $afh, LOCK_EX ); - print( $afh "delete $lhs; # " . localtime(time) . "\n" ); - flock( $afh, LOCK_UN ); + if ( defined $orig_key ) { + my $lhs = $self->_find_parent; +# 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 { + $self->_fileobj->audit( "\$db->delete('$orig_key');" ); } } @@ -604,10 +631,9 @@ sub CLEAR { $self->_throw_error( 'Cannot write to a readonly filehandle' ); } - if ( my $afh = $self->_fileobj->{audit_fh} ) { + { my $lhs = $self->_find_parent; - my $rhs = '()'; if ( $self->_type eq TYPE_HASH ) { $lhs = '%{' . $lhs . '}'; } @@ -615,9 +641,7 @@ sub CLEAR { $lhs = '@{' . $lhs . '}'; } - flock( $afh, LOCK_EX ); - print( $afh "$lhs = $rhs; # " . localtime(time) . "\n" ); - flock( $afh, LOCK_UN ); + $self->_fileobj->audit( "$lhs = ();" ); } ## @@ -625,14 +649,6 @@ sub CLEAR { ## $self->lock( LOCK_EX ); - my $fh = $self->_fh; - - seek($fh, $self->_base_offset + $self->_fileobj->{file_offset}, SEEK_SET); - if (eof $fh) { - $self->unlock(); - return; - } - #XXX This needs updating to use _release_space $self->{engine}->write_tag( $self->_base_offset, $self->_type,