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

   1 #TODO: Add chaining back in.
   2 package DBM::Deep::Engine::Sector::Scalar;
   3
   4 use 5.006_000;
   5
   6 use strict;
   7 use warnings FATAL => 'all';
   8
   9 use DBM::Deep::Engine::Sector::Data;
  10 our @ISA = qw( DBM::Deep::Engine::Sector::Data );
  11
  12 sub free {
  13     my $self = shift;
  14
  15     my $chain_loc = $self->chain_loc;
  16
  17     $self->SUPER::free();
  18
  19     if ( $chain_loc ) {
  20         $self->engine->_load_sector( $chain_loc )->free;
  21     }
  22
  23     return;
  24 }
  25
  26 sub type { $_[0]{engine}->SIG_DATA }
  27 sub _init {
  28     my $self = shift;
  29
  30     my $engine = $self->engine;
  31
  32     unless ( $self->offset ) {
  33         $self->{offset} = $engine->_request_data_sector( $self->size );
  34         my $data = delete $self->{data};
  35         my $dlen = length $data;
  36
  37         my $data_section = $self->size - $self->base_size - $engine->byte_size - 1;
  38         my $next_offset = 0;
  39
  40         if ( $dlen > $data_section ) {
  41             DBM::Deep->_throw_error( "Storage of values longer than $data_section not supported." );
  42         }
  43
  44         $self->write( 0, $self->type );
  45         $self->write( $self->base_size,
  46             pack( $engine->StP($engine->byte_size), $next_offset ) # Chain loc
  47           . pack( $engine->StP(1), $dlen )                         # Data length
  48           . $data
  49         );
  50
  51         return;
  52     }
  53 }
  54
  55 sub data_length {
  56     my $self = shift;
  57
  58     return unpack(
  59         $self->engine->StP(1),
  60         $self->read( $self->base_size + $self->engine->byte_size, 1 ),
  61     );
  62 }
  63
  64 sub chain_loc {
  65     my $self = shift;
  66     return unpack(
  67         $self->engine->StP($self->engine->byte_size),
  68         $self->read(
  69             $self->base_size,
  70             $self->engine->byte_size,
  71         ),
  72     );
  73 }
  74
  75 sub data {
  76     my $self = shift;
  77
  78     my $data;
  79     while ( 1 ) {
  80         my $chain_loc = $self->chain_loc;
  81
  82         $data .= $self->read( $self->base_size + $self->engine->byte_size + 1, $self->data_length );
  83
  84         last unless $chain_loc;
  85
  86         $self = $self->engine->_load_sector( $chain_loc );
  87     }
  88
  89     return $data;
  90 }
  91
  92 1;
  93 __END__