autobless added back in
rkinyon [Mon, 4 Dec 2006 04:12:36 +0000 (04:12 +0000)]
lib/DBM/Deep/Engine3.pm
t/24_autobless.t [moved from t/24_autobless.todo with 98% similarity]

index 114066e..e3b34f3 100644 (file)
@@ -696,17 +696,20 @@ sub _init {
     my $engine = $self->engine;
 
     unless ( $self->offset ) {
-        my $leftover = $self->size - 4 - 2 * $engine->byte_size;
+        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;
 
         $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}, 0 ),                  # Blessedness
-            pack( $StP{1}, 0 ),                  # Classname length
-            chr(0) x $leftover,                  # Zero-fill the data
+            $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
         );
 
         return;
@@ -755,6 +758,21 @@ 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,
+    );
+    $is_blessed = unpack ( $StP{1}, $is_blessed );
+
+    return unless $is_blessed;
+
+    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 );
+}
+
 sub data {
     my $self = shift;
 
@@ -764,6 +782,13 @@ sub data {
         storage     => $self->engine->storage,
     });
 
+    if ( $self->engine->storage->{autobless} ) {
+        my $classname = $self->get_classname;
+        if ( defined $classname ) {
+            bless $new_obj, $classname;
+        }
+    }
+
     return $new_obj;
 }
 
similarity index 98%
rename from t/24_autobless.todo
rename to t/24_autobless.t
index 9483fbd..953ecd8 100644 (file)
@@ -148,6 +148,8 @@ my ($fh, $filename) = new_fh();
     is( $db->{unblessed}{b}[2], 3 );
 }
 
+SKIP: {
+    skip "import() not ready yet", 2;
 my ($fh2, $filename2) = new_fh();
 {
     my $db = DBM::Deep->new(
@@ -172,6 +174,7 @@ my ($fh2, $filename2) = new_fh();
     isa_ok( $blessed, 'Foo' );
     is( $blessed->{a}, 1 );
 }
+}
 
 {
        ##