The refcount functions have been refactored a bit

diff --git a/Changes b/Changes
index 88d6092..a7cd00f 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,10 +1,11 @@
 Revision history for DBM::Deep.
 
 1.0004 Sep 25 00:00:00 2007 EDT
-    - Fixed the Changes file
+    - Fixed the Changes file (wrong version was displayed for 1.0003)
     - Added filter sugar methods to be more API-compatible with other DBMs
-    - Implemented _dump_file in order to display the file structure.
-      - Arrays now clean up after themselves better.
+    - Implemented _dump_file in order to display the file structure. As a
+      result, the following bugs are fixed:
+      - Arrays and hashes now clean up after themselves better.
       - Bucketlists now clean up after themselves better.
       - Reindexing properly clears the old bucketlist before freeing it.
 

diff --git a/lib/DBM/Deep.pm b/lib/DBM/Deep.pm
index 34091e7..40028f2 100644 (file)
--- a/lib/DBM/Deep.pm
+++ b/lib/DBM/Deep.pm
@@ -557,10 +557,7 @@ sub delete { (shift)->DELETE( @_ ) }
 sub exists { (shift)->EXISTS( @_ ) }
 sub clear { (shift)->CLEAR( @_ ) }
 
-sub _dump_file {
-    my $self = shift->_get_self;
-    return $self->_engine->_dump_file;
-}
+sub _dump_file {shift->_get_self->_engine->_dump_file;}
 
 1;
 __END__

diff --git a/lib/DBM/Deep/Engine.pm b/lib/DBM/Deep/Engine.pm
index bc63b76..6d14136 100644 (file)
--- a/lib/DBM/Deep/Engine.pm
+++ b/lib/DBM/Deep/Engine.pm
@@ -1715,20 +1715,11 @@ sub data {
 sub increment_refcount {
     my $self = shift;
 
-    my $e = $self->engine;
-    my $refcount = unpack(
-        $StP{$e->byte_size},
-        $e->storage->read_at(
-            $self->offset + $self->base_size + 2 * $e->byte_size, $e->byte_size,
-        ),
-    );
+    my $refcount = $self->get_refcount;
 
     $refcount++;
 
-    $e->storage->print_at(
-        $self->offset + $self->base_size + 2 * $e->byte_size,
-        pack( $StP{$e->byte_size}, $refcount ),
-    );
+    $self->write_refcount( $refcount );
 
     return $refcount;
 }
@@ -1736,20 +1727,11 @@ sub increment_refcount {
 sub decrement_refcount {
     my $self = shift;
 
-    my $e = $self->engine;
-    my $refcount = unpack(
-        $StP{$e->byte_size},
-        $e->storage->read_at(
-            $self->offset + $self->base_size + 2 * $e->byte_size, $e->byte_size,
-        ),
-    );
+    my $refcount = $self->get_refcount;
 
     $refcount--;
 
-    $e->storage->print_at(
-        $self->offset + $self->base_size + 2 * $e->byte_size,
-        pack( $StP{$e->byte_size}, $refcount ),
-    );
+    $self->write_refcount( $refcount );
 
     return $refcount;
 }
@@ -1766,6 +1748,17 @@ sub get_refcount {
     );
 }
 
+sub write_refcount {
+    my $self = shift;
+    my ($num) = @_;
+
+    my $e = $self->engine;
+    $e->storage->print_at(
+        $self->offset + $self->base_size + 2 * $e->byte_size,
+        pack( $StP{$e->byte_size}, $num ),
+    );
+}
+
 package DBM::Deep::Engine::Sector::BucketList;
 
 our @ISA = qw( DBM::Deep::Engine::Sector );

diff --git a/t/100_dump_file.t b/t/100_dump_file.t
index d7abaae..a99e73f 100644 (file)
--- a/t/100_dump_file.t
+++ b/t/100_dump_file.t
@@ -14,7 +14,7 @@ my $db = DBM::Deep->new(
 );
 
 $db->{foo} = [];
-#$db->{bar} = $db->{foo};
+$db->{bar} = $db->{foo};
 
 warn -s $filename, $/;
 warn $db->_dump_file, $/;
@@ -22,7 +22,7 @@ warn $db->_dump_file, $/;
 $db->begin_work;
 
     delete $db->{foo};
-#    delete $db->{bar};
+    delete $db->{bar};
 
     warn -s $filename, $/;
     warn $db->_dump_file, $/;
@@ -33,3 +33,8 @@ $db->commit;
 
 warn -s $filename, $/;
 warn $db->_dump_file, $/;
+
+$db->{foo} = 1;
+
+warn -s $filename, $/;
+warn $db->_dump_file, $/;

diff --git a/t/44_upgrade_db.t b/t/44_upgrade_db.t
index 04be1c9..c39d153 100644 (file)
--- a/t/44_upgrade_db.t
+++ b/t/44_upgrade_db.t
@@ -13,7 +13,7 @@ BEGIN {
     }
 }
 
-plan tests => 192;
+plan tests => 202;
 
 use t::common qw( new_fh );
 use File::Spec;
@@ -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.0003', '1.0004',
 );
 
 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[3]/ ) {
+        elsif ( $v =~ /^1\.000[34]/ ) {
             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 9b64ced..960abce 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.0003',
+  version => '1.0004',
   autobless => 1,
 );
 GetOptions( \%opts,
@@ -77,7 +77,7 @@ my %db;
   elsif ( $ver =~ /^1\.000?[0-2]?/) {
     $ver = 2;
   }
-  elsif ( $ver =~ /^1\.000[3]/) {
+  elsif ( $ver =~ /^1\.000[34]/) {
     $ver = 3;
   }
   else {