X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBM%2FDeep.pm;h=c6e8c1f3fc9b1636690599cca3fd5f052d27ccb4;hb=753e18da7604016750eab2a61f208f59816d3538;hp=bd59707decab1cdd2a583306179f61d3b2f31291;hpb=429e4192e1328c956eebea61f225a33e7909d101;p=dbsrgits%2FDBM-Deep.git

diff --git a/lib/DBM/Deep.pm b/lib/DBM/Deep.pm
index bd59707..c6e8c1f 100644
--- a/lib/DBM/Deep.pm
+++ b/lib/DBM/Deep.pm
@@ -24,7 +24,7 @@ package DBM::Deep;
 #	print "This module " . $db->{my_complex}->[1]->{perl} . "!\n";
 #
 # Copyright:
-#	(c) 2002-2005 Joseph Huckaby.  All Rights Reserved.
+#	(c) 2002-2006 Joseph Huckaby.  All Rights Reserved.
 #	This program is free software; you can redistribute it and/or 
 #	modify it under the same terms as Perl itself.
 ##
@@ -1291,6 +1291,16 @@ sub set_digest {
 	_precalc_sizes();
 }
 
+sub _is_writable {
+    my $fh = shift;
+    (O_WRONLY | O_RDWR) & fcntl( $fh, F_GETFL, my $slush = 0);
+}
+
+#sub _is_readable {
+#    my $fh = shift;
+#    (O_RDONLY | O_RDWR) & fcntl( $fh, F_GETFL, my $slush = 0);
+#}
+
 ##
 # tie() methods (hashes and arrays)
 ##
@@ -1316,7 +1326,10 @@ sub STORE {
 	if (!defined($self->_fh) && !$self->_open()) {
 		return;
 	}
-	##
+
+    unless ( _is_writable( $self->_fh ) ) {
+        $self->_throw_error( 'Cannot write to a readonly filehandle' );
+    }
 	
 	##
 	# Request exclusive lock for writing
@@ -2513,6 +2526,13 @@ These functions cause every element in the array to move, which can be murder
 on DBM::Deep, as every element has to be fetched from disk, then stored again in
 a different location.  This will be addressed in the forthcoming version 1.00.
 
+=head2 WRITEONLY FILES
+
+If you pass in a filehandle to new(), you may have opened it in either a readonly or
+writeonly mode. STORE will verify that the filehandle is writable. However, there
+doesn't seem to be a good way to determine if a filehandle is readable. And, if the
+filehandle isn't readable, it's not clear what will happen. So, don't do that.
+
 =head1 PERFORMANCE
 
 This section discusses DBM::Deep's speed and memory usage.
@@ -2715,10 +2735,10 @@ B<Devel::Cover> report on this module's test suite.
   ---------------------------- ------ ------ ------ ------ ------ ------ ------
   File                           stmt   bran   cond    sub    pod   time  total
   ---------------------------- ------ ------ ------ ------ ------ ------ ------
-  blib/lib/DBM/Deep.pm           95.0   83.2   68.7   98.2  100.0   57.8   90.7
-  blib/lib/DBM/Deep/Array.pm     98.9   88.9   87.5  100.0    n/a   27.4   96.4
-  blib/lib/DBM/Deep/Hash.pm      95.3   80.0  100.0  100.0    n/a   14.8   92.4
-  Total                          95.8   83.9   72.8   98.8  100.0  100.0   91.8
+  blib/lib/DBM/Deep.pm           95.2   83.8   70.0   98.2  100.0   58.0   91.0
+  blib/lib/DBM/Deep/Array.pm    100.0   91.1  100.0  100.0    n/a   26.7   98.0
+  blib/lib/DBM/Deep/Hash.pm      95.3   80.0  100.0  100.0    n/a   15.3   92.4
+  Total                          96.2   84.8   74.4   98.8  100.0  100.0   92.4
   ---------------------------- ------ ------ ------ ------ ------ ------ ------
 
 =head1 MORE INFORMATION