lib/DBM/Deep/Engine.pm

   1 package DBM::Deep::Engine;
   2
   3 use strict;
   4
   5 use Fcntl qw( :DEFAULT :flock :seek );
   6
   7 sub open {
   8         ##
   9         # Open a fh to the database, create if nonexistent.
  10         # Make sure file signature matches DBM::Deep spec.
  11         ##
  12     shift;
  13     my $self = shift;
  14
  15         if (defined($self->_fh)) { $self->_close(); }
  16
  17     eval {
  18         local $SIG{'__DIE__'};
  19         # Theoretically, adding O_BINARY should remove the need for the binmode
  20         # Of course, testing it is going to be ... interesting.
  21         my $flags = O_RDWR | O_CREAT | O_BINARY;
  22
  23         my $fh;
  24         sysopen( $fh, $self->_root->{file}, $flags )
  25             or $fh = undef;
  26         $self->_root->{fh} = $fh;
  27     }; if ($@ ) { $self->_throw_error( "Received error: $@\n" ); }
  28         if (! defined($self->_fh)) {
  29                 return $self->_throw_error("Cannot sysopen file: " . $self->_root->{file} . ": $!");
  30         }
  31
  32     my $fh = $self->_fh;
  33
  34     #XXX Can we remove this by using the right sysopen() flags?
  35     # Maybe ... q.v. above
  36     binmode $fh; # for win32
  37
  38     if ($self->_root->{autoflush}) {
  39         my $old = select $fh;
  40         $|=1;
  41         select $old;
  42     }
  43
  44     seek($fh, 0 + $self->_root->{file_offset}, SEEK_SET);
  45
  46     my $signature;
  47     my $bytes_read = read( $fh, $signature, length(DBM::Deep->SIG_FILE));
  48
  49     ##
  50     # File is empty -- write signature and master index
  51     ##
  52     if (!$bytes_read) {
  53         seek($fh, 0 + $self->_root->{file_offset}, SEEK_SET);
  54         print( $fh DBM::Deep->SIG_FILE);
  55         $self->_create_tag($self->_base_offset, $self->_type, chr(0) x $DBM::Deep::INDEX_SIZE);
  56
  57         my $plain_key = "[base]";
  58         print( $fh pack($DBM::Deep::DATA_LENGTH_PACK, length($plain_key)) . $plain_key );
  59
  60         # Flush the filehandle
  61         my $old_fh = select $fh;
  62         my $old_af = $|; $| = 1; $| = $old_af;
  63         select $old_fh;
  64
  65         my @stats = stat($fh);
  66         $self->_root->{inode} = $stats[1];
  67         $self->_root->{end} = $stats[7];
  68
  69         return 1;
  70     }
  71
  72     ##
  73     # Check signature was valid
  74     ##
  75     unless ($signature eq DBM::Deep->SIG_FILE) {
  76         $self->_close();
  77         return $self->_throw_error("Signature not found -- file is not a Deep DB");
  78     }
  79
  80         my @stats = stat($fh);
  81         $self->_root->{inode} = $stats[1];
  82     $self->_root->{end} = $stats[7];
  83
  84     ##
  85     # Get our type from master index signature
  86     ##
  87     my $tag = $self->_load_tag($self->_base_offset);
  88
  89 #XXX We probably also want to store the hash algorithm name and not assume anything
  90 #XXX The cool thing would be to allow a different hashing algorithm at every level
  91
  92     if (!$tag) {
  93         return $self->_throw_error("Corrupted file, no master index record");
  94     }
  95     if ($self->{type} ne $tag->{signature}) {
  96         return $self->_throw_error("File type mismatch");
  97     }
  98
  99     return 1;
 100 }
 101
 102 1;
 103 __END__