lib/DBM/Deep/Engine/Sector/Scalar.pm

   1 package DBM::Deep::Engine::Sector::Scalar;
   2
   3 use 5.006_000;
   4
   5 use strict;
   6 use warnings FATAL => 'all';
   7 no warnings 'recursion';
   8
   9 use base qw( DBM::Deep::Engine::Sector::Data );
  10
  11 my $STALE_SIZE = 2;
  12
  13 # Please refer to the pack() documentation for further information
  14 my %StP = (
  15     1 => 'C', # Unsigned char value (no order needed as it's just one byte)
  16     2 => 'n', # Unsigned short in "network" (big-endian) order
  17     4 => 'N', # Unsigned long in "network" (big-endian) order
  18     8 => 'Q', # Usigned quad (no order specified, presumably machine-dependent)
  19 );
  20
  21 sub free {
  22     my $self = shift;
  23
  24     my $chain_loc = $self->chain_loc;
  25
  26     $self->SUPER::free();
  27
  28     if ( $chain_loc ) {
  29         $self->engine->_load_sector( $chain_loc )->free;
  30     }
  31
  32     return;
  33 }
  34
  35 sub type { $_[0]{engine}->SIG_DATA }
  36 sub _init {
  37     my $self = shift;
  38
  39     my $engine = $self->engine;
  40
  41     unless ( $self->offset ) {
  42         my $data_section = $self->size - $self->base_size - $engine->byte_size - 1;
  43
  44         $self->{offset} = $engine->_request_data_sector( $self->size );
  45
  46         my $data = delete $self->{data};
  47         my $dlen = length $data;
  48         my $continue = 1;
  49         my $curr_offset = $self->offset;
  50         while ( $continue ) {
  51
  52             my $next_offset = 0;
  53
  54             my ($leftover, $this_len, $chunk);
  55             if ( $dlen > $data_section ) {
  56                 $leftover = 0;
  57                 $this_len = $data_section;
  58                 $chunk = substr( $data, 0, $this_len );
  59
  60                 $dlen -= $data_section;
  61                 $next_offset = $engine->_request_data_sector( $self->size );
  62                 $data = substr( $data, $this_len );
  63             }
  64             else {
  65                 $leftover = $data_section - $dlen;
  66                 $this_len = $dlen;
  67                 $chunk = $data;
  68
  69                 $continue = 0;
  70             }
  71
  72             $engine->storage->print_at( $curr_offset, $self->type ); # Sector type
  73             # Skip staleness
  74             $engine->storage->print_at( $curr_offset + $self->base_size,
  75                 pack( $StP{$engine->byte_size}, $next_offset ),  # Chain loc
  76                 pack( $StP{1}, $this_len ),                      # Data length
  77                 $chunk,                                          # Data to be stored in this sector
  78                 chr(0) x $leftover,                              # Zero-fill the rest
  79             );
  80
  81             $curr_offset = $next_offset;
  82         }
  83
  84         return;
  85     }
  86 }
  87
  88 sub data_length {
  89     my $self = shift;
  90
  91     my $buffer = $self->engine->storage->read_at(
  92         $self->offset + $self->base_size + $self->engine->byte_size, 1
  93     );
  94
  95     return unpack( $StP{1}, $buffer );
  96 }
  97
  98 sub chain_loc {
  99     my $self = shift;
 100     return unpack(
 101         $StP{$self->engine->byte_size},
 102         $self->engine->storage->read_at(
 103             $self->offset + $self->base_size,
 104             $self->engine->byte_size,
 105         ),
 106     );
 107 }
 108
 109 sub data {
 110     my $self = shift;
 111 #    my ($args) = @_;
 112 #    $args ||= {};
 113
 114     my $data;
 115     while ( 1 ) {
 116         my $chain_loc = $self->chain_loc;
 117
 118         $data .= $self->engine->storage->read_at(
 119             $self->offset + $self->base_size + $self->engine->byte_size + 1, $self->data_length,
 120         );
 121
 122         last unless $chain_loc;
 123
 124         $self = $self->engine->_load_sector( $chain_loc );
 125     }
 126
 127     return $data;
 128 }
 129
 130 1;
 131 __END__