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         $self->engine->load_sector( $chain_loc )->free;
  29     }
  30
  31     return;
  32 }
  33
  34 sub clone {
  35     my $self = shift;
  36     return ref($self)->new({
  37         engine => $self->engine,
  38         type   => $self->type,
  39         data   => $self->data,
  40     });
  41 }
  42
  43 sub type { $_[0]{engine}->SIG_DATA }
  44 sub _init {
  45     my $self = shift;
  46
  47     my $engine = $self->engine;
  48
  49     unless ( $self->offset ) {
  50         my $data_section = $self->size - $self->base_size - $engine->byte_size - 1;
  51
  52         $self->{offset} = $engine->_request_data_sector( $self->size );
  53
  54         my $data = delete $self->{data};
  55         my $dlen = length $data;
  56         my $continue = 1;
  57         my $curr_offset = $self->offset;
  58         while ( $continue ) {
  59
  60             my $next_offset = 0;
  61
  62             my ($leftover, $this_len, $chunk);
  63             if ( $dlen > $data_section ) {
  64                 $leftover = 0;
  65                 $this_len = $data_section;
  66                 $chunk = substr( $data, 0, $this_len );
  67
  68                 $dlen -= $data_section;
  69                 $next_offset = $engine->_request_data_sector( $self->size );
  70                 $data = substr( $data, $this_len );
  71             }
  72             else {
  73                 $leftover = $data_section - $dlen;
  74                 $this_len = $dlen;
  75                 $chunk = $data;
  76
  77                 $continue = 0;
  78             }
  79
  80             $engine->storage->print_at( $curr_offset, $self->type ); # Sector type
  81             # Skip staleness
  82             $engine->storage->print_at( $curr_offset + $self->base_size,
  83                 pack( $StP{$engine->byte_size}, $next_offset ),  # Chain loc
  84                 pack( $StP{1}, $this_len ),                      # Data length
  85                 $chunk,                                          # Data to be stored in this sector
  86                 chr(0) x $leftover,                              # Zero-fill the rest
  87             );
  88
  89             $curr_offset = $next_offset;
  90         }
  91
  92         return;
  93     }
  94 }
  95
  96 sub data_length {
  97     my $self = shift;
  98
  99     my $buffer = $self->engine->storage->read_at(
 100         $self->offset + $self->base_size + $self->engine->byte_size, 1
 101     );
 102
 103     return unpack( $StP{1}, $buffer );
 104 }
 105
 106 sub chain_loc {
 107     my $self = shift;
 108     return unpack(
 109         $StP{$self->engine->byte_size},
 110         $self->engine->storage->read_at(
 111             $self->offset + $self->base_size,
 112             $self->engine->byte_size,
 113         ),
 114     );
 115 }
 116
 117 sub data {
 118     my $self = shift;
 119
 120     my $data;
 121     while ( 1 ) {
 122         my $chain_loc = $self->chain_loc;
 123
 124         $data .= $self->engine->storage->read_at(
 125             $self->offset + $self->base_size + $self->engine->byte_size + 1, $self->data_length,
 126         );
 127
 128         last unless $chain_loc;
 129
 130         $self = $self->engine->load_sector( $chain_loc );
 131     }
 132
 133     return $data;
 134 }
 135
 136 1;
 137 __END__