Large values are now handled

diff --git a/lib/DBM/Deep/Engine3.pm b/lib/DBM/Deep/Engine3.pm
index 89b14ed..c82c76a 100644 (file)
--- a/lib/DBM/Deep/Engine3.pm
+++ b/lib/DBM/Deep/Engine3.pm
@@ -33,7 +33,7 @@ sub SIG_SIZE     () {  1     }
 
 # Please refer to the pack() documentation for further information
 my %StP = (
-    1 => 'c', # Unsigned char value
+    1 => 'C', # Unsigned char value
     2 => 'n', # Unsigned short in "network" (big-endian) order
     4 => 'N', # Unsigned long in "network" (big-endian) order
     8 => 'Q', # Usigned quad (no order specified, presumably machine-dependent)
@@ -623,6 +623,20 @@ package DBM::Deep::Engine::Sector::Scalar;
 
 our @ISA = qw( DBM::Deep::Engine::Sector::Data );
 
+sub free {
+    my $self = shift;
+
+    my $chain_loc = $self->chain_loc;
+
+    $self->SUPER::free();
+
+    if ( $chain_loc ) {
+        $self->engine->_load_sector( $chain_loc )->free;
+    }
+
+    return;
+}
+
 sub type { $_[0]{engine}->SIG_DATA }
 sub _init {
     my $self = shift;
@@ -630,23 +644,48 @@ sub _init {
     my $engine = $self->engine;
 
     unless ( $self->offset ) {
-        my $leftover = $self->size - 3 - 1 * $engine->byte_size;
+        my $data_section = $self->size - 3 - 1 * $engine->byte_size;
 
         my $data = delete $self->{data};
 
-        # XXX Need to build in chaining
-        #XXX This assumes that length($data) > $leftover
-        $leftover -= length( $data );
-
         $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{1}, length($data) ),       # Data length
-            $data,                                # Data to be stored
-            chr(0) x $leftover,                   # Zero-fill the rest
-        );
+
+        my $dlen = length $data;
+        my $continue = 1;
+        my $curr_offset = $self->offset;
+        while ( $continue ) {
+
+            my $next_offset = 0;
+
+            my ($leftover, $this_len, $chunk);
+            if ( $dlen > $data_section ) {
+                $leftover = 0;
+                $this_len = $data_section;
+                $chunk = substr( $data, 0, $this_len );
+
+                $dlen -= $data_section;
+                $next_offset = $engine->_request_sector( $self->size );
+                $data = substr( $data, $this_len );
+            }
+            else {
+                $leftover = $data_section - $dlen;
+                $this_len = $dlen;
+                $chunk = $data;
+
+                $continue = 0;
+            }
+
+            $engine->storage->print_at( $curr_offset,
+                $self->type,                                     # Sector type
+                pack( $StP{1}, 0 ),                              # Recycled counter
+                pack( $StP{$engine->byte_size}, $next_offset ),  # Chain loc
+                pack( $StP{1}, $this_len ),                      # Data length
+                $chunk,                                          # Data to be stored in this sector
+                chr(0) x $leftover,                              # Zero-fill the rest
+            );
+
+            $curr_offset = $next_offset;
+        }
 
         return;
     }
@@ -655,18 +694,35 @@ sub _init {
 sub data_length {
     my $self = shift;
 
-    my $data_len = $self->engine->storage->read_at(
+    my $buffer = $self->engine->storage->read_at(
         $self->offset + 2 + $self->engine->byte_size, 1
     );
-    return unpack( $StP{1}, $data_len );
+
+    return unpack( $StP{1}, $buffer );
+}
+
+sub chain_loc {
+    my $self = shift;
+    my $chain_loc = $self->engine->storage->read_at(
+        $self->offset + 2, $self->engine->byte_size,
+    );
+    return unpack( $StP{$self->engine->byte_size}, $chain_loc );
 }
 
 sub data {
     my $self = shift;
 
-    return $self->engine->storage->read_at(
+    my $chain_loc = $self->chain_loc;
+
+    my $data = $self->engine->storage->read_at(
         $self->offset + 2 + $self->engine->byte_size + 1, $self->data_length,
     );
+
+    if ( $chain_loc ) {
+        $data .= $self->engine->_load_sector( $chain_loc )->data;
+    }
+
+    return $data;
 }
 
 package DBM::Deep::Engine::Sector::Null;