cached singletons for most cases. The external reference issue is starting to come...

diff --git a/Changes b/Changes
index 7d732fe..6bc7c2e 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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</CIRCULAR REFERENCES>
-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<my $x = $db-E<gt>{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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (executable)
--- 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 {