Upgrade to Tie::File 0.97.

p4raw-id: //depot/perl@19813

5 files changed, 31 insertions, 76 deletions

diff --git a/lib/Tie/File.pm b/lib/Tie/File.pm
index 851e63a61b..253932407b 100644
--- a/lib/Tie/File.pm
+++ b/lib/Tie/File.pm
@@ -7,14 +7,14 @@ use Fcntl 'O_CREAT', 'O_RDWR', 'LOCK_EX', 'LOCK_SH', 'O_WRONLY', 'O_RDONLY';
 sub O_ACCMODE () { O_RDONLY | O_RDWR | O_WRONLY }
 
 
-$VERSION = "0.96";
+$VERSION = "0.97";
 my $DEFAULT_MEMORY_SIZE = 1<<21;    # 2 megabytes
 my $DEFAULT_AUTODEFER_THRESHHOLD = 3; # 3 records
 my $DEFAULT_AUTODEFER_FILELEN_THRESHHOLD = 65536; # 16 disk blocksful
 
 my %good_opt = map {$_ => 1, "-$_" => 1}
                  qw(memory dw_size mode recsep discipline 
-                    autodefer autochomp autodefer_threshhold);
+                    autodefer autochomp autodefer_threshhold concurrent);
 
 sub TIEARRAY {
   if (@_ % 2 != 0) {
@@ -33,6 +33,10 @@ sub TIEARRAY {
     }
   }
 
+  if ($opts{concurrent}) {
+    croak("$pack: concurrent access not supported yet\n");
+  }
+
   unless (defined $opts{memory}) {
     # default is the larger of the default cache size and the 
     # deferred-write buffer size (if specified)
@@ -697,6 +701,8 @@ sub _upcopy {
 # moving everything in the block forwards to make room.
 # Instead of writing the last length($data) bytes from the block
 # (because there isn't room for them any longer) return them.
+#
+# Undefined $len means 'until the end of the file'
 sub _downcopy {
   my $blocksize = 8192;
   my ($self, $data, $pos, $len) = @_;
@@ -707,10 +713,19 @@ sub _downcopy {
       : $len > $blocksize? $blocksize : $len;
     $self->_seekb($pos);
     read $fh, my($old), $readsize;
+    my $last_read_was_short = length($old) < $readsize;
     $data .= $old;
-    $self->_seekb($pos);
-    my $writable = substr($data, 0, $readsize, "");
+    my $writable;
+    if ($last_read_was_short) {
+      # If last read was short, then $data now contains the entire rest
+      # of the file, so there's no need to write only one block of it
+      $writable = $data;
+      $data = "";
+    } else {
+      $writable = substr($data, 0, $readsize, "");
+    }
     last if $writable eq "";
+    $self->_seekb($pos);
     $self->_write_record($writable);
     $len -= $readsize if defined $len;
     $pos += $readsize;
@@ -1993,7 +2008,7 @@ Tie::File - Access the lines of a disk file via a Perl array
 
 =head1 SYNOPSIS
 
-	# This file documents Tie::File version 0.96
+	# This file documents Tie::File version 0.97
 	use Tie::File;
 
 	tie @array, 'Tie::File', filename or die ...;
@@ -2411,14 +2426,14 @@ C<-E<gt>autodefer()> recovers the current value of the autodefer setting.
 =head1 CONCURRENT ACCESS TO FILES
 
 Caching and deferred writing are inappropriate if you want the same
-file to be accessed simultaneously from more than one process.  You
-will want to disable these features.  You should do that by including
-the C<memory =E<gt> 0> option in your C<tie> calls; this will inhibit
-caching and deferred writing.
+file to be accessed simultaneously from more than one process.  Other
+optimizations performed internally by this module are also
+incompatible with concurrent access.  A future version of this module will
+support a C<concurrent =E<gt> 1> option that enables safe concurrent access.
 
-You will also want to lock the file while reading or writing it.  You
-can use the C<-E<gt>flock> method for this.  A future version of this
-module may provide an 'autolocking' mode.
+Previous versions of this documentation suggested using C<memory
+=E<gt> 0> for safe concurrent access.  This was mistaken.  Tie::File
+will not support safe concurrent access before version 0.98.
 
 =head1 CAVEATS
 
@@ -2516,7 +2531,7 @@ any news of importance, will be available at
 
 =head1 LICENSE
 
-C<Tie::File> version 0.96 is copyright (C) 2002 Mark Jason Dominus.
+C<Tie::File> version 0.97 is copyright (C) 2003 Mark Jason Dominus.
 
 This library is free software; you may redistribute it and/or modify
 it under the same terms as Perl itself.
@@ -2544,7 +2559,7 @@ For licensing inquiries, contact the author at:
 
 =head1 WARRANTY
 
-C<Tie::File> version 0.96 comes with ABSOLUTELY NO WARRANTY.
+C<Tie::File> version 0.97 comes with ABSOLUTELY NO WARRANTY.
 For details, see the license.
 
 =head1 THANKS
diff --git a/lib/Tie/File/t/00_version.t b/lib/Tie/File/t/00_version.t
index 68e13ff14c..3dd51c0bf6 100644
--- a/lib/Tie/File/t/00_version.t
+++ b/lib/Tie/File/t/00_version.t
@@ -2,7 +2,7 @@
 
 print "1..1\n";
 
-my $testversion = "0.96";
+my $testversion = "0.97";
 use Tie::File;
 
 if ($Tie::File::VERSION != $testversion) {
diff --git a/lib/Tie/File/t/09_gen_rs.t b/lib/Tie/File/t/09_gen_rs.t
index 43b7140a92..041131fb07 100644
--- a/lib/Tie/File/t/09_gen_rs.t
+++ b/lib/Tie/File/t/09_gen_rs.t
@@ -1,6 +1,5 @@
 #!/usr/bin/perl
 
-use lib '/home/mjd/src/perl/Tie-File2/lib';
 my $file = "tf$$.txt";
 
 print "1..59\n";
diff --git a/lib/Tie/File/t/28_mtwrite.t b/lib/Tie/File/t/28_mtwrite.t
index d21d03a918..50e306d3b6 100644
--- a/lib/Tie/File/t/28_mtwrite.t
+++ b/lib/Tie/File/t/28_mtwrite.t
@@ -282,62 +282,6 @@ sub try_all_triples {
   }
 }
 
-# Each element of @TRIES has [start, oldlen, newlen]
-# Try them pairwise
-sub xxtry_all_doubles {
-  print "# Trying double regions.\n";
-  my %reg;                        # regions
-  for my $i (0 .. $#TRIES) {
-    $a = $TRIES[$i];
-    ($reg{a}{st}, $reg{a}{ol}, $reg{a}{nl}) =  @{$TRIES[$i]};
-    next if $reg{a}{st} + $reg{a}{ol} >= $FLEN;
-    next if $reg{a}{st} + $reg{a}{nl} >= $FLEN;
-    for my $j (0 .. $#TRIES){
-      $b = $TRIES[$j];
-      ($reg{b}{st}, $reg{b}{ol}, $reg{b}{nl}) =  @{$TRIES[$j]};
-      next if $reg{b}{st} + $reg{b}{ol} >= $FLEN;
-      next if $reg{b}{st} + $reg{b}{nl} >= $FLEN;
-
-      next if $reg{b}{st} < $reg{a}{st} + $reg{a}{ol};  # Overlapping regions
-#      $reg{b}{st} -= $reg{a}{ol} - $reg{a}{nl};
-
-      open F, "> $file" or die "Couldn't open file $file: $!";
-      binmode F;
-      print F $oldfile;
-      close F;
-      die "wrong length!" unless -s $file == $FLEN;
-
-      my $expected = $oldfile;
-      for ('b', 'a') {
-        $reg{$_}{nd} = $_ x $reg{$_}{nl};
-        substr($expected, $reg{$_}{st}, $reg{$_}{ol}, $reg{$_}{nd});
-      }
-
-      my $o = tie my @lines, 'Tie::File', $file or die $!;
-      $o->_mtwrite($reg{a}{nd}, $reg{a}{st}, $reg{a}{ol},
-                   $reg{b}{nd}, $reg{b}{st}, $reg{b}{ol},
-                  );
-      undef $o; untie @lines;
-
-      open F, "< $file" or die "Couldn't open file $file: $!";
-      binmode F;
-      my $actual;
-      { local $/;
-        $actual = <F>;
-      }
-      close F;
-
-      my ($alen, $xlen) = (length $actual, length $expected);
-      print "# try_all_doubles(@$a, @$b)\n";
-      unless ($alen == $xlen) {
-        print "# expected file length $xlen, actual $alen!\n";
-      }
-      print $actual eq $expected ? "ok $N\n" : "not ok $N\n";
-      $N++;
-    }
-  }
-}
-
 sub ctrlfix {
   for (@_) {
     s/\n/\\n/g;
diff --git a/lib/Tie/File/t/29_downcopy.t b/lib/Tie/File/t/29_downcopy.t
index 24f9597815..d9c7ecb28e 100644
--- a/lib/Tie/File/t/29_downcopy.t
+++ b/lib/Tie/File/t/29_downcopy.t
@@ -1,6 +1,6 @@
 #!/usr/bin/perl
 #
-# Unit tests of _twrite function
+# Unit tests of _downcopy function
 #
 # _downcopy($self, $data, $pos, $len)
 # Write $data into a block of length $len at position $pos,
@@ -235,8 +235,6 @@ try(35272,  6728,     0);  # old=x><x     , new=0        ; old > new
 try(32768,  9232,     0);  # old=<x><x    , new=0        ; old > new
 try(42000,     0,     0);  # old=0        , new=0        ; old = new
 
-
-
 sub try {
   my ($pos, $len, $newlen) = @_;
   open F, "> $file" or die "Couldn't open file $file: $!";
@@ -363,4 +361,3 @@ END {
   untie @a;
   1 while unlink $file;
 }
-