From: rkinyon <rkinyon@50811bd7-b8ce-0310-adc1-d9db26280581>
Date: Tue, 5 Dec 2006 03:19:08 +0000 (+0000)
Subject: Long classnames are now supported
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=d4f349513ac997f80547956c85ff7789d49b64e3;p=dbsrgits%2FDBM-Deep.git

Long classnames are now supported
---

diff --git a/lib/DBM/Deep/Engine3.pm b/lib/DBM/Deep/Engine3.pm
index 0290620..7e444ff 100644
--- a/lib/DBM/Deep/Engine3.pm
+++ b/lib/DBM/Deep/Engine3.pm
@@ -768,19 +768,24 @@ sub _init {
 
     unless ( $self->offset ) {
         my $classname = Scalar::Util::blessed( delete $self->{data} );
-        my $class_len = length( defined $classname ? $classname : '' );
-        my $leftover = $self->size - 4 - 2 * $engine->byte_size - $class_len;
+        my $leftover = $self->size - 4 - 2 * $engine->byte_size;
+
+        my $class_offset = 0;
+        if ( defined $classname ) {
+            my $class_sector = DBM::Deep::Engine::Sector::Scalar->new({
+                engine => $self->engine,
+                data   => $classname,
+            });
+            $class_offset = $class_sector->offset;
+        }
 
         $self->{offset} = $engine->_request_sector( $self->size );
         $engine->storage->print_at( $self->offset,
-            $self->type,                                    # Sector type
-            pack( $StP{1}, 0 ),                             # Recycled counter
-            pack( $StP{$engine->byte_size}, 0 ),            # Chain loc
-            pack( $StP{$engine->byte_size}, 0 ),            # Index/BList loc
-            pack( $StP{1}, (defined($classname) ? 1 : 0) ), # Blessedness
-            pack( $StP{1}, $class_len ),                    # Classname length
-            (defined($classname) ? $classname : ''),        # Classname
-            chr(0) x $leftover,                             # Zero-fill the rest
+            $self->type,                                     # Sector type
+            pack( $StP{1}, 0 ),                              # Recycled counter
+            pack( $StP{$engine->byte_size}, 0 ),             # Index/BList loc
+            pack( $StP{$engine->byte_size}, $class_offset ), # Classname loc
+            chr(0) x $leftover,                              # Zero-fill the rest
         );
 
         return;
@@ -795,7 +800,7 @@ sub get_blist_loc {
     my $self = shift;
 
     my $engine = $self->engine;
-    my $blist_loc = $engine->storage->read_at( $self->offset + 2 + $engine->byte_size, $engine->byte_size );
+    my $blist_loc = $engine->storage->read_at( $self->offset + 2, $engine->byte_size );
     return unpack( $StP{$engine->byte_size}, $blist_loc );
 }
 
@@ -817,7 +822,7 @@ sub get_bucket_list {
         my $blist = DBM::Deep::Engine::Sector::BucketList->new({
             engine => $engine,
         });
-        $engine->storage->print_at( $self->offset + 2 + $engine->byte_size,
+        $engine->storage->print_at( $self->offset + 2,
             pack( $StP{$engine->byte_size}, $blist->offset ),
         );
         return $blist;
@@ -832,16 +837,14 @@ sub get_bucket_list {
 sub get_classname {
     my $self = shift;
 
-    my $is_blessed = $self->engine->storage->read_at(
-        $self->offset + 2 + 2 * $self->engine->byte_size, 1,
+    my $class_offset = $self->engine->storage->read_at(
+        $self->offset + 2 + 1 * $self->engine->byte_size, $self->engine->byte_size,
     );
-    $is_blessed = unpack ( $StP{1}, $is_blessed );
+    $class_offset = unpack ( $StP{$self->engine->byte_size}, $class_offset );
 
-    return unless $is_blessed;
+    return unless $class_offset;
 
-    my $classname_len = $self->engine->storage->read_at( undef, 1 );
-    $classname_len = unpack( $StP{1}, $classname_len );
-    return $self->engine->storage->read_at( undef, $classname_len );
+    return $self->engine->_load_sector( $class_offset )->data;
 }
 
 sub data {
diff --git a/t/24_autobless.t b/t/24_autobless.t
index 5f15247..c8bdc21 100644
--- a/t/24_autobless.t
+++ b/t/24_autobless.t
@@ -7,7 +7,7 @@ use strict;
     sub foo { 'foo' };
 }
 
-use Test::More tests => 64;
+use Test::More tests => 65;
 use t::common qw( new_fh );
 
 use_ok( 'DBM::Deep' );
@@ -50,6 +50,8 @@ my ($fh, $filename) = new_fh();
     is( $db->{unblessed}{b}[0], 1 );
     is( $db->{unblessed}{b}[1], 2 );
     is( $db->{unblessed}{b}[2], 3 );
+
+    $db->{blessed_long} = bless {}, 'a' x 1000;
 }
 
 {
@@ -83,6 +85,8 @@ my ($fh, $filename) = new_fh();
 
     $obj->{c} = 'new';
     is( $db->{blessed}{c}, 'new' );
+
+    isa_ok( $db->{blessed_long}, 'a' x 1000 );
 }
 
 {