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
   8 use base qw( DBM::Deep::Engine::Sector::Data );
   9
  10 sub free {
  11     my $self = shift;
  12
  13     my $chain_loc = $self->chain_loc;
  14
  15     $self->SUPER::free();
  16
  17     if ( $chain_loc ) {
  18         $self->engine->_load_sector( $chain_loc )->free;
  19     }
  20
  21     return;
  22 }
  23
  24 sub type { $_[0]{engine}->SIG_DATA }
  25 sub _init {
  26     my $self = shift;
  27
  28     my $engine = $self->engine;
  29
  30     unless ( $self->offset ) {
  31         my $data_section = $self->size - $self->base_size - $engine->byte_size - 1;
  32
  33         $self->{offset} = $engine->_request_data_sector( $self->size );
  34
  35         my $data = delete $self->{data};
  36         my $dlen = length $data;
  37         my $continue = 1;
  38         my $curr_offset = $self->offset;
  39         while ( $continue ) {
  40
  41             my $next_offset = 0;
  42
  43             my ($leftover, $this_len, $chunk);
  44             if ( $dlen > $data_section ) {
  45                 $leftover = 0;
  46                 $this_len = $data_section;
  47                 $chunk = substr( $data, 0, $this_len );
  48
  49                 $dlen -= $data_section;
  50                 $next_offset = $engine->_request_data_sector( $self->size );
  51                 $data = substr( $data, $this_len );
  52             }
  53             else {
  54                 $leftover = $data_section - $dlen;
  55                 $this_len = $dlen;
  56                 $chunk = $data;
  57
  58                 $continue = 0;
  59             }
  60
  61             $engine->storage->print_at( $curr_offset, $self->type ); # Sector type
  62             # Skip staleness
  63             $engine->storage->print_at( $curr_offset + $self->base_size,
  64                 pack( $StP{$engine->byte_size}, $next_offset ),  # Chain loc
  65                 pack( $StP{1}, $this_len ),                      # Data length
  66                 $chunk,                                          # Data to be stored in this sector
  67                 chr(0) x $leftover,                              # Zero-fill the rest
  68             );
  69
  70             $curr_offset = $next_offset;
  71         }
  72
  73         return;
  74     }
  75 }
  76
  77 sub data_length {
  78     my $self = shift;
  79
  80     my $buffer = $self->engine->storage->read_at(
  81         $self->offset + $self->base_size + $self->engine->byte_size, 1
  82     );
  83
  84     return unpack( $StP{1}, $buffer );
  85 }
  86
  87 sub chain_loc {
  88     my $self = shift;
  89     return unpack(
  90         $StP{$self->engine->byte_size},
  91         $self->engine->storage->read_at(
  92             $self->offset + $self->base_size,
  93             $self->engine->byte_size,
  94         ),
  95     );
  96 }
  97
  98 sub data {
  99     my $self = shift;
 100 #    my ($args) = @_;
 101 #    $args ||= {};
 102
 103     my $data;
 104     while ( 1 ) {
 105         my $chain_loc = $self->chain_loc;
 106
 107         $data .= $self->engine->storage->read_at(
 108             $self->offset + $self->base_size + $self->engine->byte_size + 1, $self->data_length,
 109         );
 110
 111         last unless $chain_loc;
 112
 113         $self = $self->engine->_load_sector( $chain_loc );
 114     }
 115
 116     return $data;
 117 }
 118
 119 1;
 120 __END__