lib/DBM/Deep/Engine/Sector.pm

   1 package DBM::Deep::Engine::Sector;
   2
   3 use 5.006_000;
   4
   5 use strict;
   6 use warnings FATAL => 'all';
   7
   8 use Scalar::Util ();
   9
  10 sub new {
  11     my $self = bless $_[1], $_[0];
  12     Scalar::Util::weaken( $self->{engine} );
  13
  14     if ( $self->offset ) {
  15         $self->{string} = $self->engine->storage->read_at(
  16             $self->offset, $self->size,
  17         );
  18     }
  19     else {
  20         $self->{string} = chr(0) x $self->size;
  21     }
  22
  23     $self->_init;
  24
  25     # Add new sectors to the sector cache.
  26     $self->engine->sector_cache->{$self->offset} = $self;
  27
  28     return $self;
  29 }
  30
  31 #sub _init {}
  32 #sub clone { DBM::Deep->_throw_error( "Must be implemented in the child class" ); }
  33
  34 sub engine { $_[0]{engine} }
  35 sub offset { $_[0]{offset} }
  36 sub type   { $_[0]{type}   }
  37
  38 sub base_size {
  39    my $self = shift;
  40    no warnings 'once';
  41    return $self->engine->SIG_SIZE + $DBM::Deep::Engine::STALE_SIZE;
  42 }
  43
  44 sub free {
  45     my $self = shift;
  46
  47     my $e = $self->engine;
  48
  49     $self->write( 0, $e->SIG_FREE );
  50     $self->write( $self->base_size, chr(0) x ($self->size - $self->base_size) );
  51
  52     $e->flush;
  53
  54 #    $e->storage->print_at( $self->offset, $e->SIG_FREE );
  55 #    # Skip staleness counter
  56 #    $e->storage->print_at( $self->offset + $self->base_size,
  57 #        chr(0) x ($self->size - $self->base_size),
  58 #    );
  59
  60     #TODO When freeing two sectors, we cannot flush them right away! This means the following:
  61     # 1) The header has to understand about unflushed items.
  62     # 2) Loading a sector has to go through a cache to make sure we see what's already been loaded.
  63     # 3) The header should be cached.
  64
  65     my $free_meth = $self->free_meth;
  66     $e->$free_meth( $self->offset, $self->size );
  67
  68     return;
  69 }
  70
  71 sub read {
  72     my $self = shift;
  73     my ($start, $length) = @_;
  74     if ( $length ) {
  75         return substr( $self->{string}, $start, $length );
  76     }
  77     else {
  78         return substr( $self->{string}, $start );
  79     }
  80 }
  81
  82 sub write {
  83     my $self = shift;
  84     my ($start, $text) = @_;
  85
  86     substr( $self->{string}, $start, length($text) ) = $text;
  87
  88     $self->mark_dirty;
  89 }
  90
  91 sub mark_dirty {
  92     my $self = shift;
  93     $self->engine->add_dirty_sector( $self );
  94 }
  95
  96 sub flush {
  97     my $self = shift;
  98     $self->engine->storage->print_at( $self->offset, $self->{string} );
  99 }
 100
 101 1;
 102 __END__