From: rkinyon Date: Fri, 7 Apr 2006 00:26:59 +0000 (+0000) Subject: Recommenced testing of DATA filehandle X-Git-Tag: 0-99_01~37 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=3e9498a10c0c718c920c7d692e2a81a4782c72d4;p=dbsrgits%2FDBM-Deep.git Recommenced testing of DATA filehandle --- diff --git a/MANIFEST b/MANIFEST index 3a2c4a0..5bf3774 100644 --- a/MANIFEST +++ b/MANIFEST @@ -35,7 +35,6 @@ t/24_autobless.t t/25_tie_return_value.t t/26_scalar_ref.t t/27_filehandle.t -t/28_DATA.t t/29_freespace_manager.t t/30_already_tied.t t/31_references.t diff --git a/lib/DBM/Deep.pm b/lib/DBM/Deep.pm index fa6ff42..47bf8c8 100644 --- a/lib/DBM/Deep.pm +++ b/lib/DBM/Deep.pm @@ -112,7 +112,7 @@ sub _init { # Grab the parameters we want to use foreach my $param ( keys %$self ) { next unless exists $args->{$param}; - $self->{$param} = $args->{$param} + $self->{$param} = $args->{$param}; } # locking implicitly enables autoflush @@ -636,7 +636,7 @@ sub new { # Grab the parameters we want to use foreach my $param ( keys %$self ) { next unless exists $args->{$param}; - $self->{$param} = $args->{$param} + $self->{$param} = $args->{$param}; } if ( $self->{fh} && !$self->{file_offset} ) { diff --git a/lib/DBM/Deep/Engine.pm b/lib/DBM/Deep/Engine.pm index b6526a7..5597161 100644 --- a/lib/DBM/Deep/Engine.pm +++ b/lib/DBM/Deep/Engine.pm @@ -100,7 +100,7 @@ sub new { # Grab the parameters we want to use foreach my $param ( keys %$self ) { next unless exists $args->{$param}; - $self->{$param} = $args->{$param} + $self->{$param} = $args->{$param}; } $self->precalc_sizes; @@ -118,7 +118,7 @@ sub write_file_header { $obj, length( SIG_FILE ) + $self->{data_size}, ); seek($fh, $loc + $obj->_root->{file_offset}, SEEK_SET); - print( $fh SIG_FILE, pack($self->{data_pack}, 0) ); + print( $fh SIG_FILE, pack('N', 0) ); return; } @@ -136,7 +136,7 @@ sub read_file_header { ); if ( $bytes_read ) { - my ($signature, $version) = unpack( "A4 $self->{data_pack}", $buffer ); + my ($signature, $version) = unpack( 'A4 N', $buffer ); unless ($signature eq SIG_FILE) { $self->close_fh( $obj ); $obj->_throw_error("Signature not found -- file is not a Deep DB"); diff --git a/t/27_filehandle.t b/t/27_filehandle.t index d46439b..2d0b332 100644 --- a/t/27_filehandle.t +++ b/t/27_filehandle.t @@ -2,65 +2,101 @@ # DBM::Deep Test ## use strict; -use Test::More tests => 11; +use Test::More tests => 14; use Test::Exception; use t::common qw( new_fh ); use_ok( 'DBM::Deep' ); -my ($fh, $filename) = new_fh(); - -# Create the datafile to be used { - my $db = DBM::Deep->new( $filename ); - $db->{hash} = { foo => [ 'a' .. 'c' ] }; -} + my ($fh, $filename) = new_fh(); -{ - open(FILE, $filename) || die("Can't open '$filename' for reading: $!\n"); + # Create the datafile to be used + { + my $db = DBM::Deep->new( $filename ); + $db->{hash} = { foo => [ 'a' .. 'c' ] }; + } - my $db; + { + open(my $fh, '<', $filename) || die("Can't open '$filename' for reading: $!\n"); - # test if we can open and read a db using its filehandle + my $db; - ok(($db = DBM::Deep->new(fh => *FILE)), "open db in filehandle"); - ok($db->{hash}->{foo}->[1] eq 'b', "and get at stuff in the database"); - throws_ok { - $db->{foo} = 1; - } qr/Cannot write to a readonly filehandle/, - "Can't write to a read-only filehandle"; - ok( !$db->exists( 'foo' ), "foo doesn't exist" ); + # test if we can open and read a db using its filehandle - my $db_obj = $db->_get_self; - ok( $db_obj->_root->{inode}, "The inode has been set" ); + ok(($db = DBM::Deep->new(fh => $fh)), "open db in filehandle"); + ok($db->{hash}->{foo}->[1] eq 'b', "and get at stuff in the database"); + throws_ok { + $db->{foo} = 1; + } qr/Cannot write to a readonly filehandle/, + "Can't write to a read-only filehandle"; + ok( !$db->exists( 'foo' ), "foo doesn't exist" ); - close(FILE); + my $db_obj = $db->_get_self; + ok( $db_obj->_root->{inode}, "The inode has been set" ); + + close($fh); + } } # now the same, but with an offset into the file. Use the database that's # embedded in the test for the DATA filehandle. First, find the database ... -open(FILE, "t/28_DATA.t") || die("Can't open t/28_DATA.t\n"); -while(my $line = ) { - last if($line =~ /^__DATA__/); -} -my $offset = tell(FILE); -close(FILE); - -SKIP: { - skip "File header and format changed ... gah!", 5; - open(FILE, "t/28_DATA.t"); - - my $db; - - ok(($db = DBM::Deep->new(fh => *FILE, file_offset => $offset)), "open db in filehandle with offset"); +{ + my ($fh,$filename) = new_fh(); - ok($db->{hash}->{foo}->[1] eq 'b', "and get at stuff in the database"); + print $fh "#!$^X\n"; + print $fh <<'__END_FH__'; +use strict; +use Test::More no_plan => 1; +Test::More->builder->no_ending(1); +Test::More->builder->{Curr_Test} = 12; - ok( !$db->exists( 'foo' ), "foo doesn't exist yet" ); - throws_ok { - $db->{foo} = 1; - } qr/Cannot write to a readonly filehandle/, "Can't write to a read-only filehandle"; - ok( !$db->exists( 'foo' ), "foo doesn't exist" ); +use_ok( 'DBM::Deep' ); - close FILE; +my $db = DBM::Deep->new({ + fh => *DATA, +}); +is($db->{x}, 'b', "and get at stuff in the database"); +__END_FH__ + print $fh "__DATA__\n"; + close $fh; + + my $offset = do { + open my $fh, '<', $filename; + while(my $line = <$fh>) { + last if($line =~ /^__DATA__/); + } + tell($fh); + }; + + { + my $db = DBM::Deep->new({ + file => $filename, + file_offset => $offset, + }); + + $db->{x} = 'b'; + is( $db->{x}, 'b', 'and it was stored' ); + } + + + { + open my $fh, '<', $filename; + my $db = DBM::Deep->new({ + fh => $fh, + file_offset => $offset, + }); + + is($db->{x}, 'b', "and get at stuff in the database"); + + ok( !$db->exists( 'foo' ), "foo doesn't exist yet" ); + throws_ok { + $db->{foo} = 1; + } qr/Cannot write to a readonly filehandle/, "Can't write to a read-only filehandle"; + ok( !$db->exists( 'foo' ), "foo still doesn't exist" ); + + is( $db->{x}, 'b' ); + } + + exec( "$^X -Ilib $filename" ); } diff --git a/t/28_DATA.t b/t/28_DATA.t deleted file mode 100644 index a3cff0f..0000000 Binary files a/t/28_DATA.t and /dev/null differ