From: rkinyon <rkinyon@50811bd7-b8ce-0310-adc1-d9db26280581>
Date: Mon, 19 Jun 2006 13:05:21 +0000 (+0000)
Subject:  r14402@Rob-Kinyons-PowerBook (orig r6525):  rkinyon | 2006-06-19 09:05:12 -0400
X-Git-Tag: 0-983~4
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=74de6d5baf71a3a8e0946f9d97a39825dfae25d7;p=dbsrgits%2FDBM-Deep.git

 r14402@Rob-Kinyons-PowerBook (orig r6525):  rkinyon | 2006-06-19 09:05:12 -0400
 Added Todd's files
---

diff --git a/Deep.pm.patch b/Deep.pm.patch
new file mode 100644
index 0000000..95a2037
--- /dev/null
+++ b/Deep.pm.patch
@@ -0,0 +1,71 @@
+--- DBM-Deep-0.983/lib/DBM/Deep.pm	2006-04-10 21:59:17.000000000 -0500
++++ DBM-Deep-0.983_copy/lib/DBM/Deep.pm	2006-06-15 10:15:07.569349000 -0500
+@@ -149,7 +149,9 @@
+ 		tie %$self, $class, %$args;
+ 	}
+ 
+-	return bless $self, $class;
++    bless $self, $class;
++    $self->_set_ref($self);
++    return $self;
+ }
+ 
+ sub _init {
+@@ -604,6 +606,8 @@
+ 				root => $root,
+ 			};
+             %$value = %x;
++            bless $value, 'DBM::Deep::Hash';
++            $value->_set_ref($value);
+ 		}
+ 		elsif ($r eq 'ARRAY') {
+             my @x = @$value;
+@@ -613,6 +617,8 @@
+ 				root => $root,
+ 			};
+             @$value = @x;
++            bless $value, 'DBM::Deep::Array';
++            $value->_set_ref($value);
+ 		}
+ 		
+ 		return $result;
+@@ -663,7 +669,8 @@
+         # If value is a hash or array, return new DBM::Deep object with correct offset
+         ##
+         if (($signature eq TYPE_HASH) || ($signature eq TYPE_ARRAY)) {
+-            my $obj = DBM::Deep->new(
++            my $obj = $self->_get_ref($subloc);
++            $obj ||= DBM::Deep->new(
+                 type => $signature,
+                 base_offset => $subloc,
+                 root => $self->_root
+@@ -1221,6 +1228,20 @@
+ 	return $self->{base_offset};
+ }
+ 
++sub _set_ref {
++    my $self = $_[0]->_get_self;
++    my $base_offset = $self->_base_offset;
++    my $refs = $self->_root->{refs};
++    $refs->{$base_offset} = $_[1];
++    Scalar::Util::weaken $refs->{$base_offset};
++}
++
++sub _get_ref {
++    my $self = $_[0]->_get_self;
++    my $refs = $self->_root->{refs};
++    return $refs->{ $_[1] };
++}
++
+ sub error {
+ 	##
+ 	# Get last error string, or undef if no error
+@@ -1585,6 +1606,7 @@
+         filter_fetch_value => undef,
+         autobless => undef,
+         locked => 0,
++        refs => {},
+         %$args,
+     }, $class;
+ 
+
diff --git a/t/39_singletons.t b/t/39_singletons.t
new file mode 100644
index 0000000..2681931
--- /dev/null
+++ b/t/39_singletons.t
@@ -0,0 +1,18 @@
+use strict;
+use Test::More tests => 2;
+
+use_ok( 'DBM::Deep' );
+
+unlink 't/test.db';
+my $db = DBM::Deep->new(
+    file => "t/test.db",
+    locking => 1,
+    autoflush => 1,
+);
+
+$db->{foo} = { a => 'b' };
+my $x = $db->{foo};
+my $y = $db->{foo};
+is( $x, $y, "The references are the same" );
+
+