Recommenced testing of DATA filehandle

diff --git a/MANIFEST b/MANIFEST
index 3a2c4a0..5bf3774 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 = <FILE>) {
-    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 (file)
index a3cff0f..0000000
Binary files a/t/28_DATA.t and /dev/null differ