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

   1 package DBM::Deep::Engine::Sector::Index;
   2
   3 use base qw( DBM::Deep::Engine::Sector );
   4
   5 my $STALE_SIZE = 2;
   6
   7 # Please refer to the pack() documentation for further information
   8 my %StP = (
   9     1 => 'C', # Unsigned char value (no order needed as it's just one byte)
  10     2 => 'n', # Unsigned short in "network" (big-endian) order
  11     4 => 'N', # Unsigned long in "network" (big-endian) order
  12     8 => 'Q', # Usigned quad (no order specified, presumably machine-dependent)
  13 );
  14
  15 sub _init {
  16     my $self = shift;
  17
  18     my $engine = $self->engine;
  19
  20     unless ( $self->offset ) {
  21         my $leftover = $self->size - $self->base_size;
  22
  23         $self->{offset} = $engine->_request_index_sector( $self->size );
  24         $engine->storage->print_at( $self->offset, $engine->SIG_INDEX ); # Sector type
  25         # Skip staleness counter
  26         $engine->storage->print_at( $self->offset + $self->base_size,
  27             chr(0) x $leftover, # Zero-fill the rest
  28         );
  29     }
  30
  31     return $self;
  32 }
  33
  34 #XXX Change here
  35 sub size {
  36     my $self = shift;
  37     unless ( $self->{size} ) {
  38         my $e = $self->engine;
  39         $self->{size} = $self->base_size + $e->byte_size * $e->hash_chars;
  40     }
  41     return $self->{size};
  42 }
  43
  44 sub free_meth { return '_add_free_index_sector' }
  45
  46 sub free {
  47     my $self = shift;
  48     my $e = $self->engine;
  49
  50     for my $i ( 0 .. $e->hash_chars - 1 ) {
  51         my $l = $self->get_entry( $i ) or next;
  52         $e->_load_sector( $l )->free;
  53     }
  54
  55     $self->SUPER::free();
  56 }
  57
  58 sub _loc_for {
  59     my $self = shift;
  60     my ($idx) = @_;
  61     return $self->offset + $self->base_size + $idx * $self->engine->byte_size;
  62 }
  63
  64 sub get_entry {
  65     my $self = shift;
  66     my ($idx) = @_;
  67
  68     my $e = $self->engine;
  69
  70     DBM::Deep->_throw_error( "get_entry: Out of range ($idx)" )
  71         if $idx < 0 || $idx >= $e->hash_chars;
  72
  73     return unpack(
  74         $StP{$e->byte_size},
  75         $e->storage->read_at( $self->_loc_for( $idx ), $e->byte_size ),
  76     );
  77 }
  78
  79 sub set_entry {
  80     my $self = shift;
  81     my ($idx, $loc) = @_;
  82
  83     my $e = $self->engine;
  84
  85     DBM::Deep->_throw_error( "set_entry: Out of range ($idx)" )
  86         if $idx < 0 || $idx >= $e->hash_chars;
  87
  88     $self->engine->storage->print_at(
  89         $self->_loc_for( $idx ),
  90         pack( $StP{$e->byte_size}, $loc ),
  91     );
  92 }
  93
  94 1;
  95 __END__