From: rkinyon Date: Mon, 6 Mar 2006 19:15:49 +0000 (+0000) Subject: Tagged 0.981_01 (experimental auditlog) X-Git-Tag: 0-981_01^0 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=12a1e26ef8f5139bb853a72a61a094b10c4fbea6;p=dbsrgits%2FDBM-Deep.git Tagged 0.981_01 (experimental auditlog) --- diff --git a/Build.PL b/Build.PL index 18173d8..db016d0 100644 --- a/Build.PL +++ b/Build.PL @@ -17,7 +17,8 @@ my $build = Module::Build->new( }, create_makefile_pl => 'traditional', add_to_cleanup => [ - 'META.yml', '*.bak', '*.gz', 'Makefile.PL', 't/test*.db', 'cover_db' + 'META.yml', '*.bak', '*.gz', 'Makefile.PL', 't/test*.db', 'cover_db', + 't/*.txt', ], test_files => 't/??_*.t', ); diff --git a/lib/DBM/Deep.pm b/lib/DBM/Deep.pm index 6b7197f..c51fe40 100644 --- a/lib/DBM/Deep.pm +++ b/lib/DBM/Deep.pm @@ -1483,9 +1483,25 @@ sub DELETE { ## # Delete single key/value pair or element given plain key or array index ## - my $self = $_[0]->_get_self; - my $key = $_[1]; + my $self = shift->_get_self; + my ($key, $orig_key) = @_; + if ( my $afh = $self->_root->{audit_fh} ) { + unless ( $self->_type eq SIG_ARRAY && $key eq 'length' ) { + my $lhs = $self->_find_parent; + if ( $self->_type eq SIG_HASH ) { + $lhs .= "\{$key\}"; + } + else { + $lhs .= "\[$_[3]\]"; + } + + flock( $afh, LOCK_EX ); + print( $afh "delete $lhs; # " . localtime(time) . "\n" ); + flock( $afh, LOCK_UN ); + } + } + my $md5 = $DIGEST_FUNC->($key); ## @@ -1569,6 +1585,22 @@ sub CLEAR { ## my $self = $_[0]->_get_self; + if ( my $afh = $self->_root->{audit_fh} ) { + my $lhs = $self->_find_parent; + + my $rhs; + if ( $self->_type eq SIG_HASH ) { + $rhs = '{}'; + } + elsif ( $self->_type eq SIG_ARRAY ) { + $rhs = '[]'; + } + + flock( $afh, LOCK_EX ); + print( $afh "$lhs = $rhs; # " . localtime(time) . "\n" ); + flock( $afh, LOCK_UN ); + } + ## # Make sure file is open ## diff --git a/lib/DBM/Deep/Array.pm b/lib/DBM/Deep/Array.pm index 23189b9..614290e 100644 --- a/lib/DBM/Deep/Array.pm +++ b/lib/DBM/Deep/Array.pm @@ -136,7 +136,7 @@ sub DELETE { $key = pack($DBM::Deep::LONG_PACK, $key); } - my $rv = $self->SUPER::DELETE( $key ); + my $rv = $self->SUPER::DELETE( $key, $unpacked_key ); if ($rv && $unpacked_key == $size - 1) { $self->STORESIZE( $unpacked_key ); diff --git a/lib/DBM/Deep/Hash.pm b/lib/DBM/Deep/Hash.pm index 0c0e909..31af528 100644 --- a/lib/DBM/Deep/Hash.pm +++ b/lib/DBM/Deep/Hash.pm @@ -36,7 +36,7 @@ sub STORE { : $_[0]; my $value = $_[1]; - return $self->SUPER::STORE( $key, $value ); + return $self->SUPER::STORE( $key, $value, $_[0] ); } sub EXISTS { @@ -54,7 +54,7 @@ sub DELETE { ? $self->_root->{filter_store_key}->($_[0]) : $_[0]; - return $self->SUPER::DELETE( $key ); + return $self->SUPER::DELETE( $key, $_[0] ); } sub FIRSTKEY { diff --git a/t/50_audit_trail.t b/t/50_audit_trail.t index 1042504..230b5d2 100644 --- a/t/50_audit_trail.t +++ b/t/50_audit_trail.t @@ -38,7 +38,7 @@ $|=1; sub STORESIZE {} } -use Test::More tests => 16; +use Test::More tests => 20; use_ok( 'DBM::Deep' ); @@ -113,3 +113,59 @@ undef $db; is_deeply( $export2, $export, "And recovery works" ); } + +{ + $db = DBM::Deep->new({ + file => 't/test.db', + audit_file => $audit_file, + }); + + delete $db->{baz}; + like( $audit[13], qr{delete \$db->{baz};}, "Deleting works" ); + + $export = $db->export; +} + +{ + unlink 't/test2.db'; + my $db = DBM::Deep->new({ + file => 't/test2.db', + }); + + for ( @audit ) { + eval "$_"; + } + + my $export2 = $db->export; + + is_deeply( $export2, $export, "And recovery works" ); +} + +{ + $db = DBM::Deep->new({ + file => 't/test.db', + audit_file => $audit_file, + }); + + $db->{bar}->clear; + like( $audit[14], qr{\$db->{bar} = \{\};}, "Clearing works" ); + + $export = $db->export; +} + +{ + unlink 't/test2.db'; + my $db = DBM::Deep->new({ + file => 't/test2.db', + }); + + for ( @audit ) { + eval "$_"; + } + + my $export2 = $db->export; + + is_deeply( $export2, $export, "And recovery works" ); +} + +