Final fixes before releasing last developer release

[dbsrgits/DBM-Deep.git] / lib / DBM / Deep / Sector / DBI / Reference.pm

diff --git a/lib/DBM/Deep/Sector/DBI/Reference.pm b/lib/DBM/Deep/Sector/DBI/Reference.pm
index 7775ce8..4ffbfbd 100644 (file)
--- a/lib/DBM/Deep/Sector/DBI/Reference.pm
+++ b/lib/DBM/Deep/Sector/DBI/Reference.pm
@@ -15,9 +15,11 @@ sub _init {
     my $e = $self->engine;
 
     unless ( $self->offset ) {
+        my $classname = Scalar::Util::blessed( delete $self->{data} );
         $self->{offset} = $self->engine->storage->write_to(
             refs => undef,
-            ref_type => $self->type,
+            ref_type  => $self->type,
+            classname => $classname,
         );
     }
     else {
@@ -61,7 +63,6 @@ sub write_data {
             data_type => 'S',
             key       => $args->{key},
             value     => $args->{value}{data},
-            class     => $args->{value}{class},
         );
 
         $args->{value}->reload;
@@ -74,7 +75,6 @@ sub write_data {
             data_type => 'R',
             key       => $args->{key},
             value     => $args->{value}{offset},
-            class     => $args->{value}{class},
         );
     }
 }
@@ -98,31 +98,42 @@ sub delete_key {
 
 sub get_classname {
     my $self = shift;
-    return;
+    my ($rows) = $self->engine->storage->read_from(
+        'refs', $self->offset,
+        qw( classname ),
+    );
+    return unless @$rows;
+    return $rows->[0]{classname};
 }
 
+# Look to hoist this method into a ::Reference trait
 sub data {
     my $self = shift;
     my ($args) = @_;
     $args ||= {};
 
-    my $obj = DBM::Deep->new({
-        type        => $self->type,
-        base_offset => $self->offset,
-#        staleness   => $self->staleness,
-        storage     => $self->engine->storage,
-        engine      => $self->engine,
-    });
+    my $engine = $self->engine;
+    if ( !exists $engine->cache->{ $self->offset } ) {
+        my $obj = DBM::Deep->new({
+            type        => $self->type,
+            base_offset => $self->offset,
+            storage     => $engine->storage,
+            engine      => $engine,
+        });
 
-    if ( $self->engine->storage->{autobless} ) {
-        my $classname = $self->get_classname;
-        if ( defined $classname ) {
-            bless $obj, $classname;
-        }
+        $engine->cache->{$self->offset} = $obj;
     }
+    my $obj = $engine->cache->{$self->offset};
 
     # We're not exporting, so just return.
     unless ( $args->{export} ) {
+        if ( $engine->storage->{autobless} ) {
+            my $classname = $self->get_classname;
+            if ( defined $classname ) {
+                bless $obj, $classname;
+            }
+        }
+
         return $obj;
     }
 
@@ -138,9 +149,13 @@ sub free {
     my $self = shift;
 
     # We're not ready to be removed yet.
-    if ( $self->decrement_refcount > 0 ) {
-        return;
-    }
+    return if $self->decrement_refcount > 0;
+
+    # Rebless the object into DBM::Deep::Null.
+    eval { %{ $self->engine->cache->{ $self->offset } } = (); };
+    eval { @{ $self->engine->cache->{ $self->offset } } = (); };
+    bless $self->engine->cache->{ $self->offset }, 'DBM::Deep::Null';
+    delete $self->engine->cache->{ $self->offset };
 
     $self->engine->storage->delete_from(
         'datas', { ref_id => $self->offset },
@@ -187,5 +202,18 @@ sub write_refcount {
     );
 }
 
+sub clear {
+    my $self = shift;
+
+    DBM::Deep->new({
+        type        => $self->type,
+        base_offset => $self->offset,
+        storage     => $self->engine->storage,
+        engine      => $self->engine,
+    })->_clear;
+
+    return;
+}
+
 1;
 __END__