From: rkinyon <rkinyon@50811bd7-b8ce-0310-adc1-d9db26280581>
Date: Tue, 28 Feb 2006 18:59:51 +0000 (+0000)
Subject: Tagged 0.98
X-Git-Tag: 0-98^0
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=753e18da7604016750eab2a61f208f59816d3538;p=dbsrgits%2FDBM-Deep.git

Tagged 0.98
---

diff --git a/Changes b/Changes
index 815e672..01d9924 100644
--- a/Changes
+++ b/Changes
@@ -1,6 +1,6 @@
 Revision history for DBM::Deep.
 
-0.98  Feb ?? ??:??:?? 2006 Pacific
+0.98  Feb 28 11:00:00 2006 Pacific
     - Added in patch by David Cantrell to allow use of DATA filehandle
     - Fixed bug where attempting to export() a structure that used autobless would die
     - Fixed arraytest slowness by localizing $SIG{__DIE__} to prevent Test::Builder's
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
diff --git a/t/04_array.t b/t/04_array.t
index 04a62bc..7398265 100644
--- a/t/04_array.t
+++ b/t/04_array.t
@@ -2,7 +2,7 @@
 # DBM::Deep Test
 ##
 use strict;
-use Test::More tests => 99;
+use Test::More tests => 107;
 use Test::Exception;
 
 use_ok( 'DBM::Deep' );
@@ -189,6 +189,20 @@ is($db->[0], "elem first");
 is($db->[1], "middle ABC");
 is($db->[2], "elem last");
 
+@returned = $db->splice( 1 );
+is($db->length(), 1);
+is($db->[0], "elem first");
+is($returned[0], "middle ABC");
+is($returned[1], "elem last");
+
+$db->push( @returned );
+
+@returned = $db->splice( 1, -1 );
+is($db->length(), 2);
+is($db->[0], "elem first");
+is($db->[1], "elem last");
+is($returned[0], "middle ABC");
+
 # These tests verify that the hash methods cannot be called on arraytypes.
 # They will be removed once the ARRAY and HASH types are refactored into their own classes.
 
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" );