Had to turn off caching, but I've merged everything from SPROUT's fixes

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

diff --git a/lib/DBM/Deep.pm b/lib/DBM/Deep.pm
index 1ae5d39..174082c 100644 (file)
--- a/lib/DBM/Deep.pm
+++ b/lib/DBM/Deep.pm
@@ -4,24 +4,20 @@ use 5.006_000;
 
 use strict;
 use warnings FATAL => 'all';
+no warnings 'recursion';
 
-our $VERSION = q(1.0015);
+our $VERSION = q(1.0019_003);
 
 use Scalar::Util ();
 
-use DBM::Deep::Engine::DBI ();
-use DBM::Deep::Engine::File ();
-
-use DBM::Deep::SQL::Util;
-use DBM::Deep::SQL::Array;
-use DBM::Deep::SQL::Hash;
-
 use overload
     '""' => sub { overload::StrVal( $_[0] ) },
     fallback => 1;
 
 use constant DEBUG => 0;
 
+use DBM::Deep::Engine;
+
 sub TYPE_HASH   () { DBM::Deep::Engine->SIG_HASH  }
 sub TYPE_ARRAY  () { DBM::Deep::Engine->SIG_ARRAY }
 
@@ -56,7 +52,7 @@ sub new {
     my $class = shift;
     my $args = $class->_get_args( @_ );
     my $self;
-    
+
     if (defined($args->{type}) && $args->{type} eq TYPE_ARRAY) {
         $class = 'DBM::Deep::Array';
         require DBM::Deep::Array;
@@ -93,6 +89,7 @@ sub _init {
             ? 'DBM::Deep::Engine::DBI'
             : 'DBM::Deep::Engine::File';
 
+        eval "use $class"; die $@ if $@;
         $args->{engine} = $class->new({
             %{$args},
             obj => $self,
@@ -139,6 +136,8 @@ sub lock_exclusive {
 *lock = \&lock_exclusive;
 sub lock_shared {
     my $self = shift->_get_self;
+use Carp qw( cluck ); use Data::Dumper;
+cluck Dumper($self) unless $self->_engine;
     return $self->_engine->lock_shared( $self, @_ );
 }
 
@@ -167,7 +166,7 @@ sub _copy_value {
             __PACKAGE__->_throw_error( "Unknown type for '$value'" );
         }
 
-        if ( eval { local $SIG{__DIE__}; $tied->isa( __PACKAGE__ ) } ) {
+        if ( eval { local $SIG{'__DIE__'}; $tied->isa( __PACKAGE__ ) } ) {
             ${$spot} = $tied->_repr;
             $tied->_copy_node( ${$spot} );
         }
@@ -328,6 +327,7 @@ sub optimize {
     $self->lock_exclusive;
     $self->_engine->clear_cache;
     $self->_copy_node( $db_temp );
+    $self->unlock;
     $db_temp->_engine->storage->close;
     undef $db_temp;
 
@@ -366,9 +366,6 @@ sub optimize {
 }
 
 sub clone {
-    ##
-    # Make copy of object and return
-    ##
     my $self = shift->_get_self;
 
     return __PACKAGE__->new(
@@ -416,7 +413,10 @@ sub supports {
 sub begin_work {
     my $self = shift->_get_self;
     $self->lock_exclusive;
-    my $rv = eval { $self->_engine->begin_work( $self, @_ ) };
+    my $rv = eval {
+        local $SIG{'__DIE__'};
+        $self->_engine->begin_work( $self, @_ );
+    };
     my $e = $@;
     $self->unlock;
     die $e if $e;
@@ -425,8 +425,12 @@ sub begin_work {
 
 sub rollback {
     my $self = shift->_get_self;
+
     $self->lock_exclusive;
-    my $rv = eval { $self->_engine->rollback( $self, @_ ) };
+    my $rv = eval {
+        local $SIG{'__DIE__'};
+        $self->_engine->rollback( $self, @_ );
+    };
     my $e = $@;
     $self->unlock;
     die $e if $e;
@@ -436,7 +440,10 @@ sub rollback {
 sub commit {
     my $self = shift->_get_self;
     $self->lock_exclusive;
-    my $rv = eval { $self->_engine->commit( $self, @_ ) };
+    my $rv = eval {
+        local $SIG{'__DIE__'};
+        $self->_engine->commit( $self, @_ );
+    };
     my $e = $@;
     $self->unlock;
     die $e if $e;
@@ -493,7 +500,13 @@ sub STORE {
         $value = $self->_engine->storage->{filter_store_value}->( $value );
     }
 
-    $self->_engine->write_value( $self, $key, $value );
+    eval {
+        local $SIG{'__DIE__'};
+        $self->_engine->write_value( $self, $key, $value );
+    }; if ( my $e = $@ ) {
+        $self->unlock;
+        die $e;
+    }
 
     $self->unlock;
 
@@ -565,34 +578,23 @@ sub CLEAR {
     my $self = shift->_get_self;
     warn "CLEAR($self)\n" if DEBUG;
 
-    unless ( $self->_engine->storage->is_writable ) {
+    my $engine = $self->_engine;
+    unless ( $engine->storage->is_writable ) {
         $self->_throw_error( 'Cannot write to a readonly filehandle' );
     }
 
     $self->lock_exclusive;
-
-    #XXX Rewrite this dreck to do it in the engine as a tight loop vs.
-    # iterating over keys - such a WASTE - is this required for transactional
-    # clearning?! Surely that can be detected in the engine ...
-    if ( $self->_type eq TYPE_HASH ) {
-        my $key = $self->first_key;
-        while ( $key ) {
-            # Retrieve the key before deleting because we depend on next_key
-            my $next_key = $self->next_key( $key );
-            $self->_engine->delete_key( $self, $key, $key );
-            $key = $next_key;
-        }
-    }
-    else {
-        my $size = $self->FETCHSIZE;
-        for my $key ( 0 .. $size - 1 ) {
-            $self->_engine->delete_key( $self, $key, $key );
-        }
-        $self->STORESIZE( 0 );
-    }
+    eval {
+        local $SIG{'__DIE__'};
+        $engine->clear( $self );
+    };
+    my $e = $@;
+    warn "$e\n" if $e;
 
     $self->unlock;
 
+    die $e if $e;
+
     return 1;
 }