Final fixes before releasing last developer release

[dbsrgits/DBM-Deep.git] / lib / DBM / Deep / Engine / File.pm

diff --git a/lib/DBM/Deep/Engine/File.pm b/lib/DBM/Deep/Engine/File.pm
index 878f436..0af33b8 100644 (file)
--- a/lib/DBM/Deep/Engine/File.pm
+++ b/lib/DBM/Deep/Engine/File.pm
@@ -4,6 +4,7 @@ use 5.006_000;
 
 use strict;
 use warnings FATAL => 'all';
+no warnings 'recursion';
 
 use base qw( DBM::Deep::Engine );
 
@@ -13,8 +14,22 @@ use DBM::Deep::Null ();
 use DBM::Deep::Sector::File ();
 use DBM::Deep::Storage::File ();
 
+sub sector_type { 'DBM::Deep::Sector::File' }
+sub iterator_class { 'DBM::Deep::Iterator::File' }
+
 my $STALE_SIZE = 2;
 
+# Setup file and tag signatures.  These should never change.
+sub SIG_FILE     () { 'DPDB' }
+sub SIG_HEADER   () { 'h'    }
+sub SIG_NULL     () { 'N'    }
+sub SIG_DATA     () { 'D'    }
+sub SIG_INDEX    () { 'I'    }
+sub SIG_BLIST    () { 'B'    }
+sub SIG_FREE     () { 'F'    }
+sub SIG_SIZE     () {  1     }
+# SIG_HASH and SIG_ARRAY are defined in DBM::Deep::Engine
+
 # Please refer to the pack() documentation for further information
 my %StP = (
     1 => 'C', # Unsigned char value (no order needed as it's just one byte)
@@ -29,7 +44,7 @@ DBM::Deep::Engine::File
 
 =head1 PURPOSE
 
-This is the engine for use with L<DBM::Deep::Storage::File/>.
+This is the engine for use with L<DBM::Deep::Storage::File>.
 
 =head1 EXTERNAL METHODS
 
@@ -121,7 +136,7 @@ sub read_value {
     my ($obj, $key) = @_;
 
     # This will be a Reference sector
-    my $sector = DBM::Deep::Sector::File->load( $self, $obj->_base_offset )
+    my $sector = $self->load_sector( $obj->_base_offset )
         or return;
 
     if ( $sector->staleness != $obj->_staleness ) {
@@ -156,7 +171,7 @@ sub get_classname {
     my ($obj) = @_;
 
     # This will be a Reference sector
-    my $sector = DBM::Deep::Sector::File->load( $self, $obj->_base_offset )
+    my $sector = $self->load_sector( $obj->_base_offset )
         or DBM::Deep->_throw_error( "How did get_classname fail (no sector for '$obj')?!" );
 
     if ( $sector->staleness != $obj->_staleness ) {
@@ -171,7 +186,7 @@ sub make_reference {
     my ($obj, $old_key, $new_key) = @_;
 
     # This will be a Reference sector
-    my $sector = DBM::Deep::Sector::File->load( $self, $obj->_base_offset )
+    my $sector = $self->load_sector( $obj->_base_offset )
         or DBM::Deep->_throw_error( "How did make_reference fail (no sector for '$obj')?!" );
 
     if ( $sector->staleness != $obj->_staleness ) {
@@ -217,12 +232,13 @@ sub make_reference {
     return;
 }
 
+# exists returns '', not undefined.
 sub key_exists {
     my $self = shift;
     my ($obj, $key) = @_;
 
     # This will be a Reference sector
-    my $sector = DBM::Deep::Sector::File->load( $self, $obj->_base_offset )
+    my $sector = $self->load_sector( $obj->_base_offset )
         or return '';
 
     if ( $sector->staleness != $obj->_staleness ) {
@@ -242,7 +258,7 @@ sub delete_key {
     my $self = shift;
     my ($obj, $key) = @_;
 
-    my $sector = DBM::Deep::Sector::File->load( $self, $obj->_base_offset )
+    my $sector = $self->load_sector( $obj->_base_offset )
         or return;
 
     if ( $sector->staleness != $obj->_staleness ) {
@@ -271,7 +287,7 @@ sub write_value {
     }
 
     # This will be a Reference sector
-    my $sector = DBM::Deep::Sector::File->load( $self, $obj->_base_offset )
+    my $sector = $self->load_sector( $obj->_base_offset )
         or DBM::Deep->_throw_error( "Cannot write to a deleted spot in DBM::Deep." );
 
     if ( $sector->staleness != $obj->_staleness ) {
@@ -313,7 +329,7 @@ sub write_value {
             }
 
             #XXX Can this use $loc?
-            my $value_sector = DBM::Deep::Sector::File->load( $self, $tmpvar->_base_offset );
+            my $value_sector = $self->load_sector( $tmpvar->_base_offset );
             $sector->write_data({
                 key     => $key,
                 key_md5 => $self->_apply_digest( $key ),
@@ -348,35 +364,7 @@ sub write_value {
         value   => $value_sector,
     });
 
-    # This code is to make sure we write all the values in the $value to the
-    # disk and to make sure all changes to $value after the assignment are
-    # reflected on disk. This may be counter-intuitive at first, but it is
-    # correct dwimmery.
-    #   NOTE - simply tying $value won't perform a STORE on each value. Hence,
-    # the copy to a temp value.
-    if ( $r eq 'ARRAY' ) {
-        my @temp = @$value;
-        tie @$value, 'DBM::Deep', {
-            base_offset => $value_sector->offset,
-            staleness   => $value_sector->staleness,
-            storage     => $self->storage,
-            engine      => $self,
-        };
-        @$value = @temp;
-        bless $value, 'DBM::Deep::Array' unless Scalar::Util::blessed( $value );
-    }
-    elsif ( $r eq 'HASH' ) {
-        my %temp = %$value;
-        tie %$value, 'DBM::Deep', {
-            base_offset => $value_sector->offset,
-            staleness   => $value_sector->staleness,
-            storage     => $self->storage,
-            engine      => $self,
-        };
-
-        %$value = %temp;
-        bless $value, 'DBM::Deep::Hash' unless Scalar::Util::blessed( $value );
-    }
+    $self->_descend( $value, $value_sector );
 
     return 1;
 }
@@ -480,7 +468,7 @@ sub rollback {
         $self->storage->print_at( $read_loc, pack( $StP{$self->byte_size}, 0 ) );
 
         if ( $data_loc > 1 ) {
-            DBM::Deep::Sector::File->load( $self, $data_loc )->free;
+            $self->load_sector( $data_loc )->free;
         }
     }
 
@@ -524,7 +512,7 @@ sub commit {
         );
 
         if ( $head_loc > 1 ) {
-            DBM::Deep::Sector::File->load( $self, $head_loc )->free;
+            $self->load_sector( $head_loc )->free;
         }
     }
 
@@ -948,8 +936,6 @@ The following are readonly attributes.
 
 =over 4
 
-=item * storage
-
 =item * byte_size
 
 =item * hash_size
@@ -970,7 +956,6 @@ The following are readonly attributes.
 
 =cut
 
-sub storage     { $_[0]{storage} }
 sub byte_size   { $_[0]{byte_size} }
 sub hash_size   { $_[0]{hash_size} }
 sub hash_chars  { $_[0]{hash_chars} }
@@ -1017,8 +1002,28 @@ sub set_trans_loc { $_[0]{trans_loc} = $_[1] }
 sub chains_loc     { $_[0]{chains_loc} }
 sub set_chains_loc { $_[0]{chains_loc} = $_[1] }
 
-sub cache       { $_[0]{cache} ||= {} }
-sub clear_cache { %{$_[0]->cache} = () }
+sub supports {
+    shift;
+    my ($feature) = @_;
+
+    return 1 if $feature eq 'transactions';
+    return if $feature eq 'singletones';
+    return;
+}
+
+sub clear {
+    my $self = shift;
+    my $obj = shift;
+
+    my $sector = $self->load_sector( $obj->_base_offset )
+        or return;
+
+    return unless $sector->staleness == $obj->_staleness;
+
+    $sector->clear;
+
+    return;
+}
 
 =head2 _dump_file()
 
@@ -1076,7 +1081,7 @@ sub _dump_file {
     SECTOR:
     while ( $spot < $self->storage->{end} ) {
         # Read each sector in order.
-        my $sector = DBM::Deep::Sector::File->load( $self, $spot );
+        my $sector = $self->load_sector( $spot );
         if ( !$sector ) {
             # Find it in the free-sectors that were found already
             foreach my $type ( keys %sectors ) {