Fixed Changes and a failing test found due to disttest

diff --git a/Changes b/Changes
index fbf5f95..6409e9f 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,13 +1,19 @@
 Revision history for DBM::Deep.
 
-1.0000 Jan ?? 22:30:00 2007 EDT
+1.0000 Feb 26 22:30:00 2007 EDT
     - THIS VERSION IS INCOMPATIBLE WITH FILES FROM ALL OTHER PRIOR VERSIONS.
       - To aid in this form of upgrades, DBM::Deep now checks the file format
         version to make sure that it knows how to read it.
-      - dpdb_upgrade_db.pl was added to scripts/.
-    - importing no longer takes place within a transaction
+      - db_upgrade.pl was added to utils/. This will -NOT- install onto
+        your system. This is deliberate.
+      - db_upgrade.pl will not handle developer release file formats. This
+        is due to the fact that all developer releases in preparation for a
+        given release share the same file version, even though the file
+        format may change. This is deliberate.
+    - Importing no longer takes place within a transaction
     - The following parameters were added:
       - data_sector_size - this determines the default size of a data sector.
+    - Correctly handle opening readonly files
 
 0.99_04 Jan 24 22:30:00 2007 EDT
     - Added the missing lib/DBM/Deep.pod file to the MANIFEST

diff --git a/lib/DBM/Deep/File.pm b/lib/DBM/Deep/File.pm
index 4d4a39c..02276f0 100644 (file)
--- a/lib/DBM/Deep/File.pm
+++ b/lib/DBM/Deep/File.pm
@@ -50,7 +50,14 @@ sub open {
     # Adding O_BINARY should remove the need for the binmode below. However,
     # I'm not going to remove it because I don't have the Win32 chops to be
     # absolutely certain everything will be ok.
-    my $flags = O_RDWR | O_CREAT | O_BINARY;
+    my $flags = O_CREAT | O_BINARY;
+
+    if ( !-e $self->{file} || -w _ ) {
+      $flags |= O_RDWR;
+    }
+    else {
+      $flags |= O_RDONLY;
+    }
 
     my $fh;
     sysopen( $fh, $self->{file}, $flags )

diff --git a/lib/DBM/Deep/Internals.pod b/lib/DBM/Deep/Internals.pod
index 02664b3..b5b0ff2 100644 (file)
--- a/lib/DBM/Deep/Internals.pod
+++ b/lib/DBM/Deep/Internals.pod
@@ -153,7 +153,7 @@ increasing your memeory usage at all.
 DBM::Deep is I/O-bound, pure and simple. The faster your disk, the faster
 DBM::Deep will be. Currently, when performing C<my $x = $db-E<gt>{foo}>, there
 are a minimum of 4 seeks and 1332 + N bytes read (where N is the length of your
-data). (All values assume a medium filesize.) The actions take are:
+data). (All values assume a medium filesize.) The actions taken are:
 
 =over 4
 

diff --git a/t/44_upgrade_db.t b/t/44_upgrade_db.t
index 44d6b65..b48d1be 100644 (file)
--- a/t/44_upgrade_db.t
+++ b/t/44_upgrade_db.t
@@ -69,8 +69,12 @@ foreach my $input_filename (
         File::Spec->catfile( qw( t etc ), "db-$_" )
     } @input_files
 ) {
+    # chmod it writable because old DBM::Deep versions don't handle readonly
+    # files correctly. This is fixed in DBM::Deep 1.0000
+    chmod 0600, $input_filename;
+
     foreach my $v ( @output_versions ) {
-        #print "$input_filename => $output_filename ($v)\n";
+        my (undef, $output_filename) = new_fh();
         my $output = run_prog(
             $PROG,
             "-input $input_filename",
@@ -127,33 +131,33 @@ foreach my $input_filename (
 
 ################################################################################
 
+#XXX This needs to be made OS-portable
 sub run_prog {
-    #print "Launching '@_'\n";
-    #XXX This needs to be made OS-portable
-    open( my $fh, '-|', "@_ 2>&1" ) or die "Cannot launch '@_': $!\n";
+    open( my $fh, '-|', "@_ 2>&1" )
+      or die "Cannot launch '@_' as a piped filehandle: $!\n";
     return join '', <$fh>;
 }
 
-# In 5.8, we could have used in-memory filehandles and done
+# In 5.8, we could use in-memory filehandles and have done:
 #     open( my $fh, '>', \my $pod ) or die "Cannot open in-memory filehandle: $!\n";
 #     ...
 #     return $pod;
-# However, DBM::Deep supports 5.6, so this set of contortions will do the trick.
+# However, DBM::Deep requires 5.6, so this set of contortions will have to do.
 sub get_pod {
     my ($p,$v) = @_;
 
     my ($fh, $fn) = new_fh();
     close $fh;
-    open $fh, '>', $fn;
 
+    open $fh, '>', $fn;
     pod2usage({
         -input   => $p,
         -output  => $fh,
         -verbose => $v,
         -exitval => 'NOEXIT',
     });
-
     close $fh;
+
     open $fh, '<', $fn;
     return join '', <$fh>;
 }