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