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     # Use defined() here because the offset should always be 0. -RobK. 2008-06-20
  21     unless ( $e->storage->size ) {
  22         my $nt = $e->num_txns;
  23         my $bl = $e->txn_bitfield_len;
  24
  25         my $header_var = $self->header_var_size;
  26
  27         $self->{offset} = $e->storage->request_space( $header_fixed + $header_var );
  28         DBM::Deep::_throw_error( "Offset wasn't 0, it's '$self->{offset}'" ) unless $self->offset == 0;
  29
  30         $self->write( $self->offset,
  31             $e->SIG_FILE
  32           . $e->SIG_HEADER
  33           . pack('N', $this_file_version) # At this point, we're at 9 bytes
  34           . pack('N', $header_var)        # header size
  35             # --- Above is $header_fixed. Below is $header_var
  36           . pack('C', $e->byte_size)
  37
  38             # These shenanigans are to allow a 256 within a C
  39           . pack('C', $e->max_buckets - 1)
  40           . pack('C', $e->data_sector_size - 1)
  41
  42           . pack('C', $nt)
  43           . pack('C' . $bl, 0 )                           # Transaction activeness bitfield
  44           . pack($e->StP($DBM::Deep::Engine::STALE_SIZE).($nt-1), 0 x ($nt-1) ) # Transaction staleness counters
  45           . pack($e->StP($e->byte_size), 0) # Start of free chain (blist size)
  46           . pack($e->StP($e->byte_size), 0) # Start of free chain (data size)
  47           . pack($e->StP($e->byte_size), 0) # Start of free chain (index size)
  48         );
  49
  50         $e->set_trans_loc( $header_fixed + 4 );
  51         $e->set_chains_loc( $header_fixed + 4 + $bl + $DBM::Deep::Engine::STALE_SIZE * ($nt-1) );
  52
  53         $self->{is_new} = 1;
  54     }
  55     else {
  56         $self->{offset} = 0;
  57
  58         my $s = $e->storage;
  59
  60         my $buffer = $s->read_at( $self->offset, $header_fixed );
  61         return unless length($buffer);
  62
  63         my ($file_signature, $sig_header, $file_version, $size) = unpack(
  64             'A4 A N N', $buffer
  65         );
  66
  67         unless ( $file_signature eq $e->SIG_FILE ) {
  68             $s->close;
  69             DBM::Deep->_throw_error( "Signature not found -- file is not a Deep DB" );
  70         }
  71
  72         unless ( $sig_header eq $e->SIG_HEADER ) {
  73             $s->close;
  74             DBM::Deep->_throw_error( "Pre-1.00 file version found" );
  75         }
  76
  77         unless ( $file_version == $this_file_version ) {
  78             $s->close;
  79             DBM::Deep->_throw_error(
  80                 "Wrong file version found - " .  $file_version .
  81                 " - expected " . $this_file_version
  82             );
  83         }
  84
  85         my $buffer2 = $s->read_at( undef, $size );
  86         my @values = unpack( 'C C C C', $buffer2 );
  87
  88         if ( @values != 4 || grep { !defined } @values ) {
  89             $s->close;
  90             DBM::Deep->_throw_error("Corrupted file - bad header");
  91         }
  92
  93         #XXX Add warnings if values weren't set right
  94         @{$e}{qw(byte_size max_buckets data_sector_size num_txns)} = @values;
  95
  96         # These shenangians are to allow a 256 within a C
  97         $e->{max_buckets} += 1;
  98         $e->{data_sector_size} += 1;
  99
 100         my $header_var = $self->header_var_size;
 101         unless ( $size == $header_var ) {
 102             $s->close;
 103             DBM::Deep->_throw_error( "Unexpected size found ($size <-> $header_var)." );
 104         }
 105
 106         $e->set_trans_loc( $header_fixed + scalar(@values) );
 107
 108         my $bl = $e->txn_bitfield_len;
 109         $e->set_chains_loc( $header_fixed + scalar(@values) + $bl + $DBM::Deep::Engine::STALE_SIZE * ($e->num_txns - 1) );
 110
 111         $self->{is_new} = 1;
 112     }
 113 }
 114
 115 sub header_var_size {
 116     my $self = shift;
 117     my $e = $self->engine;
 118     return 1 + 1 + 1 + 1 + $e->txn_bitfield_len + $DBM::Deep::Engine::STALE_SIZE * ($e->num_txns - 1) + 3 * $e->byte_size;
 119 }
 120
 121 sub size   {
 122     my $self = shift;
 123     $self->{size} ||= $header_fixed + $self->header_var_size;
 124 }
 125 sub is_new { $_[0]{is_new} }
 126
 127 1;
 128 __END__