Fixed Win32 issues

diff --git a/Build.PL b/Build.PL
index 18173d8..d75cb81 100644 (file)
--- a/Build.PL
+++ b/Build.PL
@@ -6,6 +6,7 @@ my $build = Module::Build->new(
     module_name => 'DBM::Deep',
     license => 'perl',
     requires => {
+        'perl'         => '5.6.0',
         'Digest::MD5'  => '1.00',
         'Scalar::Util' => '1.14',
     },

diff --git a/Changes b/Changes
index b2f7546..e811aa5 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,5 +1,10 @@
 Revision history for DBM::Deep.
 
+0.982 Mar 08 11:00:00 2006 Pacific
+    - Fixed smoketests that were failing on Win32
+    - Added restriction for Perl 5.6.0 or higher.
+      - Digest::MD5 and Sub::Uplevel (dep of Test::Exception) require 5.6+
+
 0.981 Mar 06 11:00:00 2006 Pacific
     - (RT#17947) - Fixed test that was failing on older Perls
 

diff --git a/lib/DBM/Deep.pm b/lib/DBM/Deep.pm
index f78a6ee..7583324 100644 (file)
--- a/lib/DBM/Deep.pm
+++ b/lib/DBM/Deep.pm
@@ -36,7 +36,7 @@ use Digest::MD5 ();
 use Scalar::Util ();
 
 use vars qw( $VERSION );
-$VERSION = q(0.981);
+$VERSION = q(0.982);
 
 ##
 # Set to 4 and 'N' for 32-bit offset tags (default).  Theoretical limit of 4 GB per file.
@@ -102,7 +102,6 @@ sub SIG_SIZE   () {  1  }
 ##
 sub TYPE_HASH   () { SIG_HASH   }
 sub TYPE_ARRAY  () { SIG_ARRAY  }
-sub TYPE_SCALAR () { SIG_SCALAR }
 
 sub _get_args {
     my $proto = shift;
@@ -209,26 +208,13 @@ sub _open {
 
        if (defined($self->_fh)) { $self->_close(); }
        
-    eval {
-        local $SIG{'__DIE__'};
-        # Theoretically, adding O_BINARY should remove the need for the binmode
-        # Of course, testing it is going to be ... interesting.
-        my $flags = O_RDWR | O_CREAT | O_BINARY;
-
-        my $fh;
-        sysopen( $fh, $self->_root->{file}, $flags )
-            or $fh = undef;
-        $self->_root->{fh} = $fh;
-    }; if ($@ ) { $self->_throw_error( "Received error: $@\n" ); }
-       if (! defined($self->_fh)) {
-               return $self->_throw_error("Cannot sysopen file: " . $self->_root->{file} . ": $!");
-       }
+    my $flags = O_RDWR | O_CREAT | O_BINARY;
 
-    my $fh = $self->_fh;
+    my $fh;
+    sysopen( $fh, $self->_root->{file}, $flags )
+               or $self->_throw_error( "Cannot sysopen file: " . $self->_root->{file} . ": $!" );
 
-    #XXX Can we remove this by using the right sysopen() flags?
-    # Maybe ... q.v. above
-    binmode $fh; # for win32
+    $self->_root->{fh} = $fh;
 
     if ($self->_root->{autoflush}) {
         my $old = select $fh;
@@ -1327,7 +1313,7 @@ sub STORE {
                return;
        }
 
-    unless ( _is_writable( $self->_fh ) ) {
+    if ( $^O ne 'MSWin32' && !_is_writable( $self->_fh ) ) {
         $self->_throw_error( 'Cannot write to a readonly filehandle' );
     }
        

diff --git a/t/27_filehandle.t b/t/27_filehandle.t
index ac4736c..8c68751 100644 (file)
--- a/t/27_filehandle.t
+++ b/t/27_filehandle.t
@@ -33,7 +33,11 @@ ok(($db = DBM::Deep->new(fh => *FILE, file_offset => $offset)), "open db in file
 ok($db->{hash}->{foo}->[1] eq 'b', "and get at stuff in the database");
 
 ok( !$db->{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";
+
+SKIP: {
+    skip "F_GETFL tests skipped on Win32", 1 if $^O eq 'MSWin32';
+    throws_ok {
+        $db->{foo} = 1;
+    } qr/Cannot write to a readonly filehandle/, "Can't write to a read-only filehandle";
+}
 ok( !$db->{foo}, "foo doesn't exist yet" );