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

   1 #TODO: Convert this to a string
   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
  39         my $curr_offset = $self->offset;
  40         my $continue = 1;
  41         while ( $continue ) {
  42             my $next_offset = 0;
  43
  44             my ($leftover, $this_len, $chunk);
  45             if ( $dlen > $data_section ) {
  46                 $leftover = 0;
  47                 $this_len = $data_section;
  48                 $chunk = substr( $data, 0, $this_len );
  49
  50                 $dlen -= $data_section;
  51                 $next_offset = $engine->_request_data_sector( $self->size );
  52                 $data = substr( $data, $this_len );
  53             }
  54             else {
  55                 $leftover = $data_section - $dlen;
  56                 $this_len = $dlen;
  57                 $chunk = $data;
  58
  59                 $continue = 0;
  60             }
  61
  62             my $string = chr(0) x $self->size;
  63             substr( $string, 0, $engine->SIG_SIZE, $self->type );
  64             substr( $string, $self->base_size, $engine->byte_size + 1,
  65                 pack( $engine->StP($engine->byte_size), $next_offset ) # Chain loc
  66               . pack( $engine->StP(1), $this_len ),                    # Data length
  67             );
  68             substr( $string, $self->base_size + $engine->byte_size + 1, $this_len,
  69                 $chunk,
  70             );
  71
  72             $engine->storage->print_at( $curr_offset, $string );
  73
  74             $curr_offset = $next_offset;
  75         }
  76
  77         return;
  78     }
  79 }
  80
  81 sub data_length {
  82     my $self = shift;
  83
  84     my $buffer = $self->engine->storage->read_at(
  85         $self->offset + $self->base_size + $self->engine->byte_size, 1
  86     );
  87
  88     return unpack( $self->engine->StP(1), $buffer );
  89 }
  90
  91 sub chain_loc {
  92     my $self = shift;
  93     return unpack(
  94         $self->engine->StP($self->engine->byte_size),
  95         $self->engine->storage->read_at(
  96             $self->offset + $self->base_size,
  97             $self->engine->byte_size,
  98         ),
  99     );
 100 }
 101
 102 sub data {
 103     my $self = shift;
 104 #    my ($args) = @_;
 105 #    $args ||= {};
 106
 107     my $data;
 108     while ( 1 ) {
 109         my $chain_loc = $self->chain_loc;
 110
 111         $data .= $self->engine->storage->read_at(
 112             $self->offset + $self->base_size + $self->engine->byte_size + 1, $self->data_length,
 113         );
 114
 115         last unless $chain_loc;
 116
 117         $self = $self->engine->_load_sector( $chain_loc );
 118     }
 119
 120     return $data;
 121 }
 122
 123 1;
 124 __END__