t/27_filehandle.t

   1 ##
   2 # DBM::Deep Test
   3 ##
   4 use strict;
   5 use Test::More tests => 11;
   6 use Test::Exception;
   7 use File::Temp qw( tempfile tempdir );
   8 use Fcntl qw( :flock );
   9
  10 use_ok( 'DBM::Deep' );
  11
  12 my $dir = tempdir( CLEANUP => 1 );
  13 my ($fh, $filename) = tempfile( 'tmpXXXX', UNLINK => 1, DIR => $dir );
  14 flock $fh, LOCK_UN;
  15
  16 # Create the datafile to be used
  17 {
  18     my $db = DBM::Deep->new( $filename );
  19     $db->{hash} = { foo => [ 'a' .. 'c' ] };
  20 }
  21
  22 {
  23     open(FILE, $filename) || die("Can't open '$filename' for reading: $!\n");
  24
  25     my $db;
  26
  27     # test if we can open and read a db using its filehandle
  28
  29     ok(($db = DBM::Deep->new(fh => *FILE)), "open db in filehandle");
  30     ok($db->{hash}->{foo}->[1] eq 'b', "and get at stuff in the database");
  31     throws_ok {
  32         $db->{foo} = 1;
  33     } qr/Cannot write to a readonly filehandle/,
  34       "Can't write to a read-only filehandle";
  35     ok( !$db->exists( 'foo' ), "foo doesn't exist" );
  36
  37     my $db_obj = $db->_get_self;
  38     ok( $db_obj->_root->{inode}, "The inode has been set" );
  39
  40     close(FILE);
  41 }
  42
  43 # now the same, but with an offset into the file.  Use the database that's
  44 # embedded in the test for the DATA filehandle.  First, find the database ...
  45 open(FILE, "t/28_DATA.t") || die("Can't open t/28_DATA.t\n");
  46 while(my $line = <FILE>) {
  47     last if($line =~ /^__DATA__/);
  48 }
  49 my $offset = tell(FILE);
  50 close(FILE);
  51
  52 SKIP: {
  53     skip "File header and format changed ... gah!", 5;
  54     open(FILE, "t/28_DATA.t");
  55
  56     my $db;
  57
  58     ok(($db = DBM::Deep->new(fh => *FILE, file_offset => $offset)), "open db in filehandle with offset");
  59
  60     ok($db->{hash}->{foo}->[1] eq 'b', "and get at stuff in the database");
  61
  62     ok( !$db->exists( 'foo' ), "foo doesn't exist yet" );
  63     throws_ok {
  64         $db->{foo} = 1;
  65     } qr/Cannot write to a readonly filehandle/, "Can't write to a read-only filehandle";
  66     ok( !$db->exists( 'foo' ), "foo doesn't exist" );
  67
  68     close FILE;
  69 }