All sectors now use a string to create themselves

[dbsrgits/DBM-Deep.git] / lib / DBM / Deep / File.pm

diff --git a/lib/DBM/Deep/File.pm b/lib/DBM/Deep/File.pm
index 042cbaa..0a3096f 100644 (file)
--- a/lib/DBM/Deep/File.pm
+++ b/lib/DBM/Deep/File.pm
@@ -3,12 +3,11 @@ package DBM::Deep::File;
 use 5.006_000;
 
 use strict;
-use warnings;
-
-our $VERSION = q(1.0009);
+use warnings FATAL => 'all';
 
 use Fcntl qw( :DEFAULT :flock :seek );
-use FileHandle::Fmode ();
+
+use constant DEBUG => 0;
 
 sub new {
     my $class = shift;
@@ -111,6 +110,12 @@ sub print_at {
         seek( $fh, $loc + $self->{file_offset}, SEEK_SET );
     }
 
+    if ( DEBUG ) {
+        my $caller = join ':', (caller)[0,2];
+        my $len = length( join '', @_ );
+        warn "($caller) print_at( " . (defined $loc ? $loc : '<undef>') . ", $len )\n";
+    }
+
     print( $fh @_ ) or die "Internal Error (print_at($loc)): $!\n";
 
     return 1;
@@ -127,6 +132,11 @@ sub read_at {
         seek( $fh, $loc + $self->{file_offset}, SEEK_SET );
     }
 
+    if ( DEBUG ) {
+        my $caller = join ':', (caller)[0,2];
+        warn "($caller) read_at( " . (defined $loc ? $loc : '<undef>') . ", $size )\n";
+    }
+
     my $buffer;
     read( $fh, $buffer, $size);
 
@@ -236,9 +246,17 @@ sub flush {
     return 1;
 }
 
+# Taken from http://www.perlmonks.org/?node_id=691054
 sub is_writable {
     my $self = shift;
-    return FileHandle::Fmode::is_W( $self->{fh} );
+
+    my $fh = $self->{fh};
+    return unless defined $fh;
+    return unless defined fileno $fh;
+    local $\ = '';  # just in case
+    no warnings;    # temporarily disable warnings
+    local $^W;      # temporarily disable warnings
+    return print $fh '';
 }
 
 sub copy_stats {