Fixed storage->size to only return what the size of the DB is, not the file as a...
[dbsrgits/DBM-Deep.git] / t / 27_filehandle.t
CommitLineData
714618f0 1##
2# DBM::Deep Test
3##
4use strict;
3e9498a1 5use Test::More tests => 14;
acd4faf2 6use Test::Exception;
fde3db1a 7use t::common qw( new_fh );
714618f0 8
2a81bf9e 9use_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
888453b9 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;
888453b9 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
6e6789b0 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;
f1879fdc 37 ok( $db_obj->_engine->storage->{inode}, "The inode has been set" );
6e6789b0 38 }
3e9498a1 39
40 close($fh);
41 }
70b55428 42}
714618f0 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 ...
3e9498a1 46{
47 my ($fh,$filename) = new_fh();
70b55428 48
3e9498a1 49 print $fh "#!$^X\n";
50 print $fh <<'__END_FH__';
51use strict;
52use Test::More no_plan => 1;
53Test::More->builder->no_ending(1);
54Test::More->builder->{Curr_Test} = 12;
70b55428 55
3e9498a1 56use_ok( 'DBM::Deep' );
70b55428 57
3e9498a1 58my $db = DBM::Deep->new({
59 fh => *DATA,
60});
61is($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,
2120a181 78#XXX For some reason, this is needed to make the test pass. Figure out why later.
79locking => 0,
3e9498a1 80 });
81
82 $db->{x} = 'b';
83 is( $db->{x}, 'b', 'and it was stored' );
84 }
85
3e9498a1 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
f3c5ac06 101 is( $db->{x}, 'b', "x is still 'b'" );
3e9498a1 102 }
103
019404df 104 exec( "$^X -Iblib/lib $filename" );
70b55428 105}