From: rkinyon <rkinyon@50811bd7-b8ce-0310-adc1-d9db26280581>
Date: Wed, 15 Feb 2006 15:00:27 +0000 (+0000)
Subject: A few more fixes, bringing stmt to 94.9% and overall to 88.5%
X-Git-Tag: 0-97~72
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=b8b48a591960b6b91adaa888b810350497d1a671;p=dbsrgits%2FDBM-Deep.git

A few more fixes, bringing stmt to 94.9% and overall to 88.5%
---

diff --git a/lib/DBM/Deep.pm b/lib/DBM/Deep.pm
index 9216b94..8a86fd6 100644
--- a/lib/DBM/Deep.pm
+++ b/lib/DBM/Deep.pm
@@ -441,8 +441,9 @@ sub add_bucket {
 	# If this is an internal reference, return now.
 	# No need to write value or plain key
 	##
-#YYY
-	if ($internal_ref) { return $result; }
+	if ($internal_ref) {
+        return $result;
+    }
 	
 	##
 	# If bucket didn't fit into list, split into a new index level
@@ -454,12 +455,6 @@ sub add_bucket {
 		my $index_tag = $self->create_tag($self->root->{end}, SIG_INDEX, chr(0) x $INDEX_SIZE);
 		my @offsets = ();
 		
-#XXX We've already guaranteed that this cannot be true at YYY
-#		if ($internal_ref) {
-#			$keys .= $md5 . pack($LONG_PACK, $value->base_offset);
-#			$location = $value->base_offset;
-#		}
-#		else { $keys .= $md5 . pack($LONG_PACK, 0); }
 		$keys .= $md5 . pack($LONG_PACK, 0);
 		
 		for (my $i=0; $i<=$MAX_BUCKETS; $i++) {
@@ -540,24 +535,14 @@ sub add_bucket {
 		# If value is blessed, preserve class name
 		##
 		my $value_class = Scalar::Util::blessed($value);
-#XXX NO tests for this
-		if ($self->root->{autobless} && defined $value_class) {
-			if ($value_class ne 'DBM::Deep') {
-				##
-				# Blessed ref -- will restore later
-				##
-				$self->fh->print( chr(1) );
-				$self->fh->print( pack($DATA_LENGTH_PACK, length($value_class)) . $value_class );
-				$content_length += 1;
-				$content_length += $DATA_LENGTH_SIZE + length($value_class);
-			}
-			else {
-				##
-				# Simple unblessed ref -- no restore needed
-				##
-				$self->fh->print( chr(0) );
-				$content_length += 1;
-			}
+		if ($self->root->{autobless} && defined $value_class && $value_class ne 'DBM::Deep' ) {
+            ##
+            # Blessed ref -- will restore later
+            ##
+            $self->fh->print( chr(1) );
+            $self->fh->print( pack($DATA_LENGTH_PACK, length($value_class)) . $value_class );
+            $content_length += 1;
+            $content_length += $DATA_LENGTH_SIZE + length($value_class);
 		}
 		
 		##
@@ -646,7 +631,6 @@ sub get_bucket_value {
                 root => $self->root
             );
             
-#XXX NO tests for this
             if ($self->root->{autobless}) {
                 ##
                 # Skip over value and plain key to see if object needs
@@ -902,7 +886,7 @@ sub lock {
 	# be called before the lock is released.
 	##
     my $self = _get_self($_[0]);
-	my ($type) = @_;
+	my $type = $_[1];
     $type = LOCK_EX unless defined $type;
 	
 	if ($self->root->{locking}) {
@@ -917,7 +901,6 @@ sub unlock {
 	# regarding calling lock() multiple times.
 	##
     my $self = _get_self($_[0]);
-#	my $type = $_[1];
 	
 	if ($self->root->{locking} && $self->root->{locked} > 0) {
 		$self->root->{locked}--;
@@ -933,8 +916,8 @@ sub copy_node {
 	##
     my $self = _get_self($_[0]);
 	my $db_temp = $_[1];
-	
-	if ($self->{type} eq TYPE_HASH) {
+
+	if ($self->type eq TYPE_HASH) {
 		my $key = $self->first_key();
 		while ($key) {
 			my $value = $self->get($key);
@@ -953,6 +936,7 @@ sub copy_node {
 		for (my $index = 0; $index < $length; $index++) {
 			my $value = $self->get($index);
 			if (!ref($value)) { $db_temp->[$index] = $value; }
+            #XXX NO tests for this code
 			else {
 				my $type = $value->type;
 				if ($type eq TYPE_HASH) { $db_temp->[$index] = {}; }
@@ -1126,6 +1110,7 @@ sub fh {
 	##
 	# Get access to the raw FileHandle
 	##
+    #XXX It will be useful, though, when we split out HASH and ARRAY
     my $self = _get_self($_[0]);
 	return $self->root->{fh};
 }
@@ -1726,6 +1711,7 @@ sub SPLICE {
 }
 
 #XXX We don't need to define it.
+#XXX It will be useful, though, when we split out HASH and ARRAY
 #sub EXTEND {
 	##
 	# Perl will call EXTEND() when the array is likely to grow.
diff --git a/t/autobless_2.t b/t/autobless_2.t
index f4151af..0a3337c 100644
--- a/t/autobless_2.t
+++ b/t/autobless_2.t
@@ -14,19 +14,12 @@ use_ok( 'DBM::Deep' );
 unlink 't/test.db';
 my $db = DBM::Deep->new(
     file     => "t/test.db",
-    autobless => 1,
+    autobless => 0,
 );
 if ($db->error()) {
 	die "ERROR: " . $db->error();
 }
 
-my $obj = bless {
-    a => 1,
-    b => [ 1 .. 3 ],
-}, 'Foo';
-
-$db->{blessed} = $obj;
-
 $db->{unblessed} = {};
 $db->{unblessed}{a} = 1;
 $db->{unblessed}{b} = [];
@@ -38,48 +31,30 @@ undef $db;
 
 my $db2 = DBM::Deep->new(
     file     => 't/test.db',
-    autoflush => 1,
     autobless => 1,
 );
 if ($db2->error()) {
 	die "ERROR: " . $db2->error();
 }
 
-my $obj2 = $db2->{blessed};
-isa_ok( $obj2, 'Foo' );
-can_ok( $obj2, 'export', 'foo' );
-ok( !$obj2->can( 'STORE' ), "... but it cannot 'STORE'" );
-
-is( $obj2->{a}, 1 );
-is( $obj2->{b}[0], 1 );
-is( $obj2->{b}[1], 2 );
-is( $obj2->{b}[2], 3 );
-
 is( $db2->{unblessed}{a}, 1 );
 is( $db2->{unblessed}{b}[0], 1 );
 is( $db2->{unblessed}{b}[1], 2 );
 is( $db2->{unblessed}{b}[2], 3 );
 
+$db2->{unblessed}{a} = 2;
+
+undef $db2;
+
 my $db3 = DBM::Deep->new(
-    file     => 't/test.db',
-    autoflush => 1,
-#    autobless => 0,
+    file     => "t/test.db",
+    autobless => 0,
 );
 if ($db3->error()) {
-	die "ERROR: " . $db3->error();
+	die "ERROR: " . $db->error();
 }
 
-my $obj3 = $db3->{blessed};
-isa_ok( $obj3, 'DBM::Deep' );
-can_ok( $obj3, 'export', 'STORE' );
-ok( !$obj3->can( 'foo' ), "... but it cannot 'foo'" );
-
-is( $obj3->{a}, 1 );
-is( $obj3->{b}[0], 1 );
-is( $obj3->{b}[1], 2 );
-is( $obj3->{b}[2], 3 );
-
-is( $db3->{unblessed}{a}, 1 );
+is( $db3->{unblessed}{a}, 2 );
 is( $db3->{unblessed}{b}[0], 1 );
 is( $db3->{unblessed}{b}[1], 2 );
 is( $db3->{unblessed}{b}[2], 3 );