t/27_filehandle.t

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