From: rkinyon <rkinyon@50811bd7-b8ce-0310-adc1-d9db26280581>
Date: Tue, 28 Feb 2006 18:48:04 +0000 (+0000)
Subject: Added test to verify no writing to a readonly file
X-Git-Tag: 0-99_01~121
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=acd4faf2177ef4bf8d5ed6712d2603bb722017a7;p=dbsrgits%2FDBM-Deep.git

Added test to verify no writing to a readonly file
---

diff --git a/lib/DBM/Deep.pm b/lib/DBM/Deep.pm
index bd59707..3129d5c 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
diff --git a/t/27_filehandle.t b/t/27_filehandle.t
index 6fa65c0..ac4736c 100644
--- a/t/27_filehandle.t
+++ b/t/27_filehandle.t
@@ -2,7 +2,8 @@
 # DBM::Deep Test
 ##
 use strict;
-use Test::More tests => 4;
+use Test::More tests => 7;
+use Test::Exception;
 
 use DBM::Deep;
 
@@ -27,7 +28,12 @@ while(my $line = <FILE>) {
 my $offset = tell(FILE);
 close(FILE);
 
-open(FILE, "t/28_DATA.t");
+open(FILE, '<', "t/28_DATA.t");
 ok(($db = DBM::Deep->new(fh => *FILE, file_offset => $offset)), "open db in filehandle with offset");
 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";
+ok( !$db->{foo}, "foo doesn't exist yet" );