All the tests now pass with the broken out classes
[dbsrgits/DBM-Deep.git] / 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__