Revision history for DBM::Deep.
-0.981_01 Mar 06 11:00:00 2006 Pacific
+0.981_02 Mar 06 19:00:00 2006 Pacific
+ - Added support for blessed objects in the auditlog
+
+0.981_01 Mar 06 14:00:00 2006 Pacific
- Added experimental auditlog support. This will only be released as a
developer released in the 0.x line because of the hackish nature of the
change.
use Scalar::Util ();
use vars qw( $VERSION );
-$VERSION = q(0.981_01);
+$VERSION = q(0.981_02);
##
# Set to 4 and 'N' for 32-bit offset tags (default). Theoretical limit of 4 GB per file.
$rhs = "'$_[2]'";
}
+ if ( my $c = Scalar::Util::blessed( $_[2] ) ) {
+ $rhs = "bless $rhs, '$c'";
+ }
+
flock( $afh, LOCK_EX );
print( $afh "$lhs = $rhs; # " . localtime(time) . "\n" );
flock( $afh, LOCK_UN );
sub STORESIZE {}
}
-use Test::More tests => 20;
+use Test::More tests => 24;
use_ok( 'DBM::Deep' );
is_deeply( $export2, $export, "And recovery works" );
}
+{
+ $db = DBM::Deep->new({
+ file => 't/test.db',
+ audit_file => $audit_file,
+ });
+
+ $db->{blessed} = bless { a => 5, b => 3 }, 'Floober';
+ like( $audit[15], qr{\$db->{blessed} = bless {}, 'Floober';},
+ "Assignment of a blessed reference works" );
+ like( $audit[16], qr{\$db->{blessed}{a} = '5';}, "... child 1" );
+ like( $audit[17], qr{\$db->{blessed}{b} = '3';}, "... child 2" );
+ $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" );
+}