1 package DBM::Deep::Engine::Sector::FileHeader;
6 use warnings FATAL => 'all';
8 use DBM::Deep::Engine::Sector;
9 our @ISA = qw( DBM::Deep::Engine::Sector );
11 my $header_fixed = length( &DBM::Deep::Engine::SIG_FILE ) + 1 + 4 + 4;
12 my $this_file_version = 3;
17 my $e = $self->engine;
19 # This means the file is being created.
20 unless ( exists $self->engine->sector_cache->{0} || $self->engine->storage->size ) {
21 my $nt = $e->num_txns;
22 my $bl = $e->txn_bitfield_len;
24 my $header_var = $self->header_var_size;
26 $self->{offset} = $e->storage->request_space( $header_fixed + $header_var );
27 DBM::Deep::_throw_error( "Offset wasn't 0, it's '$self->{offset}'" ) unless $self->offset == 0;
29 # Make sure we set up sector caching so that get_data() works. -RobK, 2008-06-24
30 $self->engine->sector_cache->{$self->offset} = chr(0) x ($header_fixed + $header_var);
35 . pack('N', $this_file_version) # At this point, we're at 9 bytes
36 . pack('N', $header_var) # header size
37 # --- Above is $header_fixed. Below is $header_var
38 . pack('C', $e->byte_size)
40 # These shenanigans are to allow a 256 within a C
41 . pack('C', $e->max_buckets - 1)
42 . pack('C', $e->data_sector_size - 1)
45 . pack('C' . $bl, 0 ) # Transaction activeness bitfield
46 . pack($e->StP($DBM::Deep::Engine::STALE_SIZE).($nt-1), 0 x ($nt-1) ) # Transaction staleness counters
47 . pack($e->StP($e->byte_size), 0) # Start of free chain (blist size)
48 . pack($e->StP($e->byte_size), 0) # Start of free chain (data size)
49 . pack($e->StP($e->byte_size), 0) # Start of free chain (index size)
52 $e->set_trans_loc( $header_fixed + 4 );
53 $e->set_chains_loc( $header_fixed + 4 + $bl + $DBM::Deep::Engine::STALE_SIZE * ($nt-1) );
61 return if exists $self->engine->sector_cache->{0};
65 my $buffer = $s->read_at( $self->offset, $header_fixed );
66 return unless length($buffer);
68 my ($file_signature, $sig_header, $file_version, $size) = unpack(
72 unless ( $file_signature eq $e->SIG_FILE ) {
74 DBM::Deep->_throw_error( "Signature not found -- file is not a Deep DB" );
77 unless ( $sig_header eq $e->SIG_HEADER ) {
79 DBM::Deep->_throw_error( "Pre-1.00 file version found" );
82 unless ( $file_version == $this_file_version ) {
84 DBM::Deep->_throw_error(
85 "Wrong file version found - " . $file_version .
86 " - expected " . $this_file_version
90 my $buffer2 = $s->read_at( undef, $size );
91 my @values = unpack( 'C C C C', $buffer2 );
93 if ( @values != 4 || grep { !defined } @values ) {
95 DBM::Deep->_throw_error("Corrupted file - bad header");
98 #XXX Add warnings if values weren't set right
99 @{$e}{qw(byte_size max_buckets data_sector_size num_txns)} = @values;
101 # These shenangians are to allow a 256 within a C
102 $e->{max_buckets} += 1;
103 $e->{data_sector_size} += 1;
105 my $header_var = $self->header_var_size;
106 unless ( $size == $header_var ) {
108 DBM::Deep->_throw_error( "Unexpected size found ($size <-> $header_var)." );
111 $e->set_trans_loc( $header_fixed + scalar(@values) );
113 my $bl = $e->txn_bitfield_len;
114 $e->set_chains_loc( $header_fixed + scalar(@values) + $bl + $DBM::Deep::Engine::STALE_SIZE * ($e->num_txns - 1) );
116 # Make sure we set up sector caching so that get_data() works. -RobK, 2008-06-24
117 $self->engine->sector_cache->{$self->offset} = $buffer . $buffer2;
121 sub header_var_size {
123 my $e = shift || $self->engine;
124 return 1 + 1 + 1 + 1 + $e->txn_bitfield_len + $DBM::Deep::Engine::STALE_SIZE * ($e->num_txns - 1) + 3 * $e->byte_size;
130 $self->{size} ||= $header_fixed + $self->header_var_size;
133 return $header_fixed + $self->header_var_size( @_ );
137 sub is_new { $_[0]{is_new} }
139 sub add_free_sector {
141 my ($multiple, $sector) = @_;
143 my $e = $self->engine;
145 my $chains_offset = $multiple * $e->byte_size;
147 # Increment staleness.
148 # XXX Can this increment+modulo be done by "&= 0x1" ?
149 my $staleness = unpack( $e->StP($DBM::Deep::Engine::STALE_SIZE), $sector->read( $e->SIG_SIZE, $DBM::Deep::Engine::STALE_SIZE ) );
150 $staleness = ($staleness + 1 ) % ( 2 ** ( 8 * $DBM::Deep::Engine::STALE_SIZE ) );
151 $sector->write( $e->SIG_SIZE, pack( $e->StP($DBM::Deep::Engine::STALE_SIZE), $staleness ) );
153 my $old_head = $self->read( $e->chains_loc + $chains_offset, $e->byte_size );
155 $self->write( $e->chains_loc + $chains_offset,
156 pack( $e->StP($e->byte_size), $sector->offset ),
159 # Record the old head in the new sector after the signature and staleness counter
160 $sector->write( $e->SIG_SIZE + $DBM::Deep::Engine::STALE_SIZE, $old_head );
165 my ($multiple, $size) = @_;
167 my $e = $self->engine;
169 my $chains_offset = $multiple * $e->byte_size;
171 my $old_head = $self->read( $e->chains_loc + $chains_offset, $e->byte_size );
172 my $loc = unpack( $e->StP($e->byte_size), $old_head );
174 # We don't have any free sectors of the right size, so allocate a new one.
176 my $offset = $e->storage->request_space( $size );
178 # Zero out the new sector. This also guarantees correct increases
180 $self->engine->sector_cache->{$offset} = chr(0) x $size;
185 # Need to load the new sector so we can read from it.
186 my $new_sector = $self->engine->get_data( $loc, $size );
188 # Read the new head after the signature and the staleness counter
189 my $new_head = substr( $$new_sector, $e->SIG_SIZE + $DBM::Deep::Engine::STALE_SIZE, $e->byte_size );
191 $self->write( $e->chains_loc + $chains_offset, $new_head );
198 my $e = $self->engine;
199 my $bl = $e->txn_bitfield_len;
200 my $num_bits = $bl * 8;
201 my @x = split '', unpack( 'b'.$num_bits, $self->read( $e->trans_loc, $bl ) );
205 sub write_txn_slots {
207 my $e = $self->engine;
208 my $num_bits = $e->txn_bitfield_len * 8;
209 $self->write( $e->trans_loc,
210 pack( 'b'.$num_bits, join('', @_) ),
214 sub get_txn_staleness_counter {
218 # Hardcode staleness of 0 for the HEAD
219 return 0 unless $trans_id;
221 my $e = $self->engine;
222 return unpack( $e->StP($DBM::Deep::Engine::STALE_SIZE),
224 $e->trans_loc + $e->txn_bitfield_len + $DBM::Deep::Engine::STALE_SIZE * ($trans_id - 1),
225 $DBM::Deep::Engine::STALE_SIZE,
230 sub inc_txn_staleness_counter {
234 # Hardcode staleness of 0 for the HEAD
235 return 0 unless $trans_id;
237 my $e = $self->engine;
239 $e->trans_loc + $e->txn_bitfield_len + $DBM::Deep::Engine::STALE_SIZE * ($trans_id - 1),
240 pack( $e->StP($DBM::Deep::Engine::STALE_SIZE), $self->get_txn_staleness_counter( $trans_id ) + 1 ),