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

   1 package DBM::Deep::Engine::Sector::FileHeader;
   2
   3 use 5.006;
   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 my $header_fixed = length( &DBM::Deep::Engine::SIG_FILE ) + 1 + 4 + 4;
  12 my $this_file_version = 3;
  13
  14 sub _init {
  15     my $self = shift;
  16
  17     my $e = $self->engine;
  18
  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;
  23
  24         my $header_var = $self->header_var_size;
  25
  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;
  28
  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);
  31
  32         $self->write( 0,
  33             $e->SIG_FILE
  34           . $e->SIG_HEADER
  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)
  39
  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)
  43
  44           . pack('C', $nt)
  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)
  50         );
  51
  52         $e->set_trans_loc( $header_fixed + 4 );
  53         $e->set_chains_loc( $header_fixed + 4 + $bl + $DBM::Deep::Engine::STALE_SIZE * ($nt-1) );
  54
  55         $self->{is_new} = 1;
  56     }
  57     else {
  58         $self->{offset} = 0;
  59         $self->{is_new} = 0;
  60
  61         return if exists $self->engine->sector_cache->{0};
  62
  63         my $s = $e->storage;
  64
  65         my $buffer = $s->read_at( $self->offset, $header_fixed );
  66         return unless length($buffer);
  67
  68         my ($file_signature, $sig_header, $file_version, $size) = unpack(
  69             'A4 A N N', $buffer
  70         );
  71
  72         unless ( $file_signature eq $e->SIG_FILE ) {
  73             $s->close;
  74             DBM::Deep->_throw_error( "Signature not found -- file is not a Deep DB" );
  75         }
  76
  77         unless ( $sig_header eq $e->SIG_HEADER ) {
  78             $s->close;
  79             DBM::Deep->_throw_error( "Pre-1.00 file version found" );
  80         }
  81
  82         unless ( $file_version == $this_file_version ) {
  83             $s->close;
  84             DBM::Deep->_throw_error(
  85                 "Wrong file version found - " .  $file_version .
  86                 " - expected " . $this_file_version
  87             );
  88         }
  89
  90         my $buffer2 = $s->read_at( undef, $size );
  91         my @values = unpack( 'C C C C', $buffer2 );
  92
  93         if ( @values != 4 || grep { !defined } @values ) {
  94             $s->close;
  95             DBM::Deep->_throw_error("Corrupted file - bad header");
  96         }
  97
  98         #XXX Add warnings if values weren't set right
  99         @{$e}{qw(byte_size max_buckets data_sector_size num_txns)} = @values;
 100
 101         # These shenangians are to allow a 256 within a C
 102         $e->{max_buckets} += 1;
 103         $e->{data_sector_size} += 1;
 104
 105         my $header_var = $self->header_var_size;
 106         unless ( $size == $header_var ) {
 107             $s->close;
 108             DBM::Deep->_throw_error( "Unexpected size found ($size <-> $header_var)." );
 109         }
 110
 111         $e->set_trans_loc( $header_fixed + scalar(@values) );
 112
 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) );
 115
 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;
 118     }
 119 }
 120
 121 sub header_var_size {
 122     my $self = shift;
 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;
 125 }
 126
 127 sub size {
 128     my $self = shift;
 129     if ( ref($self) ) {
 130         $self->{size} ||= $header_fixed + $self->header_var_size;
 131     }
 132     else {
 133         return $header_fixed + $self->header_var_size( @_ );
 134     }
 135 }
 136
 137 sub is_new { $_[0]{is_new} }
 138
 139 sub add_free_sector {
 140     my $self = shift;
 141     my ($multiple, $sector) = @_;
 142
 143     my $e = $self->engine;
 144
 145     my $chains_offset = $multiple * $e->byte_size;
 146
 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 ) );
 152
 153     my $old_head = $self->read( $e->chains_loc + $chains_offset, $e->byte_size );
 154
 155     $self->write( $e->chains_loc + $chains_offset,
 156         pack( $e->StP($e->byte_size), $sector->offset ),
 157     );
 158
 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 );
 161 }
 162
 163 sub request_sector {
 164     my $self = shift;
 165     my ($multiple, $size) = @_;
 166
 167     my $e = $self->engine;
 168
 169     my $chains_offset = $multiple * $e->byte_size;
 170
 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 );
 173
 174     # We don't have any free sectors of the right size, so allocate a new one.
 175     unless ( $loc ) {
 176         my $offset = $e->storage->request_space( $size );
 177
 178         # Zero out the new sector. This also guarantees correct increases
 179         # in the filesize.
 180         $self->engine->sector_cache->{$offset} = chr(0) x $size;
 181
 182         return $offset;
 183     }
 184
 185     # Need to load the new sector so we can read from it.
 186     my $new_sector = $self->engine->get_data( $loc, $size );
 187
 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 );
 190
 191     $self->write( $e->chains_loc + $chains_offset, $new_head );
 192
 193     return $loc;
 194 }
 195
 196 1;
 197 __END__