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

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