Txn counter handlers have been migrated to FileHeader and a DESTROY has been added...

git-svn-id: http://svn.ali.as/cpan/trunk/DBM-Deep@3642 88f4d9cd-8a04-0410-9d60-8f63309c3137

diff --git a/lib/DBM/Deep.pm b/lib/DBM/Deep.pm
index 7beb838..56ecc0c 100644 (file)
--- a/lib/DBM/Deep.pm
+++ b/lib/DBM/Deep.pm
@@ -76,6 +76,15 @@ sub new {
     return bless $self, $class;
 }
 
+sub DESTROY {
+    my $self = shift;
+
+    # If we have an error, don't flush - we might be flushing bad stuff. -RobK, 2008-06-26
+    die $@ if $@;
+
+    $self->_get_self->_engine->flush;
+}
+
 # This initializer is called from the various TIE* methods. new() calls tie(),
 # which allows for a single point of entry.
 sub _init {

diff --git a/lib/DBM/Deep/Engine.pm b/lib/DBM/Deep/Engine.pm
index 7edcd05..6524561 100644 (file)
--- a/lib/DBM/Deep/Engine.pm
+++ b/lib/DBM/Deep/Engine.pm
@@ -567,15 +567,12 @@ sub commit {
 
 sub read_txn_slots {
     my $self = shift;
-    return $self->_load_header->read_txn_slots;
+    return $self->_load_header->read_txn_slots(@_);
 }
 
 sub write_txn_slots {
     my $self = shift;
-    my $num_bits = $self->txn_bitfield_len * 8;
-    $self->storage->print_at( $self->trans_loc,
-        pack( 'b'.$num_bits, join('', @_) ),
-    );
+    return $self->_load_header->write_txn_slots(@_);
 }
 
 sub get_running_txn_ids {
@@ -586,30 +583,12 @@ sub get_running_txn_ids {
 
 sub get_txn_staleness_counter {
     my $self = shift;
-    my ($trans_id) = @_;
-
-    # Hardcode staleness of 0 for the HEAD
-    return 0 unless $trans_id;
-
-    return unpack( $StP{$STALE_SIZE},
-        $self->storage->read_at(
-            $self->trans_loc + $self->txn_bitfield_len + $STALE_SIZE * ($trans_id - 1),
-            $STALE_SIZE,
-        )
-    );
+    return $self->_load_header->get_txn_staleness_counter(@_);
 }
 
 sub inc_txn_staleness_counter {
     my $self = shift;
-    my ($trans_id) = @_;
-
-    # Hardcode staleness of 0 for the HEAD
-    return 0 unless $trans_id;
-
-    $self->storage->print_at(
-        $self->trans_loc + $self->txn_bitfield_len + $STALE_SIZE * ($trans_id - 1),
-        pack( $StP{$STALE_SIZE}, $self->get_txn_staleness_counter( $trans_id ) + 1 ),
-    );
+    return $self->_load_header->inc_txn_staleness_counter(@_);
 }
 
 sub get_entries {

diff --git a/lib/DBM/Deep/Engine/Sector/FileHeader.pm b/lib/DBM/Deep/Engine/Sector/FileHeader.pm
index 2cc2c65..ea14d9e 100644 (file)
--- a/lib/DBM/Deep/Engine/Sector/FileHeader.pm
+++ b/lib/DBM/Deep/Engine/Sector/FileHeader.pm
@@ -201,5 +201,44 @@ sub read_txn_slots {
     return split '', unpack( 'b'.$num_bits, $self->read( $e->trans_loc, $bl ) );
 }
 
+sub write_txn_slots {
+    my $self = shift;
+    my $e = $self->engine;
+    my $num_bits = $e->txn_bitfield_len * 8;
+    $self->write( $e->trans_loc,
+        pack( 'b'.$num_bits, join('', @_) ),
+    );
+}
+
+sub get_txn_staleness_counter {
+    my $self = shift;
+    my ($trans_id) = @_;
+
+    # Hardcode staleness of 0 for the HEAD
+    return 0 unless $trans_id;
+
+    my $e = $self->engine;
+    return unpack( $e->StP($DBM::Deep::Engine::STALE_SIZE),
+        $self->read(
+            $e->trans_loc + $e->txn_bitfield_len + $DBM::Deep::Engine::STALE_SIZE * ($trans_id - 1),
+            $DBM::Deep::Engine::STALE_SIZE,
+        )
+    );
+}
+
+sub inc_txn_staleness_counter {
+    my $self = shift;
+    my ($trans_id) = @_;
+
+    # Hardcode staleness of 0 for the HEAD
+    return 0 unless $trans_id;
+
+    my $e = $self->engine;
+    $self->write(
+        $e->trans_loc + $e->txn_bitfield_len + $DBM::Deep::Engine::STALE_SIZE * ($trans_id - 1),
+        pack( $e->StP($DBM::Deep::Engine::STALE_SIZE), $self->get_txn_staleness_counter( $trans_id ) + 1 ),
+    );
+}
+
 1;
 __END__

diff --git a/t/26_scalar_ref.t b/t/26_scalar_ref.t
index 30237ec..7f6e3e7 100644 (file)
--- a/t/26_scalar_ref.t
+++ b/t/26_scalar_ref.t
@@ -32,9 +32,7 @@ my $x = 25;
     } qr/Storage of references of type 'GLOB' is not supported/,
     'Storage of glob refs not supported';
 
-    warn "\n1: " . $db->_engine->_dump_file;
     $db->{scalar} = $x;
-    warn "\n2: " . $db->_engine->_dump_file;
     TODO: {
         todo_skip "Refs to DBM::Deep objects aren't implemented yet", 2;
         lives_ok {
@@ -43,8 +41,6 @@ my $x = 25;
 
         is( ${$db->{selfref}}, $x, "A ref to a DBM::Deep object is ok" );
     }
-
-    warn $db->_engine->_dump_file;
 }
 
 {