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

   1 package DBM::Deep::Engine::Sector::Index;
   2
   3 use 5.006_000;
   4
   5 use strict;
   6 use warnings FATAL => 'all';
   7
   8 use DBM::Deep::Engine::Sector;
   9 our @ISA = qw( DBM::Deep::Engine::Sector );
  10
  11 sub _init {
  12     my $self = shift;
  13
  14     my $engine = $self->engine;
  15
  16     unless ( $self->offset ) {
  17         $self->{offset} = $engine->_request_index_sector( $self->size );
  18
  19         $self->write( 0, $engine->SIG_INDEX );
  20     }
  21
  22     return $self;
  23 }
  24
  25 #XXX Change here
  26 #XXX Why? -RobK, 2008-06-18
  27 sub size {
  28     my $self = shift;
  29     unless ( $self->{size} ) {
  30         my $e = $self->engine;
  31         $self->{size} = $self->base_size + $e->byte_size * $e->hash_chars;
  32     }
  33     return $self->{size};
  34 }
  35
  36 sub free_meth { return '_add_free_index_sector' }
  37
  38 sub free {
  39     my $self = shift;
  40     my $e = $self->engine;
  41
  42     for my $i ( 0 .. $e->hash_chars - 1 ) {
  43         my $l = $self->get_entry( $i ) or next;
  44         $e->_load_sector( $l )->free;
  45     }
  46
  47     $self->SUPER::free();
  48 }
  49
  50 sub _loc_for {
  51     my $self = shift;
  52     my ($idx) = @_;
  53     return $self->base_size + $idx * $self->engine->byte_size;
  54 }
  55
  56 sub get_entry {
  57     my $self = shift;
  58     my ($idx) = @_;
  59
  60     my $e = $self->engine;
  61
  62     DBM::Deep->_throw_error( "get_entry: Out of range ($idx)" )
  63         if $idx < 0 || $idx >= $e->hash_chars;
  64
  65     return unpack(
  66         $e->StP($e->byte_size),
  67         $self->read( $self->_loc_for( $idx ), $e->byte_size ),
  68     );
  69 }
  70
  71 sub set_entry {
  72     my $self = shift;
  73     my ($idx, $loc) = @_;
  74
  75     my $e = $self->engine;
  76
  77     DBM::Deep->_throw_error( "set_entry: Out of range ($idx)" )
  78         if $idx < 0 || $idx >= $e->hash_chars;
  79
  80     $self->write( $self->_loc_for( $idx ), pack( $e->StP($e->byte_size), $loc ) );
  81 }
  82
  83 1;
  84 __END__