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