From: rkinyon Date: Sun, 30 Sep 2007 17:59:07 +0000 (+0000) Subject: cached singletons for most cases. The external reference issue is starting to come... X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=ef3cf62eb21b5c46498744fabf86f5fd0f996759;p=dbsrgits%2FDBM-Deep.git cached singletons for most cases. The external reference issue is starting to come into larger focus --- diff --git a/Changes b/Changes index 7d732fe..6bc7c2e 100644 --- a/Changes +++ b/Changes @@ -6,7 +6,7 @@ Revision history for DBM::Deep. $db->{foo} = [ 1 .. 3]; my $x = $db->{foo}; my $y = $db->{foo}; - is( $x == $y ); # Now passes + is( $x, $y ); # Now passes - This means that Data::Dumper now properly reports when $db->{foo} = $db->{bar} 1.0004 Sep 28 12:15:00 2007 EDT diff --git a/lib/DBM/Deep.pm b/lib/DBM/Deep.pm index 2c1b190..8eb36b9 100644 --- a/lib/DBM/Deep.pm +++ b/lib/DBM/Deep.pm @@ -5,7 +5,7 @@ use 5.006_000; use strict; use warnings; -our $VERSION = q(1.0004); +our $VERSION = q(1.0005); use Fcntl qw( :flock ); @@ -17,6 +17,10 @@ use Scalar::Util (); use DBM::Deep::Engine; use DBM::Deep::File; +use overload + '""' => sub { overload::StrVal( $_[0] ) }, + fallback => 1; + ## # Setup constants for users to pass to new() ## diff --git a/lib/DBM/Deep.pod b/lib/DBM/Deep.pod index 8b4b689..2405b25 100644 --- a/lib/DBM/Deep.pod +++ b/lib/DBM/Deep.pod @@ -945,12 +945,13 @@ the reference. Again, this would generally be considered a feature. =back -=head2 Data::Dumper and references +=head2 External references and transactions -As of 1.0003, support for independent Perl datastructures was added (q.v. L -for more info). However, because DBM::Deep doesn't properly provide the same -in-memory data-structure for a given location on disk, Data::Dumper (and -friends) doesn't properly note this. This will be addressed in a future release. +If you do C{foo};>, then start a transaction, $x will be +referencing the database from outside the transaction. A fix for this (and other +issues with how external references into the database) is being looked into. This +is the skipped set of tests in t/39_singletons.t and a related issue is the focus +of t/37_delete_edge_cases.t =head2 File corruption diff --git a/lib/DBM/Deep/Array.pm b/lib/DBM/Deep/Array.pm index f9b9af2..eb092ac 100644 --- a/lib/DBM/Deep/Array.pm +++ b/lib/DBM/Deep/Array.pm @@ -5,7 +5,7 @@ use 5.006_000; use strict; use warnings; -our $VERSION = q(1.0004); +our $VERSION = q(1.0005); # This is to allow DBM::Deep::Array to handle negative indices on # its own. Otherwise, Perl would intercept the call to negative diff --git a/lib/DBM/Deep/Engine.pm b/lib/DBM/Deep/Engine.pm index bae762a..f8656a3 100644 --- a/lib/DBM/Deep/Engine.pm +++ b/lib/DBM/Deep/Engine.pm @@ -5,7 +5,7 @@ use 5.006_000; use strict; use warnings; -our $VERSION = q(1.0004); +our $VERSION = q(1.0005); use Scalar::Util (); @@ -1720,9 +1720,9 @@ sub free { } # Rebless the object into DBM::Deep::Null. - my $x = $self->engine->cache->{ $self->offset }; %{ $self->engine->cache->{ $self->offset } } = (); bless $self->engine->cache->{ $self->offset }, 'DBM::Deep::Null'; + delete $self->engine->cache->{ $self->offset }; my $blist_loc = $self->get_blist_loc; $self->engine->_load_sector( $blist_loc )->free if $blist_loc; diff --git a/lib/DBM/Deep/File.pm b/lib/DBM/Deep/File.pm index ccedf04..6571c2e 100644 --- a/lib/DBM/Deep/File.pm +++ b/lib/DBM/Deep/File.pm @@ -5,7 +5,7 @@ use 5.006_000; use strict; use warnings; -our $VERSION = q(1.0004); +our $VERSION = q(1.0005); use Fcntl qw( :DEFAULT :flock :seek ); diff --git a/lib/DBM/Deep/Hash.pm b/lib/DBM/Deep/Hash.pm index b703705..a342d62 100644 --- a/lib/DBM/Deep/Hash.pm +++ b/lib/DBM/Deep/Hash.pm @@ -5,7 +5,7 @@ use 5.006_000; use strict; use warnings; -our $VERSION = q(1.0004); +our $VERSION = q(1.0005); use base 'DBM::Deep'; diff --git a/t/33_transactions.t b/t/33_transactions.t index cdf18ad..1edd082 100644 --- a/t/33_transactions.t +++ b/t/33_transactions.t @@ -233,7 +233,3 @@ SKIP: { } __END__ - -Tests to add: -* Two transactions running at the same time -* Doing a clear on the head while a transaction is running diff --git a/t/39_singletons.t b/t/39_singletons.t index 9f7a5ea..45afc60 100644 --- a/t/39_singletons.t +++ b/t/39_singletons.t @@ -1,38 +1,64 @@ use strict; -use Test::More tests => 9; +use Test::More tests => 11; use Test::Deep; use t::common qw( new_fh ); use_ok( 'DBM::Deep' ); -my ($fh, $filename) = new_fh(); -my $db = DBM::Deep->new( - file => $filename, - locking => 1, - autoflush => 1, -); - -$db->{a} = 1; -$db->{foo} = { a => 'b' }; -my $x = $db->{foo}; -my $y = $db->{foo}; - -is( $x, $y, "The references are the same" ); - -delete $db->{foo}; -is( $x, undef ); -is( $y, undef ); -warn "$x\n"; -is( $x + 0, 0 ); -is( $y + 0, 0 ); -is( $db->{foo}, undef ); - -# These shenanigans work to get another hashref -# into the same data location as $db->{foo} was. -$db->{foo} = {}; -delete $db->{foo}; -$db->{foo} = {}; -$db->{bar} = {}; - -is( $x, undef ); -is( $y, undef ); +{ + my ($fh, $filename) = new_fh(); + my $db = DBM::Deep->new( + file => $filename, + locking => 1, + autoflush => 1, + ); + + $db->{a} = 1; + $db->{foo} = { a => 'b' }; + my $x = $db->{foo}; + my $y = $db->{foo}; + + is( $x, $y, "The references are the same" ); + + delete $db->{foo}; + is( $x, undef ); + is( $y, undef ); + is( $x + 0, undef ); + is( $y + 0, undef ); + is( $db->{foo}, undef ); + + # These shenanigans work to get another hashref + # into the same data location as $db->{foo} was. + $db->{foo} = {}; + delete $db->{foo}; + $db->{foo} = {}; + $db->{bar} = {}; + + is( $x, undef ); + is( $y, undef ); +} + +SKIP: { + skip "What do we do with external references and txns?", 2; + my ($fh, $filename) = new_fh(); + my $db = DBM::Deep->new( + file => $filename, + locking => 1, + autoflush => 1, + num_txns => 2, + ); + + $db->{foo} = { a => 'b' }; + my $x = $db->{foo}; + + $db->begin_work; + + $db->{foo} = { c => 'd' }; + my $y = $db->{foo}; + + # XXX What should happen here with $x and $y? + is( $x, $y ); + is( $x->{c}, 'd' ); + + $db->rollback; +} diff --git a/t/44_upgrade_db.t b/t/44_upgrade_db.t index c39d153..e069990 100644 --- a/t/44_upgrade_db.t +++ b/t/44_upgrade_db.t @@ -63,7 +63,7 @@ my @output_versions = ( '0.981', '0.982', '0.983', '0.99_01', '0.99_02', '0.99_03', '0.99_04', '1.00', '1.000', '1.0000', '1.0001', '1.0002', - '1.0003', '1.0004', + '1.0003', '1.0004', '1.0005', ); foreach my $input_filename ( @@ -117,7 +117,7 @@ foreach my $input_filename ( eval "use DBM::Deep::10002"; $db = DBM::Deep::10002->new( $output_filename ); } - elsif ( $v =~ /^1\.000[34]/ ) { + elsif ( $v =~ /^1\.000[3-5]/ ) { push @INC, 'lib'; eval "use DBM::Deep"; $db = DBM::Deep->new( $output_filename ); diff --git a/utils/upgrade_db.pl b/utils/upgrade_db.pl index 960abce..3a7c86d 100755 --- a/utils/upgrade_db.pl +++ b/utils/upgrade_db.pl @@ -28,7 +28,7 @@ my %is_dev = ( my %opts = ( man => 0, help => 0, - version => '1.0004', + version => '1.0005', autobless => 1, ); GetOptions( \%opts, @@ -77,7 +77,7 @@ my %db; elsif ( $ver =~ /^1\.000?[0-2]?/) { $ver = 2; } - elsif ( $ver =~ /^1\.000[34]/) { + elsif ( $ver =~ /^1\.000[3-5]/) { $ver = 3; } else {