Got arrays working, requiring that make_reference and clone be added and functional

diff --git a/lib/DBM/Deep/Engine/DBI.pm b/lib/DBM/Deep/Engine/DBI.pm
index c00227a..192af9b 100644 (file)
--- a/lib/DBM/Deep/Engine/DBI.pm
+++ b/lib/DBM/Deep/Engine/DBI.pm
@@ -103,12 +103,50 @@ sub get_classname {
     return;
 }
 
-=pod
 sub make_reference {
     my $self = shift;
     my ($obj, $old_key, $new_key) = @_;
+
+    my $sector = $self->load_sector( $obj->_base_offset, 'refs' )
+        or return;
+
+#    if ( $sector->staleness != $obj->_staleness ) {
+#        return;
+#    }
+
+    my $value_sector = $sector->get_data_for({
+        key        => $old_key,
+        allow_head => 1,
+    });
+
+    unless ( $value_sector ) {
+        $value_sector = DBM::Deep::Sector::DBI::Scalar->new({
+            engine => $self,
+            data   => undef,
+        });
+
+        $sector->write_data({
+            key     => $old_key,
+            value   => $value_sector,
+        });
+    }
+
+    if ( $value_sector->isa( 'DBM::Deep::Sector::DBI::Reference' ) ) {
+        $sector->write_data({
+            key     => $new_key,
+            value   => $value_sector,
+        });
+        $value_sector->increment_refcount;
+    }
+    else {
+        $sector->write_data({
+            key     => $new_key,
+            value   => $value_sector->clone,
+        });
+    }
+
+    return;
 }
-=cut
 
 # exists returns '', not undefined.
 sub key_exists {

diff --git a/lib/DBM/Deep/Sector.pm b/lib/DBM/Deep/Sector.pm
index 8174f1a..3f44fca 100644 (file)
--- a/lib/DBM/Deep/Sector.pm
+++ b/lib/DBM/Deep/Sector.pm
@@ -15,7 +15,16 @@ sub new {
 }
 
 sub _init {}
-sub clone { die "clone must be implemented in a child class" }
+#sub clone { die "clone must be implemented in a child class" }
+sub clone {
+    my $self = shift;
+    return ref($self)->new({
+        engine => $self->engine,
+        type   => $self->type,
+        data   => $self->data,
+    });
+}
+
 
 sub engine { $_[0]{engine} }
 sub offset { $_[0]{offset} }

diff --git a/lib/DBM/Deep/Sector/DBI/Reference.pm b/lib/DBM/Deep/Sector/DBI/Reference.pm
index d224760..98dcfae 100644 (file)
--- a/lib/DBM/Deep/Sector/DBI/Reference.pm
+++ b/lib/DBM/Deep/Sector/DBI/Reference.pm
@@ -153,20 +153,37 @@ sub free {
 }
 
 sub increment_refcount {
-    return 1;
+    my $self = shift;
+    my $refcount = $self->get_refcount;
+    $refcount++;
+    $self->write_refcount( $refcount );
+    return $refcount;
 }
 
 sub decrement_refcount {
-    return 0;
+    my $self = shift;
+    my $refcount = $self->get_refcount;
+    $refcount--;
+    $self->write_refcount( $refcount );
+    return $refcount;
 }
 
 sub get_refcount {
-    return 1;
+    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,
+    );
 }
 
 1;

diff --git a/lib/DBM/Deep/Sector/File/Scalar.pm b/lib/DBM/Deep/Sector/File/Scalar.pm
index b8a9519..eab145c 100644 (file)
--- a/lib/DBM/Deep/Sector/File/Scalar.pm
+++ b/lib/DBM/Deep/Sector/File/Scalar.pm
@@ -31,15 +31,6 @@ sub free {
     return;
 }
 
-sub clone {
-    my $self = shift;
-    return ref($self)->new({
-        engine => $self->engine,
-        type   => $self->type,
-        data   => $self->data,
-    });
-}
-
 sub type { $_[0]{engine}->SIG_DATA }
 sub _init {
     my $self = shift;

diff --git a/lib/DBM/Deep/Storage/DBI.pm b/lib/DBM/Deep/Storage/DBI.pm
index da5c89e..2357221 100644 (file)
--- a/lib/DBM/Deep/Storage/DBI.pm
+++ b/lib/DBM/Deep/Storage/DBI.pm
@@ -105,9 +105,6 @@ sub write_to {
       . ") VALUES ("
           . join( ',', ('?') x (@keys + 1) )
       . ")";
-#warn $sql. $/;
-#no warnings;
-#warn "@args{@keys}\n";
     $self->{dbh}->do( $sql, undef, $id, @args{@keys} );
 
     return $self->{dbh}{mysql_insertid};

diff --git a/t/04_array.t b/t/04_array.t
index f8d69fe..4f049ad 100644 (file)
--- a/t/04_array.t
+++ b/t/04_array.t
@@ -14,11 +14,17 @@ while ( my $dbm_maker = $dbm_factory->() ) {
     ##
     # basic put/get/push
     ##
+warn "1\n";
     $db->[0] = "elem1";
+warn "2\n";
     $db->push( "elem2" );
+warn "3\n";
     $db->put(2, "elem3");
+warn "4\n";
     $db->store(3, "elem4");
+warn "5\n";
     $db->unshift("elem0");
+warn "6\n";
 
     is( $db->[0], 'elem0', "Array get for shift works" );
     is( $db->[1], 'elem1', "Array get for array set works" );
@@ -242,7 +248,8 @@ while ( my $dbm_maker = $dbm_factory->() ) {
         $db->exists();
     } qr/Cannot use an undefined array index/, "EXISTS fails on an undefined key";
 }
-
+done_testing;
+__END__
 # Bug reported by Mike Schilli
 # Also, RT #29583 reported by HANENKAMP
 $dbm_factory = new_dbm( type => DBM::Deep->TYPE_ARRAY );