Fixed a bug with DBI iterators and made the tets self-bootstrapping and added the...
[dbsrgits/DBM-Deep.git] / lib / DBM / Deep / Sector / DBI / Reference.pm
index e6a0ccc..d224760 100644 (file)
@@ -54,14 +54,26 @@ 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' ) {
+        $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},
+        );
+    }
+    else {
+        $self->engine->storage->write_to(
+            datas => $args->{value}{offset},
+            ref_id    => $self->offset,
+            data_type => 'R',
+            key       => $args->{key},
+            value     => $args->{value}{offset},
+            class     => $args->{value}{class},
+        );
+    }
 
     $args->{value}->reload;
 }
@@ -76,12 +88,86 @@ 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;
+    return;
+}
+
+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,
+    });
+
+    if ( $self->engine->storage->{autobless} ) {
+        my $classname = $self->get_classname;
+        if ( defined $classname ) {
+            bless $obj, $classname;
+        }
+    }
+
+    # We're not exporting, so just return.
+    unless ( $args->{export} ) {
+        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.
+    if ( $self->decrement_refcount > 0 ) {
+        return;
+    }
+
+    $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 {
+    return 1;
+}
+
+sub decrement_refcount {
+    return 0;
+}
+
+sub get_refcount {
+    return 1;
+}
+
+sub write_refcount {
+    my $self = shift;
+    my ($num) = @_;
+}
+
 1;
 __END__