A raft of minor improvements

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

diff --git a/lib/DBM/Deep/Engine.pm b/lib/DBM/Deep/Engine.pm
index 6d14136..99198fe 100644 (file)
--- a/lib/DBM/Deep/Engine.pm
+++ b/lib/DBM/Deep/Engine.pm
@@ -1372,23 +1372,6 @@ sub _init {
     return;
 }
 
-sub free {
-    my $self = shift;
-
-    # We're not ready to be removed yet.
-    if ( $self->decrement_refcount > 0 ) {
-        return;
-    }
-
-    my $blist_loc = $self->get_blist_loc;
-    $self->engine->_load_sector( $blist_loc )->free if $blist_loc;
-
-    my $class_loc = $self->get_class_offset;
-    $self->engine->_load_sector( $class_loc )->free if $class_loc;
-
-    $self->SUPER::free();
-}
-
 sub staleness { $_[0]{staleness} }
 
 sub get_data_for {
@@ -1691,25 +1674,54 @@ sub get_classname {
 }
 
 #XXX Add singleton handling here
-sub data {
-    my $self = shift;
+{
+    my %cache;
+    # XXX This is insufficient
+#    sub _clear_cache { %cache = (); }
+    sub data {
+        my $self = shift;
 
-    my $new_obj = DBM::Deep->new({
-        type        => $self->type,
-        base_offset => $self->offset,
-        staleness   => $self->staleness,
-        storage     => $self->engine->storage,
-        engine      => $self->engine,
-    });
+#        unless ( $cache{ $self->offset } ) {
+            my $new_obj = DBM::Deep->new({
+                type        => $self->type,
+                base_offset => $self->offset,
+                staleness   => $self->staleness,
+                storage     => $self->engine->storage,
+                engine      => $self->engine,
+            });
 
-    if ( $self->engine->storage->{autobless} ) {
-        my $classname = $self->get_classname;
-        if ( defined $classname ) {
-            bless $new_obj, $classname;
-        }
+            if ( $self->engine->storage->{autobless} ) {
+                my $classname = $self->get_classname;
+                if ( defined $classname ) {
+                    bless $new_obj, $classname;
+                }
+            }
+
+            $cache{$self->offset} = $new_obj;
+#        }
+        return $cache{$self->offset};
     }
 
-    return $new_obj;
+    sub free {
+        my $self = shift;
+
+        # We're not ready to be removed yet.
+        if ( $self->decrement_refcount > 0 ) {
+            return;
+        }
+
+        # Rebless the object into DBM::Deep::Null.
+#        %{$cache{ $self->offset }} = ();
+#        bless $cache{$self->offset}, 'DBM::Deep::Null';
+
+        my $blist_loc = $self->get_blist_loc;
+        $self->engine->_load_sector( $blist_loc )->free if $blist_loc;
+
+        my $class_loc = $self->get_class_offset;
+        $self->engine->_load_sector( $class_loc )->free if $class_loc;
+
+        $self->SUPER::free();
+    }
 }
 
 sub increment_refcount {
@@ -2191,5 +2203,17 @@ sub set_entry {
     );
 }
 
+# This was copied from MARCEL's Class::Null. However, I couldn't use it because
+# I need an undef value, not an implementation of the Null Class pattern.
+package DBM::Deep::Null;
+
+use overload
+    'bool'   => sub { undef},
+    '""'     => sub { undef },
+    '0+'     => sub { undef},
+    fallback => 1;
+
+sub AUTOLOAD { return; }
+
 1;
 __END__