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