t/27_filehandle.t

   1 ##
   2 # DBM::Deep Test
   3 ##
   4 use strict;
   5 use Test::More tests => 14;
   6 use Test::Exception;
   7 use t::common qw( new_fh );
   8
   9 use_ok( 'DBM::Deep' );
  10
  11 {
  12     my ($fh, $filename) = new_fh();
  13
  14     # Create the datafile to be used
  15     {
  16         my $db = DBM::Deep->new( $filename );
  17         $db->{hash} = { foo => [ 'a' .. 'c' ] };
  18     }
  19
  20     {
  21         open(my $fh, '<', $filename) || die("Can't open '$filename' for reading: $!\n");
  22
  23         # test if we can open and read a db using its filehandle
  24
  25         my $db;
  26         ok( ($db = DBM::Deep->new( fh => $fh )), "open db in filehandle" );
  27         ok( $db->{hash}{foo}[1] eq 'b', "and get at stuff in the database" );
  28         throws_ok {
  29             $db->{foo} = 1;
  30         } qr/Cannot write to a readonly filehandle/, "Can't write to a read-only filehandle";
  31         ok( !$db->exists( 'foo' ), "foo doesn't exist" );
  32
  33         SKIP: {
  34             skip( "No inode tests on Win32", 1 )
  35                 if ( $^O eq 'MSWin32' || $^O eq 'cygwin' );
  36             my $db_obj = $db->_get_self;
  37             ok( $db_obj->_engine->storage->{inode}, "The inode has been set" );
  38         }
  39
  40         close($fh);
  41     }
  42 }
  43
  44 # now the same, but with an offset into the file.  Use the database that's
  45 # embedded in the test for the DATA filehandle.  First, find the database ...
  46 {
  47     my ($fh,$filename) = new_fh();
  48
  49     print $fh "#!$^X\n";
  50     print $fh <<'__END_FH__';
  51 use strict;
  52 use Test::More no_plan => 1;
  53 Test::More->builder->no_ending(1);
  54 Test::More->builder->{Curr_Test} = 12;
  55
  56 use_ok( 'DBM::Deep' );
  57
  58 my $db = DBM::Deep->new({
  59     fh => *DATA,
  60 });
  61 is($db->{x}, 'b', "and get at stuff in the database");
  62 __END_FH__
  63     print $fh "__DATA__\n";
  64     close $fh;
  65
  66     my $offset = do {
  67         open my $fh, '<', $filename;
  68         while(my $line = <$fh>) {
  69             last if($line =~ /^__DATA__/);
  70         }
  71         tell($fh);
  72     };
  73
  74     {
  75         my $db = DBM::Deep->new({
  76             file        => $filename,
  77             file_offset => $offset,
  78 #XXX For some reason, this is needed to make the test pass. Figure out why later.
  79 locking => 0,
  80         });
  81
  82         $db->{x} = 'b';
  83         is( $db->{x}, 'b', 'and it was stored' );
  84     }
  85
  86     {
  87         open my $fh, '<', $filename;
  88         my $db = DBM::Deep->new({
  89             fh          => $fh,
  90             file_offset => $offset,
  91         });
  92
  93         is($db->{x}, 'b', "and get at stuff in the database");
  94
  95         ok( !$db->exists( 'foo' ), "foo doesn't exist yet" );
  96         throws_ok {
  97             $db->{foo} = 1;
  98         } qr/Cannot write to a readonly filehandle/, "Can't write to a read-only filehandle";
  99         ok( !$db->exists( 'foo' ), "foo still doesn't exist" );
 100
 101         is( $db->{x}, 'b' );
 102     }
 103
 104     exec( "$^X -Iblib/lib $filename" );
 105 }