From: rkinyon@cpan.org <rkinyon@cpan.org>
Date: Mon, 16 Jun 2008 02:03:28 +0000 (+0000)
Subject: DBM/Deep.pm no longer has a link to _storage. Instead, it goes through _engine now... 
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=f1879fdcbb79887d707ed56336f03e70c6e5809b;p=dbsrgits%2FDBM-Deep.git

DBM/Deep.pm no longer has a link to _storage. Instead, it goes through _engine now. This is so that all locks and unlocks go through _engine so that it can flush all dirty sectors to disk.

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

diff --git a/lib/DBM/Deep.pm b/lib/DBM/Deep.pm
index d102d36..8572137 100644
--- a/lib/DBM/Deep.pm
+++ b/lib/DBM/Deep.pm
@@ -82,9 +82,6 @@ sub _init {
     my $class = shift;
     my ($args) = @_;
 
-    $args->{storage} = DBM::Deep::File->new( $args )
-        unless exists $args->{storage};
-
     # locking implicitly enables autoflush
     if ($args->{locking}) { $args->{autoflush} = 1; }
 
@@ -93,8 +90,6 @@ sub _init {
         type        => TYPE_HASH,
         base_offset => undef,
         staleness   => undef,
-
-        storage     => undef,
         engine      => undef,
     }, $class;
 
@@ -112,7 +107,6 @@ sub _init {
 
       $self->lock_exclusive;
       $self->_engine->setup_fh( $self );
-      $self->_storage->set_inode;
       $self->unlock;
     }; if ( $@ ) {
       my $e = $@;
@@ -137,17 +131,17 @@ sub TIEARRAY {
 
 sub lock_exclusive {
     my $self = shift->_get_self;
-    return $self->_storage->lock_exclusive( $self );
+    return $self->_engine->lock_exclusive( $self );
 }
 *lock = \&lock_exclusive;
 sub lock_shared {
     my $self = shift->_get_self;
-    return $self->_storage->lock_shared( $self );
+    return $self->_engine->lock_shared( $self );
 }
 
 sub unlock {
     my $self = shift->_get_self;
-    return $self->_storage->unlock( $self );
+    return $self->_engine->unlock( $self );
 }
 
 sub _copy_value {
@@ -311,14 +305,14 @@ sub optimize {
     my $self = shift->_get_self;
 
 #XXX Need to create a new test for this
-#    if ($self->_storage->{links} > 1) {
+#    if ($self->_engine->storage->{links} > 1) {
 #        $self->_throw_error("Cannot optimize: reference count is greater than 1");
 #    }
 
     #XXX Do we have to lock the tempfile?
 
     #XXX Should we use tempfile() here instead of a hard-coded name?
-    my $temp_filename = $self->_storage->{file} . '.tmp';
+    my $temp_filename = $self->_engine->storage->{file} . '.tmp';
     my $db_temp = DBM::Deep->new(
         file => $temp_filename,
         type => $self->_type,
@@ -332,13 +326,13 @@ sub optimize {
     $self->lock_exclusive;
     $self->_engine->clear_cache;
     $self->_copy_node( $db_temp );
-    $db_temp->_storage->close;
+    $db_temp->_engine->storage->close;
     undef $db_temp;
 
     ##
     # Attempt to copy user, group and permissions over to new file
     ##
-    $self->_storage->copy_stats( $temp_filename );
+    $self->_engine->storage->copy_stats( $temp_filename );
 
     # q.v. perlport for more information on this variable
     if ( $^O eq 'MSWin32' || $^O eq 'cygwin' ) {
@@ -349,19 +343,19 @@ sub optimize {
         # with a soft copy.
         ##
         $self->unlock;
-        $self->_storage->close;
+        $self->_engine->storage->close;
     }
 
-    if (!rename $temp_filename, $self->_storage->{file}) {
+    if (!rename $temp_filename, $self->_engine->storage->{file}) {
         unlink $temp_filename;
         $self->unlock;
         $self->_throw_error("Optimize failed: Cannot copy temp file over original: $!");
     }
 
     $self->unlock;
-    $self->_storage->close;
+    $self->_engine->storage->close;
 
-    $self->_storage->open;
+    $self->_engine->storage->open;
     $self->lock_exclusive;
     $self->_engine->setup_fh( $self );
     $self->unlock;
@@ -379,7 +373,6 @@ sub clone {
         type        => $self->_type,
         base_offset => $self->_base_offset,
         staleness   => $self->_staleness,
-        storage     => $self->_storage,
         engine      => $self->_engine,
     );
 }
@@ -400,7 +393,7 @@ sub clone {
         my $func = shift;
 
         if ( $is_legal_filter{$type} ) {
-            $self->_storage->{"filter_$type"} = $func;
+            $self->_engine->storage->{"filter_$type"} = $func;
             return 1;
         }
 
@@ -437,11 +430,6 @@ sub _engine {
     return $self->{engine};
 }
 
-sub _storage {
-    my $self = $_[0]->_get_self;
-    return $self->{storage};
-}
-
 sub _type {
     my $self = $_[0]->_get_self;
     return $self->{type};
@@ -479,7 +467,7 @@ sub STORE {
     my ($key, $value) = @_;
     warn "STORE($self, $key, $value)\n" if DEBUG;
 
-    unless ( $self->_storage->is_writable ) {
+    unless ( $self->_engine->storage->is_writable ) {
         $self->_throw_error( 'Cannot write to a readonly filehandle' );
     }
 
@@ -487,8 +475,8 @@ sub STORE {
 
     # User may be storing a complex value, in which case we do not want it run
     # through the filtering system.
-    if ( !ref($value) && $self->_storage->{filter_store_value} ) {
-        $value = $self->_storage->{filter_store_value}->( $value );
+    if ( !ref($value) && $self->_engine->storage->{filter_store_value} ) {
+        $value = $self->_engine->storage->{filter_store_value}->( $value );
     }
 
     $self->_engine->write_value( $self, $key, $value);
@@ -514,8 +502,8 @@ sub FETCH {
 
     # Filters only apply to scalar values, so the ref check is making
     # sure the fetched bucket is a scalar, not a child hash or array.
-    return ($result && !ref($result) && $self->_storage->{filter_fetch_value})
-        ? $self->_storage->{filter_fetch_value}->($result)
+    return ($result && !ref($result) && $self->_engine->storage->{filter_fetch_value})
+        ? $self->_engine->storage->{filter_fetch_value}->($result)
         : $result;
 }
 
@@ -527,7 +515,7 @@ sub DELETE {
     my ($key) = @_;
     warn "DELETE($self,$key)\n" if DEBUG;
 
-    unless ( $self->_storage->is_writable ) {
+    unless ( $self->_engine->storage->is_writable ) {
         $self->_throw_error( 'Cannot write to a readonly filehandle' );
     }
 
@@ -538,8 +526,8 @@ sub DELETE {
     ##
     my $value = $self->_engine->delete_key( $self, $key);
 
-    if (defined $value && !ref($value) && $self->_storage->{filter_fetch_value}) {
-        $value = $self->_storage->{filter_fetch_value}->($value);
+    if (defined $value && !ref($value) && $self->_engine->storage->{filter_fetch_value}) {
+        $value = $self->_engine->storage->{filter_fetch_value}->($value);
     }
 
     $self->unlock;
@@ -571,7 +559,7 @@ sub CLEAR {
     my $self = shift->_get_self;
     warn "CLEAR($self)\n" if DEBUG;
 
-    unless ( $self->_storage->is_writable ) {
+    unless ( $self->_engine->storage->is_writable ) {
         $self->_throw_error( 'Cannot write to a readonly filehandle' );
     }
 
diff --git a/lib/DBM/Deep/Array.pm b/lib/DBM/Deep/Array.pm
index c32d215..186817b 100644
--- a/lib/DBM/Deep/Array.pm
+++ b/lib/DBM/Deep/Array.pm
@@ -177,12 +177,12 @@ sub FETCHSIZE {
 
     $self->lock_shared;
 
-    my $SAVE_FILTER = $self->_storage->{filter_fetch_value};
-    $self->_storage->{filter_fetch_value} = undef;
+    my $SAVE_FILTER = $self->_engine->storage->{filter_fetch_value};
+    $self->_engine->storage->{filter_fetch_value} = undef;
 
     my $size = $self->FETCH('length') || 0;
 
-    $self->_storage->{filter_fetch_value} = $SAVE_FILTER;
+    $self->_engine->storage->{filter_fetch_value} = $SAVE_FILTER;
 
     $self->unlock;
 
@@ -195,12 +195,12 @@ sub STORESIZE {
 
     $self->lock_exclusive;
 
-    my $SAVE_FILTER = $self->_storage->{filter_store_value};
-    $self->_storage->{filter_store_value} = undef;
+    my $SAVE_FILTER = $self->_engine->storage->{filter_store_value};
+    $self->_engine->storage->{filter_store_value} = undef;
 
     my $result = $self->STORE('length', $new_length, 'length');
 
-    $self->_storage->{filter_store_value} = $SAVE_FILTER;
+    $self->_engine->storage->{filter_store_value} = $SAVE_FILTER;
 
     $self->unlock;
 
diff --git a/lib/DBM/Deep/Engine.pm b/lib/DBM/Deep/Engine.pm
index fd7e78e..746736d 100644
--- a/lib/DBM/Deep/Engine.pm
+++ b/lib/DBM/Deep/Engine.pm
@@ -53,6 +53,9 @@ sub new {
     my $class = shift;
     my ($args) = @_;
 
+    $args->{storage} = DBM::Deep::File->new( $args )
+        unless exists $args->{storage};
+
     my $self = bless {
         byte_size   => 4,
 
@@ -443,6 +446,8 @@ sub setup_fh {
 
             $obj->{staleness} = $initial_reference->staleness;
         }
+
+        $self->storage->set_inode;
     }
 
     return 1;
@@ -872,6 +877,26 @@ sub _request_sector {
 
 ################################################################################
 
+sub lock_exclusive {
+    my $self = shift;
+    my ($obj) = @_;
+    return $self->storage->lock_exclusive( $obj );
+}
+
+sub lock_shared {
+    my $self = shift;
+    my ($obj) = @_;
+    return $self->storage->lock_shared( $obj );
+}
+
+sub unlock {
+    my $self = shift;
+    my ($obj) = @_;
+    return $self->storage->unlock( $obj );
+}
+
+################################################################################
+
 sub storage     { $_[0]{storage} }
 sub byte_size   { $_[0]{byte_size} }
 sub hash_size   { $_[0]{hash_size} }
diff --git a/lib/DBM/Deep/Hash.pm b/lib/DBM/Deep/Hash.pm
index 6d81faf..cc84b64 100644
--- a/lib/DBM/Deep/Hash.pm
+++ b/lib/DBM/Deep/Hash.pm
@@ -28,8 +28,8 @@ sub TIEHASH {
 sub FETCH {
     my $self = shift->_get_self;
     DBM::Deep->_throw_error( "Cannot use an undefined hash key." ) unless defined $_[0];
-    my $key = ($self->_storage->{filter_store_key})
-        ? $self->_storage->{filter_store_key}->($_[0])
+    my $key = ($self->_engine->storage->{filter_store_key})
+        ? $self->_engine->storage->{filter_store_key}->($_[0])
         : $_[0];
 
     return $self->SUPER::FETCH( $key, $_[0] );
@@ -38,8 +38,8 @@ sub FETCH {
 sub STORE {
     my $self = shift->_get_self;
     DBM::Deep->_throw_error( "Cannot use an undefined hash key." ) unless defined $_[0];
-    my $key = ($self->_storage->{filter_store_key})
-        ? $self->_storage->{filter_store_key}->($_[0])
+    my $key = ($self->_engine->storage->{filter_store_key})
+        ? $self->_engine->storage->{filter_store_key}->($_[0])
         : $_[0];
     my $value = $_[1];
 
@@ -49,8 +49,8 @@ sub STORE {
 sub EXISTS {
     my $self = shift->_get_self;
     DBM::Deep->_throw_error( "Cannot use an undefined hash key." ) unless defined $_[0];
-    my $key = ($self->_storage->{filter_store_key})
-        ? $self->_storage->{filter_store_key}->($_[0])
+    my $key = ($self->_engine->storage->{filter_store_key})
+        ? $self->_engine->storage->{filter_store_key}->($_[0])
         : $_[0];
 
     return $self->SUPER::EXISTS( $key );
@@ -59,8 +59,8 @@ sub EXISTS {
 sub DELETE {
     my $self = shift->_get_self;
     DBM::Deep->_throw_error( "Cannot use an undefined hash key." ) unless defined $_[0];
-    my $key = ($self->_storage->{filter_store_key})
-        ? $self->_storage->{filter_store_key}->($_[0])
+    my $key = ($self->_engine->storage->{filter_store_key})
+        ? $self->_engine->storage->{filter_store_key}->($_[0])
         : $_[0];
 
     return $self->SUPER::DELETE( $key, $_[0] );
@@ -78,8 +78,8 @@ sub FIRSTKEY {
     
     $self->unlock();
     
-    return ($result && $self->_storage->{filter_fetch_key})
-        ? $self->_storage->{filter_fetch_key}->($result)
+    return ($result && $self->_engine->storage->{filter_fetch_key})
+        ? $self->_engine->storage->{filter_fetch_key}->($result)
         : $result;
 }
 
@@ -89,8 +89,8 @@ sub NEXTKEY {
     ##
     my $self = shift->_get_self;
 
-    my $prev_key = ($self->_storage->{filter_store_key})
-        ? $self->_storage->{filter_store_key}->($_[0])
+    my $prev_key = ($self->_engine->storage->{filter_store_key})
+        ? $self->_engine->storage->{filter_store_key}->($_[0])
         : $_[0];
 
     $self->lock_shared;
@@ -99,8 +99,8 @@ sub NEXTKEY {
     
     $self->unlock();
     
-    return ($result && $self->_storage->{filter_fetch_key})
-        ? $self->_storage->{filter_fetch_key}->($result)
+    return ($result && $self->_engine->storage->{filter_fetch_key})
+        ? $self->_engine->storage->{filter_fetch_key}->($result)
         : $result;
 }
 
diff --git a/t/11_optimize.t b/t/11_optimize.t
index 5fb6d11..f798644 100644
--- a/t/11_optimize.t
+++ b/t/11_optimize.t
@@ -59,7 +59,7 @@ ok( $after < $before, "file size has shrunk" ); # make sure file shrunk
 is( $db->{key1}, 'value1', "key1's value is still there after optimize" );
 is( $db->{a}{c}, 'value2', "key2's value is still there after optimize" );
 
-$db->_get_self->_storage->close( $db->_get_self );
+$db->_get_self->_engine->storage->close( $db->_get_self );
 
 ##
 # now for the tricky one -- try to store a new key while file is being
diff --git a/t/21_tie_access.t b/t/21_tie_access.t
index 4059fd4..dc2d856 100644
--- a/t/21_tie_access.t
+++ b/t/21_tie_access.t
@@ -16,7 +16,7 @@ my ($fh, $filename) = new_fh();
 
     $hash{key1} = 'value';
     is( $hash{key1}, 'value', 'Set and retrieved key1' );
-    tied( %hash )->_get_self->_storage->close( tied( %hash )->_get_self );
+    tied( %hash )->_get_self->_engine->storage->close( tied( %hash )->_get_self );
 }
 
 {
@@ -27,7 +27,7 @@ my ($fh, $filename) = new_fh();
 
     is( keys %hash, 1, "There's one key so far" );
     ok( exists $hash{key1}, "... and it's key1" );
-    tied( %hash )->_get_self->_storage->close( tied( %hash )->_get_self );
+    tied( %hash )->_get_self->_engine->storage->close( tied( %hash )->_get_self );
 }
 
 {
@@ -36,7 +36,7 @@ my ($fh, $filename) = new_fh();
             file => $filename,
             type => DBM::Deep->TYPE_ARRAY,
         };
-        tied( @array )->_get_self->_storage->close( tied( @array )->_get_self );
+        tied( @array )->_get_self->_engine->storage->close( tied( @array )->_get_self );
     } qr/DBM::Deep: File type mismatch/, "\$SIG_TYPE doesn't match file's type";
 }
 
@@ -50,5 +50,5 @@ my ($fh, $filename) = new_fh();
             type => DBM::Deep->TYPE_HASH,
         };
     } qr/DBM::Deep: File type mismatch/, "\$SIG_TYPE doesn't match file's type";
-    $db->_get_self->_storage->close( $db->_get_self );
+    $db->_get_self->_engine->storage->close( $db->_get_self );
 }
diff --git a/t/22_internal_copy.t b/t/22_internal_copy.t
index 0988f8d..b17c009 100644
--- a/t/22_internal_copy.t
+++ b/t/22_internal_copy.t
@@ -57,7 +57,7 @@ my ($fh2, $filename2) = new_fh();
     }
     ## Rewind handle otherwise the signature is not recognised below.
     ## The signature check should probably rewind the fh?
-    seek $db->_get_self->_storage->{fh}, 0, 0;
+    seek $db->_get_self->_engine->storage->{fh}, 0, 0;
 }
 
 {
diff --git a/t/23_misc.t b/t/23_misc.t
index 89bb040..a0f5d9b 100644
--- a/t/23_misc.t
+++ b/t/23_misc.t
@@ -29,7 +29,7 @@ is( $db->{key1}, "value1", "Value set correctly" );
 
 # Testing to verify that the close() will occur if open is called on an open DB.
 #XXX WOW is this hacky ...
-$db->_get_self->_storage->open;
+$db->_get_self->_engine->storage->open;
 is( $db->{key1}, "value1", "Value still set after re-open" );
 
 throws_ok {
@@ -41,7 +41,7 @@ throws_ok {
         file => $filename,
         locking => 1,
     );
-    $db->_get_self->_storage->close( $db->_get_self );
+    $db->_get_self->_engine->storage->close( $db->_get_self );
     ok( !$db->lock, "Calling lock() on a closed database returns false" );
 }
 
@@ -51,6 +51,6 @@ throws_ok {
         locking => 1,
     );
     $db->lock;
-    $db->_get_self->_storage->close( $db->_get_self );
+    $db->_get_self->_engine->storage->close( $db->_get_self );
     ok( !$db->unlock, "Calling unlock() on a closed database returns false" );
 }
diff --git a/t/24_autobless.t b/t/24_autobless.t
index e2de696..70ef1df 100644
--- a/t/24_autobless.t
+++ b/t/24_autobless.t
@@ -53,7 +53,7 @@ my ($fh, $filename) = new_fh();
     is( $db->{unblessed}{b}[2], 3 );
 
     $db->{blessed_long} = bless {}, 'a' x 1000;
-    $db->_get_self->_storage->close( $db->_get_self );
+    $db->_get_self->_engine->storage->close( $db->_get_self );
 }
 
 {
@@ -89,7 +89,7 @@ my ($fh, $filename) = new_fh();
     is( $db->{blessed}{c}, 'new' );
 
     isa_ok( $db->{blessed_long}, 'a' x 1000 );
-    $db->_get_self->_storage->close( $db->_get_self );
+    $db->_get_self->_engine->storage->close( $db->_get_self );
 }
 
 {
@@ -124,7 +124,7 @@ my ($fh, $filename) = new_fh();
     is( $structure->{unblessed}{b}[0], 1 );
     is( $structure->{unblessed}{b}[1], 2 );
     is( $structure->{unblessed}{b}[2], 3 );
-    $db->_get_self->_storage->close( $db->_get_self );
+    $db->_get_self->_engine->storage->close( $db->_get_self );
 }
 
 {
@@ -155,7 +155,7 @@ my ($fh, $filename) = new_fh();
     is( $db->{unblessed}{b}[0], 1 );
     is( $db->{unblessed}{b}[1], 2 );
     is( $db->{unblessed}{b}[2], 3 );
-    $db->_get_self->_storage->close( $db->_get_self );
+    $db->_get_self->_engine->storage->close( $db->_get_self );
 }
 
 {
@@ -172,7 +172,7 @@ my ($fh, $filename) = new_fh();
         }, 'Foo';
 
         $db->import( { blessed => $obj } );
-        $db->_get_self->_storage->close( $db->_get_self );
+        $db->_get_self->_engine->storage->close( $db->_get_self );
     }
 
     {
@@ -184,7 +184,7 @@ my ($fh, $filename) = new_fh();
         my $blessed = $db->{blessed};
         isa_ok( $blessed, 'Foo' );
         is( $blessed->{a}, 1 );
-        $db->_get_self->_storage->close( $db->_get_self );
+        $db->_get_self->_engine->storage->close( $db->_get_self );
     }
 }
 
diff --git a/t/27_filehandle.t b/t/27_filehandle.t
index c70b09d..aff3007 100644
--- a/t/27_filehandle.t
+++ b/t/27_filehandle.t
@@ -34,7 +34,7 @@ use_ok( 'DBM::Deep' );
             skip( "No inode tests on Win32", 1 )
                 if ( $^O eq 'MSWin32' || $^O eq 'cygwin' );
             my $db_obj = $db->_get_self;
-            ok( $db_obj->_storage->{inode}, "The inode has been set" );
+            ok( $db_obj->_engine->storage->{inode}, "The inode has been set" );
         }
 
         close($fh);
diff --git a/t/38_data_sector_size.t b/t/38_data_sector_size.t
index ebdbff8..01a612b 100644
--- a/t/38_data_sector_size.t
+++ b/t/38_data_sector_size.t
@@ -39,7 +39,7 @@ my %sizes;
     {
         my $db = DBM::Deep->new( file => $filename );
         verify( $db );
-        $db->_get_self->_storage->close( $db->_get_self );
+        $db->_get_self->_engine->storage->close( $db->_get_self );
     }
 }
 
@@ -60,7 +60,7 @@ my %sizes;
     {
         my $db = DBM::Deep->new( $filename );
         verify( $db );
-         $db->_get_self->_storage->close( $db->_get_self );
+         $db->_get_self->_engine->storage->close( $db->_get_self );
     }
 }
 
@@ -81,7 +81,7 @@ my %sizes;
     {
         my $db = DBM::Deep->new( $filename );
         verify( $db );
-         $db->_get_self->_storage->close( $db->_get_self );
+         $db->_get_self->_engine->storage->close( $db->_get_self );
     }
 }
 
@@ -102,7 +102,7 @@ my %sizes;
     {
         my $db = DBM::Deep->new( $filename );
         verify( $db );
-         $db->_get_self->_storage->close( $db->_get_self );
+         $db->_get_self->_engine->storage->close( $db->_get_self );
     }
 }
 
diff --git a/t/41_transaction_multilevel.t b/t/41_transaction_multilevel.t
index f06b2eb..2c3c44a 100644
--- a/t/41_transaction_multilevel.t
+++ b/t/41_transaction_multilevel.t
@@ -13,7 +13,7 @@ my $db1 = DBM::Deep->new(
     autoflush => 1,
     num_txns  => 2,
 );
-seek $db1->_get_self->_storage->{fh}, 0, 0;
+seek $db1->_get_self->_engine->storage->{fh}, 0, 0;
 
 my $db2 = DBM::Deep->new(
     file => $filename,
@@ -94,5 +94,5 @@ cmp_bag( [ keys %{$db2->{x}} ], [qw( yz )], "DB2->X keys correct" );
 cmp_bag( [ keys %{$db1->{x}{yz}} ], [qw( bar )], "DB1->X->XY keys correct" );
 cmp_bag( [ keys %{$db2->{x}{yz}} ], [qw( bar )], "DB2->X->XY keys correct" );
 
-$db1->_get_self->_storage->close( $db1->_get_self );
-$db2->_get_self->_storage->close( $db2->_get_self );
+$db1->_get_self->_engine->storage->close( $db1->_get_self );
+$db2->_get_self->_engine->storage->close( $db2->_get_self );
diff --git a/t/45_references.t b/t/45_references.t
index 3ed2407..cb26d6d 100644
--- a/t/45_references.t
+++ b/t/45_references.t
@@ -17,7 +17,7 @@ my $db = DBM::Deep->new(
     num_txns  => 16,
 );
 
-seek $db->_get_self->_storage->{fh}, 0, 0;
+seek $db->_get_self->_engine->storage->{fh}, 0, 0;
 
 my $db2 = DBM::Deep->new(
     file => $filename,