},
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',
);
##
# 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);
##
##
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
##
$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 );
: $_[0];
my $value = $_[1];
- return $self->SUPER::STORE( $key, $value );
+ return $self->SUPER::STORE( $key, $value, $_[0] );
}
sub EXISTS {
? $self->_root->{filter_store_key}->($_[0])
: $_[0];
- return $self->SUPER::DELETE( $key );
+ return $self->SUPER::DELETE( $key, $_[0] );
}
sub FIRSTKEY {
sub STORESIZE {}
}
-use Test::More tests => 16;
+use Test::More tests => 20;
use_ok( 'DBM::Deep' );
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" );
+}
+
+