Fix fatal recursion warnings (plus tests)

[dbsrgits/DBM-Deep.git] / lib / DBM / Deep / Engine / Sector / Scalar.pm

diff --git a/lib/DBM/Deep/Engine/Sector/Scalar.pm b/lib/DBM/Deep/Engine/Sector/Scalar.pm
index 8984b94..f045f51 100644 (file)
--- a/lib/DBM/Deep/Engine/Sector/Scalar.pm
+++ b/lib/DBM/Deep/Engine/Sector/Scalar.pm
@@ -1,15 +1,22 @@
-#TODO: Convert this to a string
 package DBM::Deep::Engine::Sector::Scalar;
 
-use 5.006;
+use 5.006_000;
 
 use strict;
 use warnings FATAL => 'all';
+no warnings 'recursion';
 
-our $VERSION = '0.01';
+use base qw( DBM::Deep::Engine::Sector::Data );
 
-use DBM::Deep::Engine::Sector::Data;
-our @ISA = qw( DBM::Deep::Engine::Sector::Data );
+my $STALE_SIZE = 2;
+
+# Please refer to the pack() documentation for further information
+my %StP = (
+    1 => 'C', # Unsigned char value (no order needed as it's just one byte)
+    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)
+);
 
 sub free {
     my $self = shift;
@@ -32,17 +39,16 @@ sub _init {
     my $engine = $self->engine;
 
     unless ( $self->offset ) {
-        $self->{offset} = $engine->_request_data_sector( $self->size );
-        my $data = delete $self->{data};
-        my $dlen = length $data;
-
         my $data_section = $self->size - $self->base_size - $engine->byte_size - 1;
 
+        $self->{offset} = $engine->_request_data_sector( $self->size );
 
-
-        my $curr_offset = $self->offset;
+        my $data = delete $self->{data};
+        my $dlen = length $data;
         my $continue = 1;
+        my $curr_offset = $self->offset;
         while ( $continue ) {
+
             my $next_offset = 0;
 
             my ($leftover, $this_len, $chunk);
@@ -63,18 +69,15 @@ sub _init {
                 $continue = 0;
             }
 
-            my $string = chr(0) x $self->size;
-            substr( $string, 0, 1, $self->type );
-            substr( $string, $self->base_size, $engine->byte_size + 1,
-                pack( $engine->StP($engine->byte_size), $next_offset ) # Chain loc
-              . pack( $engine->StP(1), $this_len ),                    # Data length
-            );
-            substr( $string, $self->base_size + $engine->byte_size + 1, $this_len,
-                $chunk,
+            $engine->storage->print_at( $curr_offset, $self->type ); # Sector type
+            # Skip staleness
+            $engine->storage->print_at( $curr_offset + $self->base_size,
+                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
             );
 
-            $engine->storage->print_at( $curr_offset, $string );
-
             $curr_offset = $next_offset;
         }
 
@@ -89,13 +92,13 @@ sub data_length {
         $self->offset + $self->base_size + $self->engine->byte_size, 1
     );
 
-    return unpack( $self->engine->StP(1), $buffer );
+    return unpack( $StP{1}, $buffer );
 }
 
 sub chain_loc {
     my $self = shift;
     return unpack(
-        $self->engine->StP($self->engine->byte_size),
+        $StP{$self->engine->byte_size},
         $self->engine->storage->read_at(
             $self->offset + $self->base_size,
             $self->engine->byte_size,