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