Final fixes before releasing last developer release
[dbsrgits/DBM-Deep.git] / lib / DBM / Deep / Sector / DBI / Reference.pm
index e6a0ccc..4ffbfbd 100644 (file)
@@ -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 {
@@ -54,16 +56,27 @@ sub write_data {
     my $self = shift;
     my ($args) = @_;
 
-    $self->engine->storage->write_to(
-        datas => $args->{value}{offset},
-        ref_id    => $self->offset,
-        data_type => 'S',
-        key       => $args->{key},
-        value     => $args->{value}{data},
-        class     => $args->{value}{class},
-    );
+    if ( ( $args->{value}->type || 'S' ) eq 'S' ) {
+        $args->{value}{offset} = $self->engine->storage->write_to(
+            datas => $args->{value}{offset},
+            ref_id    => $self->offset,
+            data_type => 'S',
+            key       => $args->{key},
+            value     => $args->{value}{data},
+        );
 
-    $args->{value}->reload;
+        $args->{value}->reload;
+    }
+    else {
+        # Write the Scalar of the Reference
+        $self->engine->storage->write_to(
+            datas => undef,
+            ref_id    => $self->offset,
+            data_type => 'R',
+            key       => $args->{key},
+            value     => $args->{value}{offset},
+        );
+    }
 }
 
 sub delete_key {
@@ -76,12 +89,131 @@ sub delete_key {
 
     my $data;
     if ( $old_value ) {
-        $data = $old_value->data;
+        $data = $old_value->data({ export => 1 });
         $old_value->free;
     }
 
     return $data;
 }
 
+sub get_classname {
+    my $self = shift;
+    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 $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,
+        });
+
+        $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;
+    }
+
+    # We shouldn't export if this is still referred to.
+    if ( $self->get_refcount > 1 ) {
+        return $obj;
+    }
+
+    return $obj->export;
+}
+
+sub free {
+    my $self = shift;
+
+    # We're not ready to be removed yet.
+    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 },
+    );
+
+    $self->engine->storage->delete_from(
+        'datas', { value => $self->offset, data_type => 'R' },
+    );
+
+    $self->SUPER::free( @_ );
+}
+
+sub increment_refcount {
+    my $self = shift;
+    my $refcount = $self->get_refcount;
+    $refcount++;
+    $self->write_refcount( $refcount );
+    return $refcount;
+}
+
+sub decrement_refcount {
+    my $self = shift;
+    my $refcount = $self->get_refcount;
+    $refcount--;
+    $self->write_refcount( $refcount );
+    return $refcount;
+}
+
+sub get_refcount {
+    my $self = shift;
+    my ($rows) = $self->engine->storage->read_from(
+        'refs', $self->offset,
+        qw( refcount ),
+    );
+    return $rows->[0]{refcount};
+}
+
+sub write_refcount {
+    my $self = shift;
+    my ($num) = @_;
+    $self->engine->storage->{dbh}->do(
+        "UPDATE refs SET refcount = ? WHERE id = ?", undef,
+        $num, $self->offset,
+    );
+}
+
+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__