From: rkinyon Date: Mon, 26 Feb 2007 16:20:04 +0000 (+0000) Subject: Fixed Changes and a failing test found due to disttest X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=7447c77cb02b33dc086d457cce4541acc5d207b8;p=dbsrgits%2FDBM-Deep.git Fixed Changes and a failing test found due to disttest --- diff --git a/Changes b/Changes index fbf5f95..6409e9f 100644 --- 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 --- 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 --- 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{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 --- 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>; }