From: Jarkko Hietaniemi <jhi@iki.fi>
Date: Thu, 8 May 2003 17:46:26 +0000 (+0000)
Subject: Upgrade to Tie::File 0.95.
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=6ae23f4134087bc885284bd6ae11bfeb719e2459;p=p5sagit%2Fp5-mst-13.2.git

Upgrade to Tie::File 0.95.

p4raw-id: //depot/perl@19450
---

diff --git a/lib/Tie/File.pm b/lib/Tie/File.pm
index 637d6cf..43fd1d6 100644
--- a/lib/Tie/File.pm
+++ b/lib/Tie/File.pm
@@ -1,18 +1,20 @@
 
 package Tie::File;
 require 5.005;
-use Carp;
+use Carp ':DEFAULT', 'confess';
 use POSIX 'SEEK_SET';
-use Fcntl 'O_CREAT', 'O_RDWR', 'LOCK_EX', 'O_WRONLY', 'O_RDONLY';
+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.93";
+
+$VERSION = "0.95";
 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);
+my %good_opt = map {$_ => 1, "-$_" => 1}
+                 qw(memory dw_size mode recsep discipline 
+                    autodefer autochomp autodefer_threshhold);
 
 sub TIEARRAY {
   if (@_ % 2 != 0) {
@@ -35,7 +37,7 @@ sub TIEARRAY {
     # default is the larger of the default cache size and the 
     # deferred-write buffer size (if specified)
     $opts{memory} = $DEFAULT_MEMORY_SIZE;
-    $opts{memory} = $opts{dw_size} 
+    $opts{memory} = $opts{dw_size}
       if defined $opts{dw_size} && $opts{dw_size} > $DEFAULT_MEMORY_SIZE;
     # Dora Winifred Read
   }
@@ -49,9 +51,8 @@ sub TIEARRAY {
   $opts{deferred_s} = 0;        # count of total bytes in ->{deferred}
   $opts{deferred_max} = -1;     # empty
 
-  # the cache is a hash instead of an array because it is likely to be
-  # sparsely populated
-  $opts{cache} = Tie::File::Cache->new($opts{memory}); 
+  # What's a good way to arrange that this class can be overridden?
+  $opts{cache} = Tie::File::Cache->new($opts{memory});
 
   # autodeferment is enabled by default
   $opts{autodefer} = 1 unless defined $opts{autodefer};
@@ -114,13 +115,13 @@ sub FETCH {
   my $rec;
 
   # check the defer buffer
-  if ($self->_is_deferring && exists $self->{deferred}{$n}) {
-    $rec = $self->{deferred}{$n};
-  } else {
-    $rec = $self->_fetch($n);
-  }
+  $rec = $self->{deferred}{$n} if exists $self->{deferred}{$n};
+  $rec = $self->_fetch($n) unless defined $rec;
 
-  $self->_chomp1($rec);
+  # inlined _chomp1
+  substr($rec, - $self->{recseplen}) = ""
+    if defined $rec && $self->{autochomp};
+  $rec;
 }
 
 # Chomp many records in-place; return nothing useful
@@ -153,7 +154,7 @@ sub _fetch {
   }
 
   if ($#{$self->{offsets}} < $n) {
-    return if $self->{eof};
+    return if $self->{eof};  # request for record beyond end of file
     my $o = $self->_fill_offsets_to($n);
     # If it's still undefined, there is no such record, so return 'undef'
     return unless defined $o;
@@ -198,26 +199,18 @@ sub STORE {
   # 20020324 Wait, but this DOES alter the cache.  TODO BUG?
   my $oldrec = $self->_fetch($n);
 
-  if (defined($self->{cache}->lookup($n))) {
-    $self->{cache}->update($n, $rec);
-  }
-
   if (not defined $oldrec) {
     # We're storing a record beyond the end of the file
     $self->_extend_file_to($n+1);
     $oldrec = $self->{recsep};
   }
+#  return if $oldrec eq $rec;    # don't bother
   my $len_diff = length($rec) - length($oldrec);
 
   # length($oldrec) here is not consistent with text mode  TODO XXX BUG
-  $self->_twrite($rec, $self->{offsets}[$n], length($oldrec));
-
-  # now update the offsets
-  # array slice goes from element $n+1 (the first one to move)
-  # to the end
-  for (@{$self->{offsets}}[$n+1 .. $#{$self->{offsets}}]) {
-    $_ += $len_diff;
-  }
+  $self->_mtwrite($rec, $self->{offsets}[$n], length($oldrec));
+  $self->_oadjust([$n, 1, $rec]);
+  $self->{cache}->update($n, $rec);
 }
 
 sub _store_deferred {
@@ -259,13 +252,8 @@ sub _delete_deferred {
 
 sub FETCHSIZE {
   my $self = shift;
-  my $n = $#{$self->{offsets}};
-  # 20020317 Change this to binary search
-  unless ($self->{eof}) {
-    while (defined ($self->_fill_offsets_to($n+1))) {
-      ++$n;
-    }
-  }
+  my $n = $self->{eof} ? $#{$self->{offsets}} : $self->_fill_offsets;
+
   my $top_deferred = $self->_defer_max;
   $n = $top_deferred+1 if defined $top_deferred && $n < $top_deferred+1;
   $n;
@@ -310,10 +298,15 @@ sub STORESIZE {
   $self->{cache}->remove(grep $_ >= $len, $self->{cache}->ckeys);
 }
 
+### OPTIMIZE ME
+### It should not be necessary to do FETCHSIZE
+### Just seek to the end of the file.
 sub PUSH {
   my $self = shift;
   $self->SPLICE($self->FETCHSIZE, scalar(@_), @_);
-#  $self->FETCHSIZE;  # av.c takes care of this for me
+
+  # No need to return:
+  #  $self->FETCHSIZE;  # because av.c takes care of this for me
 }
 
 sub POP {
@@ -391,7 +384,6 @@ sub DELETE {
 sub EXISTS {
   my ($self, $n) = @_;
   return 1 if exists $self->{deferred}{$n};
-  $self->_fill_offsets_to($n);  # I think this is unnecessary
   $n < $self->FETCHSIZE;
 }
 
@@ -447,6 +439,12 @@ sub _splice {
       $nrecs = $oldsize - $pos + $nrecs;
       $nrecs = 0 if $nrecs < 0;
     }
+
+    # nrecs is too big---it really means "until the end"
+    # 20030507
+    if ($nrecs + $pos > $oldsize) {
+      $nrecs = $oldsize - $pos;
+    }
   }
 
   $self->_fixrecs(@data);
@@ -470,76 +468,52 @@ sub _splice {
     $oldlen += $self->{offsets}[$_+1] - $self->{offsets}[$_]
       if defined $self->{offsets}[$_+1];
   }
+  $self->_fill_offsets_to($pos+$nrecs);
 
   # Modify the file
-  $self->_twrite($data, $self->{offsets}[$pos], $oldlen);
-
-  # update the offsets table part 1
-  # compute the offsets of the new records:
-  my @new_offsets;
-  if (@data) {
-    push @new_offsets, $self->{offsets}[$pos];
-    for (0 .. $#data-1) {
-      push @new_offsets, $new_offsets[-1] + length($data[$_]);
+  $self->_mtwrite($data, $self->{offsets}[$pos], $oldlen);
+  # Adjust the offsets table
+  $self->_oadjust([$pos, $nrecs, @data]);
+
+  { # Take this read cache stuff out into a separate function
+    # You made a half-attempt to put it into _oadjust.  
+    # Finish something like that up eventually.
+    # STORE also needs to do something similarish
+
+    # update the read cache, part 1
+    # modified records
+    for ($pos .. $pos+$nrecs-1) {
+      my $new = $data[$_-$pos];
+      if (defined $new) {
+        $self->{cache}->update($_, $new);
+      } else {
+        $self->{cache}->remove($_);
+      }
     }
-  }
-
-  # If we're about to splice out the end of the offsets table...
-  if ($pos + $nrecs >= @{$self->{offsets}}) {
-    $self->{eof} = 0;           # ... the table is no longer complete
-  }
-  splice(@{$self->{offsets}}, $pos, $nrecs, @new_offsets);
-
-  # update the offsets table part 2
-  # adjust the offsets of the following old records
-  for ($pos+@data .. $#{$self->{offsets}}) {
-    $self->{offsets}[$_] += $datalen - $oldlen;
-  }
-  # If we scrubbed out all known offsets, regenerate the trivial table
-  # that knows that the file does indeed start at 0.
-  $self->{offsets}[0] = 0 unless @{$self->{offsets}};
-  # If the file got longer, the offsets table is no longer complete
-  $self->{eof} = 0 if @data > $nrecs;
-  
-
-  # Perhaps the following cache foolery could be factored out
-  # into a bunch of mor opaque cache functions.  For example,
-  # it's odd to delete a record from the cache and then remove
-  # it from the LRU queue later on; there should be a function to
-  # do both at once.
-
-  # update the read cache, part 1
-  # modified records
-  for ($pos .. $pos+$nrecs-1) {
-    my $new = $data[$_-$pos];
-    if (defined $new) {
-      $self->{cache}->update($_, $new);
-    } else {
-      $self->{cache}->remove($_);
+    
+    # update the read cache, part 2
+    # moved records - records past the site of the change
+    # need to be renumbered
+    # Maybe merge this with the previous block?
+    {
+      my @oldkeys = grep $_ >= $pos + $nrecs, $self->{cache}->ckeys;
+      my @newkeys = map $_-$nrecs+@data, @oldkeys;
+      $self->{cache}->rekey(\@oldkeys, \@newkeys);
     }
-  }
 
-  # update the read cache, part 2
-  # moved records - records past the site of the change
-  # need to be renumbered
-  # Maybe merge this with the previous block?
-  {
-    my @oldkeys = grep $_ >= $pos + $nrecs, $self->{cache}->ckeys;
-    my @newkeys = map $_-$nrecs+@data, @oldkeys;
-    $self->{cache}->rekey(\@oldkeys, \@newkeys);
+    # Now there might be too much data in the cache, if we spliced out
+    # some short records and spliced in some long ones.  If so, flush
+    # the cache.
+    $self->_cache_flush;
   }
 
-  # Now there might be too much data in the cache, if we spliced out
-  # some short records and spliced in some long ones.  If so, flush
-  # the cache.
-  $self->_cache_flush;
-
   # Yes, the return value of 'splice' *is* actually this complicated
   wantarray ? @result : @result ? $result[-1] : undef;
 }
 
+
 # write data into the file
-# $data is the data to be written. 
+# $data is the data to be written.
 # it should be written at position $pos, and should overwrite
 # exactly $len of the following bytes.  
 # Note that if length($data) > $len, the subsequent bytes will have to 
@@ -582,7 +556,7 @@ sub _twrite {
     $readpos += $br;
     $writepos += length $data;
     $data = $next_block;
-  } while $more_data;           # BUG XXX TODO how could this have worked?
+  } while $more_data;
   $self->_seekb($writepos);
   $self->_write_record($next_block);
 
@@ -590,6 +564,229 @@ sub _twrite {
   $self->_chop_file if $len_diff < 0;
 }
 
+# _iwrite(D, S, E)
+# Insert text D at position S.
+# Let C = E-S-|D|.  If C < 0; die.  
+# Data in [S,S+C) is copied to [S+D,S+D+C) = [S+D,E).
+# Data in [S+C = E-D, E) is returned.  Data in [E, oo) is untouched.
+#
+# In a later version, don't read the entire intervening area into
+# memory at once; do the copying block by block.
+sub _iwrite {
+  my $self = shift;
+  my ($D, $s, $e) = @_;
+  my $d = length $D;
+  my $c = $e-$s-$d;
+  local *FH = $self->{fh};
+  confess "Not enough space to insert $d bytes between $s and $e"
+    if $c < 0;
+  confess "[$s,$e) is an invalid insertion range" if $e < $s;
+
+  $self->_seekb($s);
+  read FH, my $buf, $e-$s;
+
+  $D .= substr($buf, 0, $c, "");
+
+  $self->_seekb($s);
+  $self->_write_record($D);
+
+  return $buf;
+}
+
+# Like _twrite, but the data-pos-len triple may be repeated; you may
+# write several chunks.  All the writing will be done in
+# one pass.   Chunks SHALL be in ascending order and SHALL NOT overlap.
+sub _mtwrite {
+  my $self = shift;
+  my $unwritten = "";
+  my $delta = 0;
+
+  @_ % 3 == 0 
+    or die "Arguments to _mtwrite did not come in groups of three";
+
+  while (@_) {
+    my ($data, $pos, $len) = splice @_, 0, 3;
+    my $end = $pos + $len;  # The OLD end of the segment to be replaced
+    $data = $unwritten . $data;
+    $delta -= length($unwritten);
+    $unwritten  = "";
+    $pos += $delta;             # This is where the data goes now
+    my $dlen = length $data;
+    $self->_seekb($pos);
+    if ($len >= $dlen) {        # the data will fit
+      $self->_write_record($data);
+      $delta += ($dlen - $len); # everything following moves down by this much
+      $data = ""; # All the data in the buffer has been written
+    } else {                    # won't fit
+      my $writable = substr($data, 0, $len - $delta, "");
+      $self->_write_record($writable);
+      $delta += ($dlen - $len); # everything following moves down by this much
+    } 
+
+    # At this point we've written some but maybe not all of the data.
+    # There might be a gap to close up, or $data might still contain a
+    # bunch of unwritten data that didn't fit.
+    my $ndlen = length $data;
+    if ($delta == 0) {
+      $self->_write_record($data);
+    } elsif ($delta < 0) {
+      # upcopy (close up gap)
+      if (@_) {
+        $self->_upcopy($end, $end + $delta, $_[1] - $end);  
+      } else {
+        $self->_upcopy($end, $end + $delta);  
+      }
+    } else {
+      # downcopy (insert data that didn't fit; replace this data in memory
+      # with _later_ data that doesn't fit)
+      if (@_) {
+        $unwritten = $self->_downcopy($data, $end, $_[1] - $end);
+      } else {
+        # Make the file longer to accomodate the last segment that doesn'
+        $unwritten = $self->_downcopy($data, $end);
+      }
+    }
+  }
+}
+
+# Copy block of data of length $len from position $spos to position $dpos
+# $dpos must be <= $spos
+#
+# If $len is undefined, go all the way to the end of the file
+# and then truncate it ($spos - $dpos bytes will be removed)
+sub _upcopy {
+  my $blocksize = 8192;
+  my ($self, $spos, $dpos, $len) = @_;
+  if ($dpos > $spos) {
+    die "source ($spos) was upstream of destination ($dpos) in _upcopy";
+  } elsif ($dpos == $spos) {
+    return;
+  }
+  
+  while (! defined ($len) || $len > 0) {
+    my $readsize = ! defined($len) ? $blocksize
+               : $len > $blocksize ? $blocksize
+               : $len;
+      
+    my $fh = $self->{fh};
+    $self->_seekb($spos);
+    my $bytes_read = read $fh, my $data, $readsize;
+    $self->_seekb($dpos);
+    if ($data eq "") { 
+      $self->_chop_file;
+      last;
+    }
+    $self->_write_record($data);
+    $spos += $bytes_read;
+    $dpos += $bytes_read;
+    $len -= $bytes_read if defined $len;
+  }
+}
+
+# Write $data into a block of length $len at position $pos,
+# 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.
+sub _downcopy {
+  my $blocksize = 8192;
+  my ($self, $data, $pos, $len) = @_;
+  my $fh = $self->{fh};
+
+  while (! defined $len || $len > 0) {
+    my $readsize = ! defined($len) ? $blocksize 
+      : $len > $blocksize? $blocksize : $len;
+    $self->_seekb($pos);
+    read $fh, my $old, $readsize;
+    $data .= $old;
+    $self->_seekb($pos);
+    my $writable = substr($data, 0, $readsize, "");
+    last if $writable eq "";
+    $self->_write_record($writable);
+    $len -= $readsize if defined $len;
+    $pos += $readsize;
+  }
+  return $data;
+}
+
+# Adjust the object data structures following an '_mtwrite'
+# Arguments are
+#  [$pos, $nrecs, @length]  items
+# indicating that $nrecs records were removed at $recpos (a record offset)
+# and replaced with records of length @length...
+# Arguments guarantee that $recpos is strictly increasing.
+# No return value
+sub _oadjust {
+  my $self = shift;
+  my $delta = 0;
+  my $delta_recs = 0;
+  my $prev_end = -1;
+  my %newkeys;
+
+  for (@_) {
+    my ($pos, $nrecs, @data) = @$_;
+    $pos += $delta_recs;
+
+    # Adjust the offsets of the records after the previous batch up
+    # to the first new one of this batch
+    for my $i ($prev_end+2 .. $pos - 1) {
+      $self->{offsets}[$i] += $delta;
+      $newkey{$i} = $i + $delta_recs;
+    }
+
+    $prev_end = $pos + @data - 1; # last record moved on this pass 
+
+    # Remove the offsets for the removed records;
+    # replace with the offsets for the inserted records
+    my @newoff = ($self->{offsets}[$pos] + $delta);
+    for my $i (0 .. $#data) {
+      my $newlen = length $data[$i];
+      push @newoff, $newoff[$i] + $newlen;
+      $delta += $newlen;
+    }
+
+    for my $i ($pos .. $pos+$nrecs-1) {
+      last if $i+1 > $#{$self->{offsets}};
+      my $oldlen = $self->{offsets}[$i+1] - $self->{offsets}[$i];
+      $delta -= $oldlen;
+    }
+
+#    # also this data has changed, so update it in the cache
+#    for (0 .. $#data) {
+#      $self->{cache}->update($pos + $_, $data[$_]);
+#    }
+#    if ($delta_recs) {
+#      my @oldkeys = grep $_ >= $pos + @data, $self->{cache}->ckeys;
+#      my @newkeys = map $_ + $delta_recs, @oldkeys;
+#      $self->{cache}->rekey(\@oldkeys, \@newkeys);
+#    }
+
+    # replace old offsets with new
+    splice @{$self->{offsets}}, $pos, $nrecs+1, @newoff;
+    # What if we just spliced out the end of the offsets table?
+    # shouldn't we clear $self->{eof}?   Test for this XXX BUG TODO
+
+    $delta_recs += @data - $nrecs; # net change in total number of records
+  }
+
+  # The trailing records at the very end of the file
+  if ($delta) {
+    for my $i ($prev_end+2 .. $#{$self->{offsets}}) {
+      $self->{offsets}[$i] += $delta;
+    }
+  }
+
+  # If we scrubbed out all known offsets, regenerate the trivial table
+  # that knows that the file does indeed start at 0.
+  $self->{offsets}[0] = 0 unless @{$self->{offsets}};
+  # If the file got longer, the offsets table is no longer complete
+  # $self->{eof} = 0 if $delta_recs > 0;
+
+  # Now there might be too much data in the cache, if we spliced out
+  # some short records and spliced in some long ones.  If so, flush
+  # the cache.
+  $self->_cache_flush;
+}
+
 # If a record does not already end with the appropriate terminator
 # string, append one.
 sub _fixrecs {
@@ -620,9 +817,10 @@ sub _seek {
   defined($o)
     or confess("logic error: undefined offset for record $n");
   seek $self->{fh}, $o, SEEK_SET
-    or die "Couldn't seek filehandle: $!";  # "Should never happen."
+    or confess "Couldn't seek filehandle: $!";  # "Should never happen."
 }
 
+# seek to byte $b in the file
 sub _seekb {
   my ($self, $b) = @_;
   seek $self->{fh}, $b, SEEK_SET
@@ -641,11 +839,10 @@ sub _fill_offsets_to {
   my $rec;
 
   until ($#OFF >= $n) {
-    my $o = $OFF[-1];
     $self->_seek(-1);           # tricky -- see comment at _seek
     $rec = $self->_read_record;
     if (defined $rec) {
-      push @OFF, tell $fh;
+      push @OFF, int(tell $fh);  # Tels says that int() saves memory here
     } else {
       $self->{eof} = 1;
       return;                   # It turns out there is no such record
@@ -654,7 +851,26 @@ sub _fill_offsets_to {
 
   # we have now read all the records up to record n-1,
   # so we can return the offset of record n
-  return $OFF[$n];
+  $OFF[$n];
+}
+
+sub _fill_offsets {
+  my ($self) = @_;
+
+  my $fh = $self->{fh};
+  local *OFF = $self->{offsets};
+  
+  $self->_seek(-1);           # tricky -- see comment at _seek
+
+  # Tels says that inlining read_record() would make this loop
+  # five times faster. 20030508
+  while ( defined $self->_read_record()) {
+    # int() saves us memory here
+    push @OFF, int(tell $fh);
+  }
+
+  $self->{eof} = 1;
+  $#OFF;
 }
 
 # assumes that $rec is already suitably terminated
@@ -735,7 +951,7 @@ sub _extend_file_to {
   # Todo : just use $self->{recsep} x $extras here?
   while ($extras-- > 0) {
     $self->_write_record($self->{recsep});
-    push @{$self->{offsets}}, tell $self->{fh};
+    push @{$self->{offsets}}, int(tell $self->{fh});
   }
 }
 
@@ -752,7 +968,7 @@ sub _chop_file {
 # The result should be at least $n.
 sub _bufsize {
   my $n = shift;
-  return 8192 if $n < 0;
+  return 8192 if $n <= 0;
   my $b = $n & ~8191;
   $b += 8192 if $n & 8191;
   $b;
@@ -772,7 +988,18 @@ sub flock {
   }
   my $fh = $self->{fh};
   $op = LOCK_EX unless defined $op;
-  flock $fh, $op;
+  my $locked = flock $fh, $op;
+  
+  if ($locked && ($op & (LOCK_EX | LOCK_SH))) {
+    # If you're locking the file, then presumably it's because
+    # there might have been a write access by another process.
+    # In that case, the read cache contents and the offsets table
+    # might be invalid, so discard them.  20030508
+    $self->{offsets} = [0];
+    $self->{cache}->empty;
+  }
+
+  $locked;
 }
 
 # Get/set autochomp option
@@ -787,6 +1014,25 @@ sub autochomp {
   }
 }
 
+# Get offset table entries; returns offset of nth record
+sub offset {
+  my ($self, $n) = @_;
+
+  if ($#{$self->{offsets}} < $n) {
+    return if $self->{eof};     # request for record beyond the end of file
+    my $o = $self->_fill_offsets_to($n);
+    # If it's still undefined, there is no such record, so return 'undef'
+    return unless defined $o;
+   }
+ 
+  $self->{offsets}[$n];
+}
+
+sub discard_offsets {
+  my $self = shift;
+  $self->{offsets} = [0];
+}
+
 ################################################################
 #
 # Matters related to deferred writing
@@ -804,7 +1050,7 @@ sub defer {
 #
 # This could be better optimized to write the file in one pass, instead
 # of one pass per block of records.  But that will require modifications
-# to _twrite, so I should have a good _twite test suite first.
+# to _twrite, so I should have a good _twrite test suite first.
 sub flush {
   my $self = shift;
 
@@ -812,10 +1058,10 @@ sub flush {
   $self->{defer} = 0;
 }
 
-sub _flush {
+sub _old_flush {
   my $self = shift;
   my @writable = sort {$a<=>$b} (keys %{$self->{deferred}});
-  
+
   while (@writable) {
     # gather all consecutive records from the front of @writable
     my $first_rec = shift @writable;
@@ -831,6 +1077,40 @@ sub _flush {
   $self->_discard;               # clear out defered-write-cache
 }
 
+sub _flush {
+  my $self = shift;
+  my @writable = sort {$a<=>$b} (keys %{$self->{deferred}});
+  my @args;
+  my @adjust;
+
+  while (@writable) {
+    # gather all consecutive records from the front of @writable
+    my $first_rec = shift @writable;
+    my $last_rec = $first_rec+1;
+    ++$last_rec, shift @writable while @writable && $last_rec == $writable[0];
+    --$last_rec;
+    my $end = $self->_fill_offsets_to($last_rec+1);
+    if (not defined $end) {
+      $self->_extend_file_to($last_rec);
+      $end = $self->{offsets}[$last_rec];
+    }
+    my ($start) = $self->{offsets}[$first_rec];
+    push @args,
+         join("", @{$self->{deferred}}{$first_rec .. $last_rec}), # data
+         $start,                                                  # position
+         $end-$start;                                             # length
+    push @adjust, [$first_rec, # starting at this position...
+                   $last_rec-$first_rec+1,  # this many records...
+                   # are replaced with these...
+                   @{$self->{deferred}}{$first_rec .. $last_rec},
+                  ];
+  }
+
+  $self->_mtwrite(@args);  # write multiple record groups
+  $self->_discard;               # clear out defered-write-cache
+  $self->_oadjust(@adjust);
+}
+
 # Discard deferred writes and disable future deferred writes
 sub discard {
   my $self = shift;
@@ -940,7 +1220,7 @@ sub _annotate_ad_history {
   }
 }
 
-# If autodferring was enabled, cut it out and discard the history
+# If autodeferring was enabled, cut it out and discard the history
 sub _stop_autodeferring {
   my $self = shift;
   if ($self->{autodeferring}) {
@@ -1150,6 +1430,9 @@ sub HEAP () { 0 }
 sub HASH () { 1 }
 sub MAX  () { 2 }
 sub BYTES() { 3 }
+#sub STAT () { 4 } # Array with request statistics for each record
+#sub MISS () { 5 } # Total number of cache misses
+#sub REQ  () { 6 } # Total number of cache requests 
 use strict 'vars';
 
 sub new {
@@ -1183,7 +1466,7 @@ sub _heap_move {
   if (defined $n) {
     $self->[HASH]{$k} = $n;
   } else {
-    delete $self->[HASH]{$k}; 
+    delete $self->[HASH]{$k};
   }
 }
 
@@ -1196,6 +1479,12 @@ sub insert {
   }
   confess "undefined val" unless defined $val;
   return if length($val) > $self->[MAX];
+
+#  if ($self->[STAT]) {
+#    $self->[STAT][$key] = 1;
+#    return;
+#  }
+
   my $oldnode = $self->[HASH]{$key};
   if (defined $oldnode) {
     my $oldval = $self->[HEAP]->set_val($oldnode, $val);
@@ -1204,7 +1493,7 @@ sub insert {
     $self->[HEAP]->insert($key, $val);
   }
   $self->[BYTES] += length($val);
-  $self->flush;
+  $self->flush if $self->[BYTES] > $self->[MAX];
 }
 
 sub expire {
@@ -1218,6 +1507,14 @@ sub expire {
 sub remove {
   my ($self, @keys) = @_;
   my @result;
+
+#  if ($self->[STAT]) {
+#    for my $key (@keys) {
+#      $self->[STAT][$key] = 0;
+#    }
+#    return;
+#  }
+
   for my $key (@keys) {
     next unless exists $self->[HASH]{$key};
     my $old_data = $self->[HEAP]->remove($self->[HASH]{$key});
@@ -1231,6 +1528,15 @@ sub lookup {
   my ($self, $key) = @_;
   local *_;
   croak "missing argument to ->lookup" unless defined $key;
+
+#  if ($self->[STAT]) {
+#    $self->[MISS]++  if $self->[STAT][$key]++ == 0;
+#    $self->[REQ]++;
+#    my $hit_rate = 1 - $self->[MISS] / $self->[REQ];
+#    # Do some testing to determine this threshhold
+#    $#$self = STAT - 1 if $hit_rate > 0.20; 
+#  }
+
   if (exists $self->[HASH]{$key}) {
     $self->[HEAP]->lookup($self->[HASH]{$key});
   } else {
@@ -1257,6 +1563,9 @@ sub empty {
   %{$self->[HASH]} = ();
     $self->[BYTES] = 0;
     $self->[HEAP]->empty;
+#  @{$self->[STAT]} = ();
+#    $self->[MISS] = 0;
+#    $self->[REQ] = 0;
 }
 
 sub is_empty {
@@ -1269,7 +1578,7 @@ sub update {
   local *_;
   croak "missing argument to ->update" unless defined $key;
   if (length($val) > $self->[MAX]) {
-    my $oldval = $self->remove($key);
+    my ($oldval) = $self->remove($key);
     $self->[BYTES] -= length($oldval) if defined $oldval;
   } elsif (exists $self->[HASH]{$key}) {
     my $oldval = $self->[HEAP]->set_val($self->[HASH]{$key}, $val);
@@ -1307,23 +1616,29 @@ sub ckeys {
   @a;
 }
 
+# Return total amount of cached data
 sub bytes {
   my $self = shift;
   $self->[BYTES];
 }
 
+# Expire oldest item from cache until cache size is smaller than $max
 sub reduce_size_to {
   my ($self, $max) = @_;
-  until ($self->is_empty || $self->[BYTES] <= $max) {
-    $self->expire;
+  until ($self->[BYTES] <= $max) {
+    # Note that Tie::File::Cache::expire has been inlined here
+    my $old_data = $self->[HEAP]->popheap;
+    return unless defined $old_data;
+    $self->[BYTES] -= length $old_data;
   }
 }
 
+# Why not just $self->reduce_size_to($self->[MAX])?
+# Try this when things stabilize   TODO XXX
+# If the cache is too full, expire the oldest records
 sub flush {
   my $self = shift;
-  until ($self->is_empty || $self->[BYTES] <= $self->[MAX]) {
-    $self->expire;
-  }
+  $self->reduce_size_to($self->[MAX]) if $self->[BYTES] > $self->[MAX];
 }
 
 # For internal use only
@@ -1502,7 +1817,7 @@ sub _insert {
 # Remove the item at node $i from the heap, moving child items upwards.
 # The item with the smallest sequence number is always at the top.
 # Moving items upwards maintains this condition.
-# Return the removed item.
+# Return the removed item.  Return undef if there was no item at node $i.
 sub remove {
   my ($self, $i) = @_;
   $i = 1 unless defined $i;
@@ -1661,13 +1976,16 @@ sub _nodes {
 
 "Cogito, ergo sum.";  # don't forget to return a true value from the file
 
+__END__
+
 =head1 NAME
 
 Tie::File - Access the lines of a disk file via a Perl array
 
 =head1 SYNOPSIS
 
-	# This file documents Tie::File version 0.93
+	# This file documents Tie::File version 0.95
+	use Tie::File;
 
 	tie @array, 'Tie::File', filename or die ...;
 
@@ -1688,7 +2006,7 @@ Tie::File - Access the lines of a disk file via a Perl array
 	push @array, new recs...;
 	my $r1 = pop @array;
 	unshift @array, new recs...;
-	my $r1 = shift @array;
+	my $r2 = shift @array;
 	@old_recs = splice @array, 3, 7, new recs...;
 
 	untie @array;            # all finished
@@ -1712,7 +2030,7 @@ Lazy people and beginners may now stop reading the manual.
 
 What is a 'record'?  By default, the meaning is the same as for the
 C<E<lt>...E<gt>> operator: It's a string terminated by C<$/>, which is
-probably C<"\n">.  (Minor exception: on dos and Win32 systems, a
+probably C<"\n">.  (Minor exception: on DOS and Win32 systems, a
 'record' is a string terminated by C<"\r\n">.)  You may change the
 definition of "record" by supplying the C<recsep> option in the C<tie>
 call:
@@ -1836,7 +2154,13 @@ fetched from disk every time you examine them.
 The C<memory> value is not an absolute or exact limit on the memory
 used.  C<Tie::File> objects contains some structures besides the read
 cache and the deferred write buffer, whose sizes are not charged
-against C<memory>.
+against C<memory>. 
+
+The cache itself consumes about 310 bytes per cached record, so if
+your file has many short records, you may want to decrease the cache
+memory limit, or else the cache overhead may exceed the size of the
+cached data.
+
 
 =head2 C<dw_size>
 
@@ -1888,6 +2212,15 @@ the C<use Fcntl ':flock'> declaration.)
 
 C<MODE> is optional; the default is C<LOCK_EX>.
 
+C<Tie::File> maintains an internal table of the byte offset of each
+record it has seen in the file.  
+
+When you use C<flock> to lock the file, C<Tie::File> assumes that the
+read cache is no longer trustworthy, because another process might
+have modified the file since the last time it was read.  Therefore, a
+successful call to C<flock> discards the contents of the read cache
+and the internal record offset table.
+
 C<Tie::File> promises that the following sequence of operations will
 be safe:
 
@@ -1929,6 +2262,14 @@ See L<"autochomp">, above.
 
 See L<"Deferred Writing">, below.
 
+=head2 C<offset>
+
+	$off = $o->offset($n);
+
+This method returns the byte offset of the start of the C<$n>th record
+in the file.  If there is no such record, it returns an undefined
+value.
+
 =head1 Tying to an already-opened filehandle
 
 If C<$fh> is a filehandle, such as is returned by C<IO::File> or one
@@ -2052,21 +2393,24 @@ or
 Similarly, C<-E<gt>autodefer(1)> re-enables autodeferment, and 
 C<-E<gt>autodefer()> recovers the current value of the autodefer setting.
 
-=head1 CAVEATS
 
-(That's Latin for 'warnings'.)
+=head1 CONCURRENT ACCESS TO FILES
 
-=over 4
+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.
 
-=item *
+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.
+
+=head1 CAVEATS
 
-This is BETA RELEASE SOFTWARE.  It may have bugs.  See the discussion
-below about the (lack of any) warranty.
+(That's Latin for 'warnings'.)
 
-In particular, this means that the interface may change in
-incompatible ways from one version to the next, without warning.  That
-has happened at least once already.  The interface will freeze before
-Perl 5.8 is released, probably sometime in April 2002.
+=over 4
 
 =item *
 
@@ -2100,27 +2444,12 @@ and C<delete>, but in general, the correspondence is extremely close.
 
 =item *
 
-Not quite every effort was made to make this module as efficient as
-possible.  C<FETCHSIZE> should use binary search instead of linear
-search.
-
-The performance of the C<flush> method could be improved.  At present,
-it still rewrites the tail of the file once for each block of
-contiguous lines to be changed.  In the typical case, this will result
-in only one rewrite, but in peculiar cases it might be bad.  It should
-be possible to perform I<all> deferred writing with a single rewrite.
-
-Profiling suggests that these defects are probably minor; in any
-event, they will be fixed in a future version of the module.
-
-=item *
-
 I have supposed that since this module is concerned with file I/O,
 almost all normal use of it will be heavily I/O bound.  This means
 that the time to maintain complicated data structures inside the
 module will be dominated by the time to actually perform the I/O.
 When there was an opportunity to spend CPU time to avoid doing I/O, I
-tried to take it.
+usually tried to take it.
 
 =item *
 
@@ -2128,6 +2457,17 @@ You might be tempted to think that deferred writing is like
 transactions, with C<flush> as C<commit> and C<discard> as
 C<rollback>, but it isn't, so don't.
 
+=item *
+
+There is a large memory overhead for each record offset and for each
+cache entry: about 310 bytes per cached data record, and about 21 bytes per offset table entry.
+
+The per-record overhead will limit the maximum number of records you
+can access per file. Note that I<accessing> the length of the array
+via C<$x = scalar @tied_file> accesses B<all> records and stores their
+offsets.  The same for C<foreach (@tied_file)>, even if you exit the
+loop early.
+
 =back
 
 =head1 SUBCLASSING
@@ -2162,7 +2502,7 @@ any news of importance, will be available at
 
 =head1 LICENSE
 
-C<Tie::File> version 0.93 is copyright (C) 2002 Mark Jason Dominus.
+C<Tie::File> version 0.95 is copyright (C) 2002 Mark Jason Dominus.
 
 This library is free software; you may redistribute it and/or modify
 it under the same terms as Perl itself.
@@ -2190,7 +2530,7 @@ For licensing inquiries, contact the author at:
 
 =head1 WARRANTY
 
-C<Tie::File> version 0.93 comes with ABSOLUTELY NO WARRANTY.
+C<Tie::File> version 0.95 comes with ABSOLUTELY NO WARRANTY.
 For details, see the license.
 
 =head1 THANKS
@@ -2206,28 +2546,29 @@ Autrijus Tang (for heroic eleventh-hour Win32 testing above and beyond
 the call of duty), Michael G Schwern (for testing advice), and the
 rest of the CPAN testers (for testing generally).
 
+Special thanks to Tels for suggesting several speed and memory
+optimizations.
+
 Additional thanks to:
 Edward Avis /
+Mattia Barbon /
 Gerrit Haase /
+Jarkko Hietaniemi (again) /
 Nikola Knezevic /
+John Kominetz /
 Nick Ing-Simmons /
 Tassilo von Parseval /
 H. Dieter Pearcey /
 Slaven Rezic /
+Eric Roode /
 Peter Scott /
 Peter Somu /
 Autrijus Tang (again) /
-Tels /
-Juerd Wallboer
+Tels (again) /
+Juerd Waalboer
 
 =head1 TODO
 
-More tests.  (The cache and heap modules need more unit tests.) 
-
-Improve SPLICE algorithm to use deferred writing machinery.
-
-Cleverer strategy for flushing deferred writes.
-
 More tests.  (Stuff I didn't think of yet.)
 
 Paragraph mode?
@@ -2236,9 +2577,23 @@ Fixed-length mode.  Leave-blanks mode.
 
 Maybe an autolocking mode?
 
+For many common uses of the module, the read cache is a liability.
+For example, a program that inserts a single record, or that scans the
+file once, will have a cache hit rate of zero.  This suggests a major
+optimization: The cache should be initially disabled.  Here's a hybrid
+approach: Initially, the cache is disabled, but the cache code
+maintains statistics about how high the hit rate would be *if* it were
+enabled.  When it sees the hit rate get high enough, it enables
+itself.  The STAT comments in this code are the beginning of an
+implementation of this.
+
 Record locking with fcntl()?  Then the module might support an undo
 log and get real transactions.  What a tour de force that would be.
 
+Keeping track of the highest cached record. This would allow reads-in-a-row
+to skip the cache lookup faster (if reading from 1..N with empty cache at
+start, the last cached value will be always N-1).
+
 More tests.
 
 =cut
diff --git a/lib/Tie/File/t/00_version.t b/lib/Tie/File/t/00_version.t
index 71c1c82..9285257 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.93";
+my $testversion = "0.95";
 use Tie::File;
 
 if ($Tie::File::VERSION != $testversion) {
@@ -19,3 +19,4 @@ None of the other test results will be reliable.
 }
 
 print "ok 1\n";
+
diff --git a/lib/Tie/File/t/01_gen.t b/lib/Tie/File/t/01_gen.t
index 0fc0176..202b09c 100644
--- a/lib/Tie/File/t/01_gen.t
+++ b/lib/Tie/File/t/01_gen.t
@@ -1,6 +1,8 @@
 #!/usr/bin/perl
 
+$| = 1;
 my $file = "tf$$.txt";
+1 while unlink $file;
 
 print "1..75\n";
 
diff --git a/lib/Tie/File/t/04_splice.t b/lib/Tie/File/t/04_splice.t
index cb08dac..b3880b7 100644
--- a/lib/Tie/File/t/04_splice.t
+++ b/lib/Tie/File/t/04_splice.t
@@ -12,6 +12,7 @@
 # contents.
 
 
+$| = 1;
 my $file = "tf$$.txt";
 $: = Tie::File::_default_recsep();
 my $data = "rec0$:rec1$:rec2$:";
diff --git a/lib/Tie/File/t/09_gen_rs.t b/lib/Tie/File/t/09_gen_rs.t
index c202556..7d70e3e 100644
--- a/lib/Tie/File/t/09_gen_rs.t
+++ b/lib/Tie/File/t/09_gen_rs.t
@@ -104,7 +104,6 @@ if (setup_badly_terminated_file(3)) {
   $N++;
   push @a, "next";
   check_contents($badrec, "next");
-  undef $o; untie @a;
 }
 # (51-52)
 if (setup_badly_terminated_file(2)) {
@@ -113,7 +112,6 @@ if (setup_badly_terminated_file(2)) {
     or die "Couldn't tie file: $!";
   splice @a, 1, 0, "x", "y";
   check_contents($badrec, "x", "y");
-  undef $o; untie @a;
 }
 # (53-56)
 if (setup_badly_terminated_file(4)) {
@@ -128,7 +126,6 @@ if (setup_badly_terminated_file(4)) {
     : "not ok $N \# expected <$badrec>, got <$r[0]>\n";
   $N++;
   check_contents("x", "y");
-  undef $o; untie @a;
 }
 
 # (57-58) 20020402 The modifiaction would have failed if $\ were set wrong.
@@ -141,7 +138,6 @@ if (setup_badly_terminated_file(2)) {
     my $z = $a[0];
   }
   check_contents($badrec);
-  undef $o; untie @a;
 }
 
 sub setup_badly_terminated_file {
diff --git a/lib/Tie/File/t/16_handle.t b/lib/Tie/File/t/16_handle.t
index f799496..72ff10b 100644
--- a/lib/Tie/File/t/16_handle.t
+++ b/lib/Tie/File/t/16_handle.t
@@ -79,7 +79,7 @@ undef $o;
 untie @a;
 
 # (39) Does it correctly detect a non-seekable handle?
-{  if ($^O =~ /^(MSWin32|dos|beos)$/) {
+{  if ($^O =~ /^(MSWin32|dos|BeOS)$/) {
      print "ok $N # skipped ($^O has broken pipe semantics)\n";
      last;
    }
diff --git a/lib/Tie/File/t/19_cache.t b/lib/Tie/File/t/19_cache.t
index 74228c0..81c6932 100644
--- a/lib/Tie/File/t/19_cache.t
+++ b/lib/Tie/File/t/19_cache.t
@@ -3,12 +3,13 @@
 # Tests for various caching errors
 #
 
+$|=1;
 my $file = "tf$$.txt";
 $: = Tie::File::_default_recsep();
 my $data = join $:, "rec0" .. "rec9", "";
 my $V = $ENV{INTEGRITY};        # Verbose integrity checking?
 
-print "1..54\n";
+print "1..55\n";
 
 my $N = 1;
 use Tie::File;
@@ -160,6 +161,11 @@ check();
 splice @a;
 check();
     
+# (55) This was broken on 20030507 when you moved the cache management
+# stuff out of _oadjust back into _splice without also putting it back 
+# into _store.
+@a = (0..11);
+check();
 
 sub init_file {
   my $data = shift;
diff --git a/lib/Tie/File/t/21_win32.t b/lib/Tie/File/t/21_win32.t
index 80d795a..d068544 100644
--- a/lib/Tie/File/t/21_win32.t
+++ b/lib/Tie/File/t/21_win32.t
@@ -9,7 +9,7 @@
 
 my $file = "tf$$.txt";
 
-unless ($^O =~ /^(MSWin32)$/) {
+unless ($^O =~ /^(MSWin32|dos)$/) {
   print "1..0\n";
   exit;
 }
diff --git a/lib/Tie/File/t/25_gen_nocache.t b/lib/Tie/File/t/25_gen_nocache.t
index bafecf0..78e5506 100644
--- a/lib/Tie/File/t/25_gen_nocache.t
+++ b/lib/Tie/File/t/25_gen_nocache.t
@@ -3,7 +3,6 @@
 # Regular read-write tests with caching disabled
 # (Same as 01_gen.t)
 #
-
 my $file = "tf$$.txt";
 
 print "1..68\n";
diff --git a/lib/Tie/File/t/26_twrite.t b/lib/Tie/File/t/26_twrite.t
index 1d9073c..e2a925f 100644
--- a/lib/Tie/File/t/26_twrite.t
+++ b/lib/Tie/File/t/26_twrite.t
@@ -269,7 +269,7 @@ sub try {
   # The record has exactly 17 characters.  This will help ensure that
   # even if _twrite screws up, the data doesn't coincidentally
   # look good because the remainder accidentally lines up.
-  my $d = length($:) == 1 ? "0123456789abcdef$:" : "0123456789abcde$:";
+  my $d = substr("0123456789abcdef$:", -17);
   my $recs = defined($FLEN) ?
     int($FLEN/length($d))+1 : # enough to make up at least $FLEN
     int(8192*5/length($d))+1; # at least 5 blocks' worth
diff --git a/lib/Tie/File/t/27_iwrite.t b/lib/Tie/File/t/27_iwrite.t
new file mode 100644
index 0000000..db591a8
--- /dev/null
+++ b/lib/Tie/File/t/27_iwrite.t
@@ -0,0 +1,235 @@
+#!/usr/bin/perl
+#
+# Unit tests of _iwrite function
+#
+# _iwrite($self, $data, $start, $end)
+#
+# 'i' here is for 'insert'.  This writes $data at absolute position $start
+# in the file, copying the data at that position downwards---
+# but only down to position $end.  Data at or past $end is not moved
+# or even examined.    Since there isn't enough room for the full copy
+# (Because we inserted $data at the beginning) we copy as much as possible
+# and return a string containing the remainder.
+
+my $file = "tf$$.txt";
+$| = 1;
+
+print "1..203\n";
+
+my $N = 1;
+my $oldfile;
+use Tie::File;
+print "ok $N\n"; $N++;
+
+$: = Tie::File::_default_recsep();
+
+$FLEN = 40970;   # Use files of this length
+$oldfile = mkrand($FLEN);
+print "# MOF tests\n";
+# (2-85) These were generated by 'gentests.pl' to cover all possible cases
+# (I hope)
+# Legend:
+#         x: data is entirely contained within one block
+#        x>: data runs from the middle to the end of the block
+#        <x: data runs from the start to the middle of the block
+#       <x>: data occupies precisely one block
+#      x><x: data overlaps one block boundary
+#     <x><x: data runs from the start of one block into the middle of the next
+#     x><x>: data runs from the middle of one block to the end of the next
+#    <x><x>: data occupies two blocks exactly
+# <x><x><x>: data occupies three blocks exactly
+#         0: data is null
+#
+# For each possible alignment of the old and new data, we investigate
+# up to three situations: old data is shorter, old and new data are the
+# same length, and new data is shorter.
+#
+# try($pos, $old, $new) means to run a test where the area being
+# written into starts at position $pos, the area being written into
+# has length $old, and and the new data has length $new.
+try( 8605,  2394,  2394);  # old=x        , new=x        ; old = new
+try( 9768,  1361,   664);  # old=x        , new=x        ; old > new
+try( 9955,  6429,  6429);  # old=x>       , new=x        ; old = new
+try(10550,  5834,  4123);  # old=x>       , new=x        ; old > new
+try(14580,  6158,   851);  # old=x><x     , new=x        ; old > new
+try(13442, 11134,  1572);  # old=x><x>    , new=x        ; old > new
+try( 8192,   514,   514);  # old=<x       , new=<x       ; old = new
+try( 8192,  2196,   858);  # old=<x       , new=<x       ; old > new
+try( 8192,  8192,  8192);  # old=<x>      , new=<x       ; old = new
+try( 8192,  8192,  1290);  # old=<x>      , new=<x       ; old > new
+try( 8192, 10575,  6644);  # old=<x><x    , new=<x       ; old > new
+try( 8192, 16384,  5616);  # old=<x><x>   , new=<x       ; old > new
+try( 8192, 24576,  6253);  # old=<x><x><x>, new=<x       ; old > new
+try( 9965,  6419,  6419);  # old=x>       , new=x>       ; old = new
+try(16059,  6102,   325);  # old=x><x     , new=x>       ; old > new
+try( 9503, 15073,  6881);  # old=x><x>    , new=x>       ; old > new
+try(16316,  1605,  1605);  # old=x><x     , new=x><x     ; old = new
+try(16093,  4074,   993);  # old=x><x     , new=x><x     ; old > new
+try(14739,  9837,  9837);  # old=x><x>    , new=x><x     ; old = new
+try(14071, 10505,  7344);  # old=x><x>    , new=x><x     ; old > new
+try( 8192,  8192,  8192);  # old=<x>      , new=<x>      ; old = new
+try( 8192, 14817,  8192);  # old=<x><x    , new=<x>      ; old > new
+try( 8192, 16384,  8192);  # old=<x><x>   , new=<x>      ; old > new
+try( 8192, 24576,  8192);  # old=<x><x><x>, new=<x>      ; old > new
+try( 8192,  9001,  9001);  # old=<x><x    , new=<x><x    ; old = new
+try( 8192, 11760, 10274);  # old=<x><x    , new=<x><x    ; old > new
+try( 8192, 16384, 10781);  # old=<x><x>   , new=<x><x    ; old > new
+try( 8192, 24576,  9284);  # old=<x><x><x>, new=<x><x    ; old > new
+try(14761,  9815,  9815);  # old=x><x>    , new=x><x>    ; old = new
+try( 8192, 16384, 16384);  # old=<x><x>   , new=<x><x>   ; old = new
+try( 8192, 24576, 16384);  # old=<x><x><x>, new=<x><x>   ; old > new
+try( 8192, 24576, 24576);  # old=<x><x><x>, new=<x><x><x>; old = new
+try( 8771,   776,     0);  # old=x        , new=0        ; old > new
+try( 8192,  2813,     0);  # old=<x       , new=0        ; old > new
+try(13945,  2439,     0);  # old=x>       , new=0        ; old > new
+try(14493,  6090,     0);  # old=x><x     , new=0        ; old > new
+try( 8192,  8192,     0);  # old=<x>      , new=0        ; old > new
+try( 8192, 10030,     0);  # old=<x><x    , new=0        ; old > new
+try(14983,  9593,     0);  # old=x><x>    , new=0        ; old > new
+try( 8192, 16384,     0);  # old=<x><x>   , new=0        ; old > new
+try( 8192, 24576,     0);  # old=<x><x><x>, new=0        ; old > new
+try(10489,     0,     0);  # old=0        , new=0        ; old = new
+
+print "# SOF tests\n";
+# (86-133)
+# These tests all take place at the start of the file
+try(    0,  4868,  4868);  # old=<x       , new=<x       ; old = new
+try(    0,   147,   118);  # old=<x       , new=<x       ; old > new
+try(    0,  8192,  8192);  # old=<x>      , new=<x       ; old = new
+try(    0,  8192,  4574);  # old=<x>      , new=<x       ; old > new
+try(    0, 11891,  1917);  # old=<x><x    , new=<x       ; old > new
+try(    0, 16384,  5155);  # old=<x><x>   , new=<x       ; old > new
+try(    0, 24576,  2953);  # old=<x><x><x>, new=<x       ; old > new
+try(    0,  8192,  8192);  # old=<x>      , new=<x>      ; old = new
+try(    0, 11083,  8192);  # old=<x><x    , new=<x>      ; old > new
+try(    0, 16384,  8192);  # old=<x><x>   , new=<x>      ; old > new
+try(    0, 24576,  8192);  # old=<x><x><x>, new=<x>      ; old > new
+try(    0, 14126, 14126);  # old=<x><x    , new=<x><x    ; old = new
+try(    0, 12002,  9034);  # old=<x><x    , new=<x><x    ; old > new
+try(    0, 16384, 13258);  # old=<x><x>   , new=<x><x    ; old > new
+try(    0, 24576, 14367);  # old=<x><x><x>, new=<x><x    ; old > new
+try(    0, 16384, 16384);  # old=<x><x>   , new=<x><x>   ; old = new
+try(    0, 24576, 16384);  # old=<x><x><x>, new=<x><x>   ; old > new
+try(    0, 24576, 24576);  # old=<x><x><x>, new=<x><x><x>; old = new
+try(    0,  6530,     0);  # old=<x       , new=0        ; old > new
+try(    0,  8192,     0);  # old=<x>      , new=0        ; old > new
+try(    0, 14707,     0);  # old=<x><x    , new=0        ; old > new
+try(    0, 16384,     0);  # old=<x><x>   , new=0        ; old > new
+try(    0, 24576,     0);  # old=<x><x><x>, new=0        ; old > new
+try(    0,     0,     0);  # old=0        , new=0        ; old = new
+
+print "# EOF tests 1\n";
+# (134-169)
+# These tests all take place at the end of the file
+$FLEN = 40960;  # Force the file to be exactly 40960 bytes long
+$oldfile = mkrand($FLEN);
+try(32768,  8192,  8192);  # old=<x>      , new=<x       ; old = new
+try(32768,  8192,  4026);  # old=<x>      , new=<x       ; old > new
+try(24576, 16384,  1917);  # old=<x><x>   , new=<x       ; old > new
+try(16384, 24576,  3818);  # old=<x><x><x>, new=<x       ; old > new
+try(32768,  8192,  8192);  # old=<x>      , new=<x>      ; old = new
+try(24576, 16384,  8192);  # old=<x><x>   , new=<x>      ; old > new
+try(16384, 24576,  8192);  # old=<x><x><x>, new=<x>      ; old > new
+try(24576, 16384, 12221);  # old=<x><x>   , new=<x><x    ; old > new
+try(16384, 24576, 15030);  # old=<x><x><x>, new=<x><x    ; old > new
+try(24576, 16384, 16384);  # old=<x><x>   , new=<x><x>   ; old = new
+try(16384, 24576, 16384);  # old=<x><x><x>, new=<x><x>   ; old > new
+try(16384, 24576, 24576);  # old=<x><x><x>, new=<x><x><x>; old = new
+try(35973,  4987,     0);  # old=x>       , new=0        ; old > new
+try(32768,  8192,     0);  # old=<x>      , new=0        ; old > new
+try(29932, 11028,     0);  # old=x><x>    , new=0        ; old > new
+try(24576, 16384,     0);  # old=<x><x>   , new=0        ; old > new
+try(16384, 24576,     0);  # old=<x><x><x>, new=0        ; old > new
+try(40960,     0,     0);  # old=0        , new=0        ; old = new
+
+print "# EOF tests 2\n";
+# (170-203)
+# These tests all take place at the end of the file
+$FLEN = 42000;  # Force the file to be exactly 42000 bytes long
+$oldfile = mkrand($FLEN);
+try(41683,   317,   317);  # old=x        , new=x        ; old = new
+try(41225,   775,   405);  # old=x        , new=x        ; old > new
+try(35709,  6291,   284);  # old=x><x     , new=x        ; old > new
+try(40960,  1040,  1040);  # old=<x       , new=<x       ; old = new
+try(40960,  1040,   378);  # old=<x       , new=<x       ; old > new
+try(32768,  9232,  5604);  # old=<x><x    , new=<x       ; old > new
+try(39994,  2006,   966);  # old=x><x     , new=x>       ; old > new
+try(36725,  5275,  5275);  # old=x><x     , new=x><x     ; old = new
+try(37990,  4010,  3199);  # old=x><x     , new=x><x     ; old > new
+try(32768,  9232,  8192);  # old=<x><x    , new=<x>      ; old > new
+try(32768,  9232,  9232);  # old=<x><x    , new=<x><x    ; old = new
+try(32768,  9232,  8795);  # old=<x><x    , new=<x><x    ; old > new
+try(41500,   500,     0);  # old=x        , new=0        ; old > new
+try(40960,  1040,     0);  # old=<x       , new=0        ; old > new
+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 mkrand {
+  my $len = shift;
+  srand $len;
+  my @c = ('a' .. 'z', 'A' .. 'Z', 0..9, $:);
+  my $d = "";
+  $d .= $c[rand @c] until length($d) >= $len;
+  substr($d, $len) = ""; # chop it off to the proper length
+  $d;
+}
+
+sub try {
+  my ($s, $len, $newlen) = @_;
+  my $e = $s + $len;
+
+  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 $newdata = "-" x $newlen;
+  my $expected = $oldfile;
+
+  my $expected_return = substr($expected, $e - $newlen, $newlen, "");
+  substr($expected, $s, 0, $newdata);
+
+  my $o = tie my @lines, 'Tie::File', $file or die $!;
+  my $actual_return = $o->_iwrite($newdata, $s, $e);
+  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);
+  unless ($alen == $xlen) {
+    print "# try(@_) expected file length $xlen, actual $alen!\n";
+  }
+  print $actual eq $expected ? "ok $N\n" : "not ok $N\n";
+  $N++;
+
+  if (! defined $actual_return && ! defined $expected_return) {
+    print "ok $N\n";
+  } elsif (! defined $actual_return || ! defined $expected_return) {
+    print "not ok $N\n";
+  } else {
+    print $actual_return eq $expected_return ? "ok $N\n" : "not ok $N\n";
+  }
+  $N++;
+}
+
+sub ctrlfix {
+  for (@_) {
+    s/\n/\\n/g;
+    s/\r/\\r/g;
+  }
+}
+
+END {
+  1 while unlink $file;
+}
+
diff --git a/lib/Tie/File/t/28_mtwrite.t b/lib/Tie/File/t/28_mtwrite.t
new file mode 100644
index 0000000..d21d03a
--- /dev/null
+++ b/lib/Tie/File/t/28_mtwrite.t
@@ -0,0 +1,351 @@
+#!/usr/bin/perl
+#
+# Unit tests of _mtwrite function
+#
+# _mtwrite($self, $d1, $s1, $l1, $d2, $s2, $l2, ...)
+#
+# 'm' here is for 'multiple'.  This writes data $d1 at position $s1
+# over a block of space $l1, moving subsequent data up or down as necessary.
+
+my $file = "tf$$.txt";
+$| = 1;
+
+print "1..2252\n";
+
+my $N = 1;
+my $oldfile;
+use Tie::File;
+print "ok $N\n"; $N++;
+
+$: = Tie::File::_default_recsep();
+
+# Only these are used for the triple-region tests
+@BASE_TRIES = (
+               [10, 20, 30], 
+               [10, 30, 20], 
+               [100, 30, 20],
+               [100, 20, 30], 
+               [100, 40, 20], 
+               [100, 20, 40], 
+               [200, 20, 30],
+               [200, 30, 20],
+               [200, 20, 60],
+               [200, 60, 20],
+               );
+
+@TRIES = @BASE_TRIES;
+
+$FLEN = 40970;   # Use files of this length
+$oldfile = mkrand($FLEN);
+print "# MOF tests\n";
+# These were generated by 'gentests.pl' to cover all possible cases
+# (I hope)
+# Legend:
+#         x: data is entirely contained within one block
+#        x>: data runs from the middle to the end of the block
+#        <x: data runs from the start to the middle of the block
+#       <x>: data occupies precisely one block
+#      x><x: data overlaps one block boundary
+#     <x><x: data runs from the start of one block into the middle of the next
+#     x><x>: data runs from the middle of one block to the end of the next
+#    <x><x>: data occupies two blocks exactly
+# <x><x><x>: data occupies three blocks exactly
+#         0: data is null
+#
+# For each possible alignment of the old and new data, we investigate
+# up to three situations: old data is shorter, old and new data are the
+# same length, and new data is shorter.
+#
+# try($pos, $old, $new) means to run a test where the area being
+# written into starts at position $pos, the area being written into
+# has length $old, and and the new data has length $new.
+try( 8605,  2394,  2394);  # old=x        , new=x        ; old = new
+try( 9768,  1361,   664);  # old=x        , new=x        ; old > new
+try( 9955,  6429,  6429);  # old=x>       , new=x        ; old = new
+try(10550,  5834,  4123);  # old=x>       , new=x        ; old > new
+try(14580,  6158,   851);  # old=x><x     , new=x        ; old > new
+try(13442, 11134,  1572);  # old=x><x>    , new=x        ; old > new
+try( 8192,   514,   514);  # old=<x       , new=<x       ; old = new
+try( 8192,  2196,   858);  # old=<x       , new=<x       ; old > new
+try( 8192,  8192,  8192);  # old=<x>      , new=<x       ; old = new
+try( 8192,  8192,  1290);  # old=<x>      , new=<x       ; old > new
+try( 8192, 10575,  6644);  # old=<x><x    , new=<x       ; old > new
+try( 8192, 16384,  5616);  # old=<x><x>   , new=<x       ; old > new
+try( 8192, 24576,  6253);  # old=<x><x><x>, new=<x       ; old > new
+try( 9965,  6419,  6419);  # old=x>       , new=x>       ; old = new
+try(16059,  6102,   325);  # old=x><x     , new=x>       ; old > new
+try( 9503, 15073,  6881);  # old=x><x>    , new=x>       ; old > new
+try(16316,  1605,  1605);  # old=x><x     , new=x><x     ; old = new
+try(16093,  4074,   993);  # old=x><x     , new=x><x     ; old > new
+try(14739,  9837,  9837);  # old=x><x>    , new=x><x     ; old = new
+try(14071, 10505,  7344);  # old=x><x>    , new=x><x     ; old > new
+try( 8192,  8192,  8192);  # old=<x>      , new=<x>      ; old = new
+try( 8192, 14817,  8192);  # old=<x><x    , new=<x>      ; old > new
+try( 8192, 16384,  8192);  # old=<x><x>   , new=<x>      ; old > new
+try( 8192, 24576,  8192);  # old=<x><x><x>, new=<x>      ; old > new
+try( 8192,  9001,  9001);  # old=<x><x    , new=<x><x    ; old = new
+try( 8192, 11760, 10274);  # old=<x><x    , new=<x><x    ; old > new
+try( 8192, 16384, 10781);  # old=<x><x>   , new=<x><x    ; old > new
+try( 8192, 24576,  9284);  # old=<x><x><x>, new=<x><x    ; old > new
+try(14761,  9815,  9815);  # old=x><x>    , new=x><x>    ; old = new
+try( 8192, 16384, 16384);  # old=<x><x>   , new=<x><x>   ; old = new
+try( 8192, 24576, 16384);  # old=<x><x><x>, new=<x><x>   ; old > new
+try( 8192, 24576, 24576);  # old=<x><x><x>, new=<x><x><x>; old = new
+try( 8771,   776,     0);  # old=x        , new=0        ; old > new
+try( 8192,  2813,     0);  # old=<x       , new=0        ; old > new
+try(13945,  2439,     0);  # old=x>       , new=0        ; old > new
+try(14493,  6090,     0);  # old=x><x     , new=0        ; old > new
+try( 8192,  8192,     0);  # old=<x>      , new=0        ; old > new
+try( 8192, 10030,     0);  # old=<x><x    , new=0        ; old > new
+try(14983,  9593,     0);  # old=x><x>    , new=0        ; old > new
+try( 8192, 16384,     0);  # old=<x><x>   , new=0        ; old > new
+try( 8192, 24576,     0);  # old=<x><x><x>, new=0        ; old > new
+try(10489,     0,     0);  # old=0        , new=0        ; old = new
+
+print "# SOF tests\n";
+# These tests all take place at the start of the file
+try(    0,  4868,  4868);  # old=<x       , new=<x       ; old = new
+try(    0,   147,   118);  # old=<x       , new=<x       ; old > new
+try(    0,  8192,  8192);  # old=<x>      , new=<x       ; old = new
+try(    0,  8192,  4574);  # old=<x>      , new=<x       ; old > new
+try(    0, 11891,  1917);  # old=<x><x    , new=<x       ; old > new
+try(    0, 16384,  5155);  # old=<x><x>   , new=<x       ; old > new
+try(    0, 24576,  2953);  # old=<x><x><x>, new=<x       ; old > new
+try(    0,  8192,  8192);  # old=<x>      , new=<x>      ; old = new
+try(    0, 11083,  8192);  # old=<x><x    , new=<x>      ; old > new
+try(    0, 16384,  8192);  # old=<x><x>   , new=<x>      ; old > new
+try(    0, 24576,  8192);  # old=<x><x><x>, new=<x>      ; old > new
+try(    0, 14126, 14126);  # old=<x><x    , new=<x><x    ; old = new
+try(    0, 12002,  9034);  # old=<x><x    , new=<x><x    ; old > new
+try(    0, 16384, 13258);  # old=<x><x>   , new=<x><x    ; old > new
+try(    0, 24576, 14367);  # old=<x><x><x>, new=<x><x    ; old > new
+try(    0, 16384, 16384);  # old=<x><x>   , new=<x><x>   ; old = new
+try(    0, 24576, 16384);  # old=<x><x><x>, new=<x><x>   ; old > new
+try(    0, 24576, 24576);  # old=<x><x><x>, new=<x><x><x>; old = new
+try(    0,  6530,     0);  # old=<x       , new=0        ; old > new
+try(    0,  8192,     0);  # old=<x>      , new=0        ; old > new
+try(    0, 14707,     0);  # old=<x><x    , new=0        ; old > new
+try(    0, 16384,     0);  # old=<x><x>   , new=0        ; old > new
+try(    0, 24576,     0);  # old=<x><x><x>, new=0        ; old > new
+try(    0,     0,     0);  # old=0        , new=0        ; old = new
+
+print "# EOF tests 1\n";
+# These tests all take place at the end of the file
+$FLEN = 40960;  # Force the file to be exactly 40960 bytes long
+$oldfile = mkrand($FLEN);
+try(32768,  8192,  8192);  # old=<x>      , new=<x       ; old = new
+try(32768,  8192,  4026);  # old=<x>      , new=<x       ; old > new
+try(24576, 16384,  1917);  # old=<x><x>   , new=<x       ; old > new
+try(16384, 24576,  3818);  # old=<x><x><x>, new=<x       ; old > new
+try(32768,  8192,  8192);  # old=<x>      , new=<x>      ; old = new
+try(24576, 16384,  8192);  # old=<x><x>   , new=<x>      ; old > new
+try(16384, 24576,  8192);  # old=<x><x><x>, new=<x>      ; old > new
+try(24576, 16384, 12221);  # old=<x><x>   , new=<x><x    ; old > new
+try(16384, 24576, 15030);  # old=<x><x><x>, new=<x><x    ; old > new
+try(24576, 16384, 16384);  # old=<x><x>   , new=<x><x>   ; old = new
+try(16384, 24576, 16384);  # old=<x><x><x>, new=<x><x>   ; old > new
+try(16384, 24576, 24576);  # old=<x><x><x>, new=<x><x><x>; old = new
+try(35973,  4987,     0);  # old=x>       , new=0        ; old > new
+try(32768,  8192,     0);  # old=<x>      , new=0        ; old > new
+try(29932, 11028,     0);  # old=x><x>    , new=0        ; old > new
+try(24576, 16384,     0);  # old=<x><x>   , new=0        ; old > new
+try(16384, 24576,     0);  # old=<x><x><x>, new=0        ; old > new
+try(40960,     0,     0);  # old=0        , new=0        ; old = new
+
+print "# EOF tests 2\n";
+# These tests all take place at the end of the file
+$FLEN = 42000;  # Force the file to be exactly 42000 bytes long
+$oldfile = mkrand($FLEN);
+try(41683,   317,   317);  # old=x        , new=x        ; old = new
+try(41225,   775,   405);  # old=x        , new=x        ; old > new
+try(35709,  6291,   284);  # old=x><x     , new=x        ; old > new
+try(40960,  1040,  1040);  # old=<x       , new=<x       ; old = new
+try(40960,  1040,   378);  # old=<x       , new=<x       ; old > new
+try(32768,  9232,  5604);  # old=<x><x    , new=<x       ; old > new
+try(39994,  2006,   966);  # old=x><x     , new=x>       ; old > new
+try(36725,  5275,  5275);  # old=x><x     , new=x><x     ; old = new
+try(37990,  4010,  3199);  # old=x><x     , new=x><x     ; old > new
+try(32768,  9232,  8192);  # old=<x><x    , new=<x>      ; old > new
+try(32768,  9232,  9232);  # old=<x><x    , new=<x><x    ; old = new
+try(32768,  9232,  8795);  # old=<x><x    , new=<x><x    ; old > new
+try(41500,   500,     0);  # old=x        , new=0        ; old > new
+try(40960,  1040,     0);  # old=<x       , new=0        ; old > new
+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
+
+# Now the REAL tests 
+# Make sure mtwrite can properly write sequences of several intervals
+# The intervals tested above were accumulated into @TRIES.
+# try_all_doubles() tries every possible sensible pair of those intervals.
+# try_all_triples() tries every possible sensible group of 
+#  tree intervals from the more restrictive set @BASE_TRIES.
+$FLEN = 40970;
+$oldfile = mkrand($FLEN);
+try_all_doubles();
+try_all_triples();
+
+sub mkrand {
+  my $len = shift;
+  srand $len;
+  my @c = ('a' .. 'z', 'A' .. 'Z', 0..9, $:);
+  my $d = "";
+  $d .= $c[rand @c] until length($d) >= $len;
+  substr($d, $len) = ""; # chop it off to the proper length
+  $d;
+}
+
+sub try {
+  push @TRIES, [@_] if @_ == 3;
+
+  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 @mt_args; 
+  my $expected = $oldfile;
+  { my @a = @_;
+    my $c = "a";
+    while (@a) {
+      my ($s, $len, $newlen) = splice @a, -3;
+      my $newdata = $c++ x $newlen;
+      substr($expected, $s, $len, $newdata);
+      unshift @mt_args, $newdata, $s, $len;
+    }
+  }
+
+  my $o = tie my @lines, 'Tie::File', $file or die $!;
+  my $actual_return = $o->_mtwrite(@mt_args);
+  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);
+  unless ($alen == $xlen) {
+    print "# try(@_) expected file length $xlen, actual $alen!\n";
+  }
+  print $actual eq $expected ? "ok $N\n" : "not ok $N\n";
+  $N++;
+
+#  if (! defined $actual_return && ! defined $expected_return) {
+#    print "ok $N\n";
+#  } elsif (! defined $actual_return || ! defined $expected_return) {
+#    print "not ok $N\n";
+#  } else {
+#    print $actual_return eq $expected_return ? "ok $N\n" : "not ok $N\n";
+#  }
+#  $N++;
+}
+
+sub try_all_doubles {
+  print "# Trying double regions.\n";
+  for my $a (@TRIES) {
+    next if $a->[0] + $a->[1] >= $FLEN;
+    next if $a->[0] + $a->[2] >= $FLEN;
+    for my $b (@TRIES) {
+      next if $b->[0] + $b->[1] >= $FLEN;
+      next if $b->[0] + $b->[2] >= $FLEN;
+
+      next if $b->[0] < $a->[0] + $a->[1]; # Overlapping regions
+      try(@$a, @$b);
+    }
+  }
+}
+
+sub try_all_triples {
+  print "# Trying triple regions.\n";
+  for my $a (@BASE_TRIES) {
+    next if $a->[0] + $a->[1] >= $FLEN;
+    next if $a->[0] + $a->[2] >= $FLEN;
+    for my $b (@BASE_TRIES) {
+      next if $b->[0] + $b->[1] >= $FLEN;
+      next if $b->[0] + $b->[2] >= $FLEN;
+
+      next if $b->[0] < $a->[0] + $a->[1]; # Overlapping regions
+
+      for my $c (@BASE_TRIES) {
+        next if $c->[0] + $c->[1] >= $FLEN;
+        next if $c->[0] + $c->[2] >= $FLEN;
+
+        next if $c->[0] < $b->[0] + $b->[1]; # Overlapping regions
+        try(@$a, @$b, @$c);
+      }
+    }
+  }
+}
+
+# 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;
+    s/\r/\\r/g;
+  }
+}
+
+END {
+  1 while unlink $file;
+}
+
diff --git a/lib/Tie/File/t/29_downcopy.t b/lib/Tie/File/t/29_downcopy.t
new file mode 100644
index 0000000..24f9597
--- /dev/null
+++ b/lib/Tie/File/t/29_downcopy.t
@@ -0,0 +1,366 @@
+#!/usr/bin/perl
+#
+# Unit tests of _twrite function
+#
+# _downcopy($self, $data, $pos, $len)
+# Write $data into a block of length $len at position $pos,
+# 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.
+#
+#
+
+my $file = "tf$$.txt";
+
+print "1..718\n";
+
+my $N = 1;
+use Tie::File;
+print "ok $N\n"; $N++;
+
+$: = Tie::File::_default_recsep();
+
+my @subtests = qw(x <x x> x><x <x> <x><x x><x> <x><x> <x><x><x> 0);
+print "ok $N\n"; $N++;
+
+# (3-144) These were generated by 'gentests.pl' to cover all possible cases
+# (I hope)
+# Legend:
+#         x: data is entirely contained within one block
+#        x>: data runs from the middle to the end of the block
+#        <x: data runs from the start to the middle of the block
+#       <x>: data occupies precisely one block
+#      x><x: data overlaps one block boundary
+#     <x><x: data runs from the start of one block into the middle of the next
+#     x><x>: data runs from the middle of one block to the end of the next
+#    <x><x>: data occupies two blocks exactly
+# <x><x><x>: data occupies three blocks exactly
+#         0: data is null
+#
+# For each possible alignment of the old and new data, we investigate
+# up to three situations: old data is shorter, old and new data are the
+# same length, and new data is shorter.
+#
+# try($pos, $old, $new) means to run a test where the data starts at 
+# position $pos, the old data has length $old,
+# and the new data has length $new.
+try( 9659,  6635,  6691);  # old=x        , new=x        ; old < new
+try( 8605,  2394,  2394);  # old=x        , new=x        ; old = new
+try( 9768,  1361,   664);  # old=x        , new=x        ; old > new
+try( 9955,  6429,  6429);  # old=x>       , new=x        ; old = new
+try(10550,  5834,  4123);  # old=x>       , new=x        ; old > new
+try(14580,  6158,   851);  # old=x><x     , new=x        ; old > new
+try(13442, 11134,  1572);  # old=x><x>    , new=x        ; old > new
+try( 8394,     0,  5742);  # old=0        , new=x        ; old < new
+try( 8192,  2819,  6738);  # old=<x       , new=<x       ; old < new
+try( 8192,   514,   514);  # old=<x       , new=<x       ; old = new
+try( 8192,  2196,   858);  # old=<x       , new=<x       ; old > new
+try( 8192,  8192,  8192);  # old=<x>      , new=<x       ; old = new
+try( 8192,  8192,  1290);  # old=<x>      , new=<x       ; old > new
+try( 8192, 10575,  6644);  # old=<x><x    , new=<x       ; old > new
+try( 8192, 16384,  5616);  # old=<x><x>   , new=<x       ; old > new
+try( 8192, 24576,  6253);  # old=<x><x><x>, new=<x       ; old > new
+try( 8192,     0,  6870);  # old=0        , new=<x       ; old < new
+try( 8478,  6259,  7906);  # old=x        , new=x>       ; old < new
+try( 9965,  6419,  6419);  # old=x>       , new=x>       ; old = new
+try(16059,  6102,   325);  # old=x><x     , new=x>       ; old > new
+try( 9503, 15073,  6881);  # old=x><x>    , new=x>       ; old > new
+try( 9759,     0,  6625);  # old=0        , new=x>       ; old < new
+try( 8525,  2081,  8534);  # old=x        , new=x><x     ; old < new
+try(15550,   834,  1428);  # old=x>       , new=x><x     ; old < new
+try(14966,  1668,  3479);  # old=x><x     , new=x><x     ; old < new
+try(16316,  1605,  1605);  # old=x><x     , new=x><x     ; old = new
+try(16093,  4074,   993);  # old=x><x     , new=x><x     ; old > new
+try(14739,  9837,  9837);  # old=x><x>    , new=x><x     ; old = new
+try(14071, 10505,  7344);  # old=x><x>    , new=x><x     ; old > new
+try(12602,     0,  8354);  # old=0        , new=x><x     ; old < new
+try( 8192,  2767,  8192);  # old=<x       , new=<x>      ; old < new
+try( 8192,  8192,  8192);  # old=<x>      , new=<x>      ; old = new
+try( 8192, 14817,  8192);  # old=<x><x    , new=<x>      ; old > new
+try( 8192, 16384,  8192);  # old=<x><x>   , new=<x>      ; old > new
+try( 8192, 24576,  8192);  # old=<x><x><x>, new=<x>      ; old > new
+try( 8192,     0,  8192);  # old=0        , new=<x>      ; old < new
+try( 8192,  6532, 10882);  # old=<x       , new=<x><x    ; old < new
+try( 8192,  8192, 16044);  # old=<x>      , new=<x><x    ; old < new
+try( 8192,  9555, 11020);  # old=<x><x    , new=<x><x    ; old < new
+try( 8192,  9001,  9001);  # old=<x><x    , new=<x><x    ; old = new
+try( 8192, 11760, 10274);  # old=<x><x    , new=<x><x    ; old > new
+try( 8192, 16384, 10781);  # old=<x><x>   , new=<x><x    ; old > new
+try( 8192, 24576,  9284);  # old=<x><x><x>, new=<x><x    ; old > new
+try( 8192,     0, 12488);  # old=0        , new=<x><x    ; old < new
+try( 8222,  6385, 16354);  # old=x        , new=x><x>    ; old < new
+try(13500,  2884, 11076);  # old=x>       , new=x><x>    ; old < new
+try(14069,  4334, 10507);  # old=x><x     , new=x><x>    ; old < new
+try(14761,  9815,  9815);  # old=x><x>    , new=x><x>    ; old = new
+try(10469,     0, 14107);  # old=0        , new=x><x>    ; old < new
+try( 8192,  4181, 16384);  # old=<x       , new=<x><x>   ; old < new
+try( 8192,  8192, 16384);  # old=<x>      , new=<x><x>   ; old < new
+try( 8192, 12087, 16384);  # old=<x><x    , new=<x><x>   ; old < new
+try( 8192, 16384, 16384);  # old=<x><x>   , new=<x><x>   ; old = new
+try( 8192, 24576, 16384);  # old=<x><x><x>, new=<x><x>   ; old > new
+try( 8192,     0, 16384);  # old=0        , new=<x><x>   ; old < new
+try( 8192,  4968, 24576);  # old=<x       , new=<x><x><x>; old < new
+try( 8192,  8192, 24576);  # old=<x>      , new=<x><x><x>; old < new
+try( 8192, 14163, 24576);  # old=<x><x    , new=<x><x><x>; old < new
+try( 8192, 16384, 24576);  # old=<x><x>   , new=<x><x><x>; old < new
+try( 8192, 24576, 24576);  # old=<x><x><x>, new=<x><x><x>; old = new
+try( 8192,     0, 24576);  # old=0        , new=<x><x><x>; old < new
+try( 8771,   776,     0);  # old=x        , new=0        ; old > new
+try( 8192,  2813,     0);  # old=<x       , new=0        ; old > new
+try(13945,  2439,     0);  # old=x>       , new=0        ; old > new
+try(14493,  6090,     0);  # old=x><x     , new=0        ; old > new
+try( 8192,  8192,     0);  # old=<x>      , new=0        ; old > new
+try( 8192, 10030,     0);  # old=<x><x    , new=0        ; old > new
+try(14983,  9593,     0);  # old=x><x>    , new=0        ; old > new
+try( 8192, 16384,     0);  # old=<x><x>   , new=0        ; old > new
+try( 8192, 24576,     0);  # old=<x><x><x>, new=0        ; old > new
+try(10489,     0,     0);  # old=0        , new=0        ; old = new
+
+# (142-223)
+# These tests all take place at the start of the file
+try(    0,   771,  1593);  # old=<x       , new=<x       ; old < new
+try(    0,  4868,  4868);  # old=<x       , new=<x       ; old = new
+try(    0,   147,   118);  # old=<x       , new=<x       ; old > new
+try(    0,  8192,  8192);  # old=<x>      , new=<x       ; old = new
+try(    0,  8192,  4574);  # old=<x>      , new=<x       ; old > new
+try(    0, 11891,  1917);  # old=<x><x    , new=<x       ; old > new
+try(    0, 16384,  5155);  # old=<x><x>   , new=<x       ; old > new
+try(    0, 24576,  2953);  # old=<x><x><x>, new=<x       ; old > new
+try(    0,     0,  1317);  # old=0        , new=<x       ; old < new
+try(    0,  5609,  8192);  # old=<x       , new=<x>      ; old < new
+try(    0,  8192,  8192);  # old=<x>      , new=<x>      ; old = new
+try(    0, 11083,  8192);  # old=<x><x    , new=<x>      ; old > new
+try(    0, 16384,  8192);  # old=<x><x>   , new=<x>      ; old > new
+try(    0, 24576,  8192);  # old=<x><x><x>, new=<x>      ; old > new
+try(    0,     0,  8192);  # old=0        , new=<x>      ; old < new
+try(    0,  6265,  9991);  # old=<x       , new=<x><x    ; old < new
+try(    0,  8192, 16119);  # old=<x>      , new=<x><x    ; old < new
+try(    0, 10218, 11888);  # old=<x><x    , new=<x><x    ; old < new
+try(    0, 14126, 14126);  # old=<x><x    , new=<x><x    ; old = new
+try(    0, 12002,  9034);  # old=<x><x    , new=<x><x    ; old > new
+try(    0, 16384, 13258);  # old=<x><x>   , new=<x><x    ; old > new
+try(    0, 24576, 14367);  # old=<x><x><x>, new=<x><x    ; old > new
+try(    0,     0, 10881);  # old=0        , new=<x><x    ; old < new
+try(    0,  6448, 16384);  # old=<x       , new=<x><x>   ; old < new
+try(    0,  8192, 16384);  # old=<x>      , new=<x><x>   ; old < new
+try(    0, 15082, 16384);  # old=<x><x    , new=<x><x>   ; old < new
+try(    0, 16384, 16384);  # old=<x><x>   , new=<x><x>   ; old = new
+try(    0, 24576, 16384);  # old=<x><x><x>, new=<x><x>   ; old > new
+try(    0,     0, 16384);  # old=0        , new=<x><x>   ; old < new
+try(    0,  2421, 24576);  # old=<x       , new=<x><x><x>; old < new
+try(    0,  8192, 24576);  # old=<x>      , new=<x><x><x>; old < new
+try(    0, 11655, 24576);  # old=<x><x    , new=<x><x><x>; old < new
+try(    0, 16384, 24576);  # old=<x><x>   , new=<x><x><x>; old < new
+try(    0, 24576, 24576);  # old=<x><x><x>, new=<x><x><x>; old = new
+try(    0,     0, 24576);  # old=0        , new=<x><x><x>; old < new
+try(    0,  6530,     0);  # old=<x       , new=0        ; old > new
+try(    0,  8192,     0);  # old=<x>      , new=0        ; old > new
+try(    0, 14707,     0);  # old=<x><x    , new=0        ; old > new
+try(    0, 16384,     0);  # old=<x><x>   , new=0        ; old > new
+try(    0, 24576,     0);  # old=<x><x><x>, new=0        ; old > new
+try(    0,     0,     0);  # old=0        , new=0        ; old = new
+
+# (224-277)
+# These tests all take place at the end of the file
+$FLEN = 40960;  # Force the file to be exactly 40960 bytes long
+try(32768,  8192,  8192);  # old=<x>      , new=<x       ; old = new
+try(32768,  8192,  4026);  # old=<x>      , new=<x       ; old > new
+try(24576, 16384,  1917);  # old=<x><x>   , new=<x       ; old > new
+try(16384, 24576,  3818);  # old=<x><x><x>, new=<x       ; old > new
+try(40960,     0,  2779);  # old=0        , new=<x       ; old < new
+try(32768,  8192,  8192);  # old=<x>      , new=<x>      ; old = new
+try(24576, 16384,  8192);  # old=<x><x>   , new=<x>      ; old > new
+try(16384, 24576,  8192);  # old=<x><x><x>, new=<x>      ; old > new
+try(40960,     0,  8192);  # old=0        , new=<x>      ; old < new
+try(32768,  8192, 10724);  # old=<x>      , new=<x><x    ; old < new
+try(24576, 16384, 12221);  # old=<x><x>   , new=<x><x    ; old > new
+try(16384, 24576, 15030);  # old=<x><x><x>, new=<x><x    ; old > new
+try(40960,     0, 11752);  # old=0        , new=<x><x    ; old < new
+try(32768,  8192, 16384);  # old=<x>      , new=<x><x>   ; old < new
+try(24576, 16384, 16384);  # old=<x><x>   , new=<x><x>   ; old = new
+try(16384, 24576, 16384);  # old=<x><x><x>, new=<x><x>   ; old > new
+try(40960,     0, 16384);  # old=0        , new=<x><x>   ; old < new
+try(32768,  8192, 24576);  # old=<x>      , new=<x><x><x>; old < new
+try(24576, 16384, 24576);  # old=<x><x>   , new=<x><x><x>; old < new
+try(16384, 24576, 24576);  # old=<x><x><x>, new=<x><x><x>; old = new
+try(40960,     0, 24576);  # old=0        , new=<x><x><x>; old < new
+try(35973,  4987,     0);  # old=x>       , new=0        ; old > new
+try(32768,  8192,     0);  # old=<x>      , new=0        ; old > new
+try(29932, 11028,     0);  # old=x><x>    , new=0        ; old > new
+try(24576, 16384,     0);  # old=<x><x>   , new=0        ; old > new
+try(16384, 24576,     0);  # old=<x><x><x>, new=0        ; old > new
+try(40960,     0,     0);  # old=0        , new=0        ; old = new
+
+# (278-357)
+# These tests all take place at the end of the file
+$FLEN = 42000;  # Force the file to be exactly 42000 bytes long
+try(41275,   725,  4059);  # old=x        , new=x        ; old < new
+try(41683,   317,   317);  # old=x        , new=x        ; old = new
+try(41225,   775,   405);  # old=x        , new=x        ; old > new
+try(35709,  6291,   284);  # old=x><x     , new=x        ; old > new
+try(42000,     0,  2434);  # old=0        , new=x        ; old < new
+try(40960,  1040,  1608);  # old=<x       , new=<x       ; old < new
+try(40960,  1040,  1040);  # old=<x       , new=<x       ; old = new
+try(40960,  1040,   378);  # old=<x       , new=<x       ; old > new
+try(32768,  9232,  5604);  # old=<x><x    , new=<x       ; old > new
+try(42000,     0,  6637);  # old=0        , new=<x       ; old < new
+try(41022,   978,  8130);  # old=x        , new=x>       ; old < new
+try(39994,  2006,   966);  # old=x><x     , new=x>       ; old > new
+try(42000,     0,  7152);  # old=0        , new=x>       ; old < new
+try(41613,   387, 10601);  # old=x        , new=x><x     ; old < new
+try(38460,  3540,  3938);  # old=x><x     , new=x><x     ; old < new
+try(36725,  5275,  5275);  # old=x><x     , new=x><x     ; old = new
+try(37990,  4010,  3199);  # old=x><x     , new=x><x     ; old > new
+try(42000,     0,  9189);  # old=0        , new=x><x     ; old < new
+try(40960,  1040,  8192);  # old=<x       , new=<x>      ; old < new
+try(32768,  9232,  8192);  # old=<x><x    , new=<x>      ; old > new
+try(42000,     0,  8192);  # old=0        , new=<x>      ; old < new
+try(40960,  1040, 11778);  # old=<x       , new=<x><x    ; old < new
+try(32768,  9232, 13792);  # old=<x><x    , new=<x><x    ; old < new
+try(32768,  9232,  9232);  # old=<x><x    , new=<x><x    ; old = new
+try(32768,  9232,  8795);  # old=<x><x    , new=<x><x    ; old > new
+try(42000,     0,  8578);  # old=0        , new=<x><x    ; old < new
+try(41531,   469, 15813);  # old=x        , new=x><x>    ; old < new
+try(39618,  2382,  9534);  # old=x><x     , new=x><x>    ; old < new
+try(42000,     0, 15344);  # old=0        , new=x><x>    ; old < new
+try(40960,  1040, 16384);  # old=<x       , new=<x><x>   ; old < new
+try(32768,  9232, 16384);  # old=<x><x    , new=<x><x>   ; old < new
+try(42000,     0, 16384);  # old=0        , new=<x><x>   ; old < new
+try(40960,  1040, 24576);  # old=<x       , new=<x><x><x>; old < new
+try(32768,  9232, 24576);  # old=<x><x    , new=<x><x><x>; old < new
+try(42000,     0, 24576);  # old=0        , new=<x><x><x>; old < new
+try(41500,   500,     0);  # old=x        , new=0        ; old > new
+try(40960,  1040,     0);  # old=<x       , new=0        ; old > new
+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: $!";
+  binmode F;
+
+  # The record has exactly 17 characters.  This will help ensure that
+  # even if _downcoopy screws up, the data doesn't coincidentally
+  # look good because the remainder accidentally lines up.
+  my $d = substr("0123456789abcdef$:", -17);
+  my $recs = defined($FLEN) ?
+    int($FLEN/length($d))+1 : # enough to make up at least $FLEN
+    int(8192*5/length($d))+1; # at least 5 blocks' worth
+  my $oldfile = $d x $recs;
+  my $flen = defined($FLEN) ? $FLEN : $recs * 17;
+  substr($oldfile, $FLEN) = "" if defined $FLEN;  # truncate
+  print F $oldfile;
+  close F;
+
+  die "wrong length!" unless -s $file == $flen;
+
+  my $newdata = "-" x $newlen;
+  my $expected = $oldfile;
+  my $old = defined $len ? substr($expected, $pos, $len) 
+                         : substr($expected, $pos);
+  $old = "$newdata$old";
+  my $x_retval;
+  if (defined $len) {
+    substr($expected, $pos, $len, substr($old, 0, $len, ""));
+    $x_retval = $old;
+  } else {
+    substr($expected, $pos) = $old;
+    $x_retval = "";
+  }
+
+  my $o = tie my @lines, 'Tie::File', $file or die $!;
+  local $SIG{ALRM} = sub { die "Alarm clock" };
+  my $a_retval = eval { alarm(5) unless $^P; $o->_downcopy($newdata, $pos, $len) };
+  my $err = $@;
+  undef $o; untie @lines;
+  if ($err) {
+    if ($err =~ /^Alarm clock/) {
+      print "# Timeout\n";
+      print "not ok $N\n"; $N++;
+      print "not ok $N\n"; $N++;
+      return;
+    } else {
+      $@ = $err;
+      die;
+    }
+  }
+
+  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);
+  unless ($alen == $xlen) {
+    my @ARGS = @_;
+    for (@ARGS) { $_ = "UNDEF" unless defined }
+    print "# try(@ARGS) expected file length $xlen, actual $alen!\n";
+  }
+  print $actual eq $expected ? "ok $N\n" : "not ok $N\n";
+  $N++;
+  print $a_retval eq $x_retval ? "ok $N\n" : "not ok $N\n";
+  $N++;
+
+  if (defined $len) {
+    try($pos, undef, $newlen);
+  }
+}
+
+
+
+use POSIX 'SEEK_SET';
+sub check_contents {
+  my @c = @_;
+  my $x = join $:, @c, '';
+  local *FH = $o->{fh};
+  seek FH, 0, SEEK_SET;
+#  my $open = open FH, "< $file";
+  my $a;
+  { local $/; $a = <FH> }
+  $a = "" unless defined $a;
+  if ($a eq $x) {
+    print "ok $N\n";
+  } else {
+    ctrlfix($a, $x);
+    print "not ok $N\n# expected <$x>, got <$a>\n";
+  }
+  $N++;
+
+  # now check FETCH:
+  my $good = 1;
+  my $msg;
+  for (0.. $#c) {
+    my $aa = $a[$_];
+    unless ($aa eq "$c[$_]$:") {
+      $msg = "expected <$c[$_]$:>, got <$aa>";
+      ctrlfix($msg);
+      $good = 0;
+    }
+  }
+  print $good ? "ok $N\n" : "not ok $N # $msg\n";
+  $N++;
+
+  print $o->_check_integrity($file, $ENV{INTEGRITY}) 
+      ? "ok $N\n" : "not ok $N\n";
+  $N++;
+}
+
+sub ctrlfix {
+  for (@_) {
+    s/\n/\\n/g;
+    s/\r/\\r/g;
+  }
+}
+
+END {
+  undef $o;
+  untie @a;
+  1 while unlink $file;
+}
+
diff --git a/lib/Tie/File/t/29a_upcopy.t b/lib/Tie/File/t/29a_upcopy.t
new file mode 100644
index 0000000..67e8526
--- /dev/null
+++ b/lib/Tie/File/t/29a_upcopy.t
@@ -0,0 +1,211 @@
+#!/usr/bin/perl
+#
+# Unit tests of _upcopy function
+#
+# _upcopy($self, $source, $dest, $len)
+#
+# Take a block of data of leength $len at $source and copy it
+# to $dest, which must be <= $source but which need not be <= $source - $len
+# (That is, this will only copy a block to a position earlier in the file,
+# but the source and destination regions may overlap.)
+
+
+my $file = "tf$$.txt";
+
+print "1..55\n";
+
+my $N = 1;
+use Tie::File;
+print "ok $N\n"; $N++;
+
+$: = Tie::File::_default_recsep();
+
+my @subtests = qw(x <x x> x><x <x> <x><x x><x> <x><x> <x><x><x> 0);
+
+$FLEN = 40970;  # 2410 records of 17 chars each
+
+# (2-7) Trivial non-moves at start of file
+try(0, 0, 0);
+try(0, 0, 10);
+try(0, 0, 100);
+try(0, 0, 1000);
+try(0, 0, 10000);
+try(0, 0, 20000);
+
+# (8-13) Trivial non-moves in middle of file
+try(100, 100, 0);
+try(100, 100, 10);
+try(100, 100, 100);
+try(100, 100, 1000);
+try(100, 100, 10000);
+try(100, 100, 20000);
+
+# (14) Trivial non-move at end of file
+try($FLEN, $FLEN, 0);
+
+# (15-17) Trivial non-move of tail of file
+try(0, 0, undef);
+try(100, 100, undef);
+try($FLEN, $FLEN, undef);
+
+# (18-24) Moves to start of file
+try(100, 0, 0);
+try(100, 0, 10);
+try(100, 0, 100);
+try(100, 0, 1000);
+try(100, 0, 10000);
+try(100, 0, 20000);
+try(100, 0, undef);
+
+# (25-31) Moves in middle of file
+try(200, 100, 0);
+try(200, 100, 10);
+try(200, 100, 100);
+try(200, 100, 1000);
+try(200, 100, 10000);
+try(200, 100, 20000);
+try(200, 100, undef);
+
+# (32-43) Moves from end of file
+try($FLEN, 10000, 0);
+try($FLEN-10, 10000, 10);
+try($FLEN-100, 10000, 100);
+try($FLEN-1000, 200, 1000);
+try($FLEN-10000, 200, 10000);
+try($FLEN-20000, 200, 20000);
+try($FLEN, 10000, undef);
+try($FLEN-10, 10000, undef);
+try($FLEN-100, 10000, undef);
+try($FLEN-1000, 200, undef);
+try($FLEN-10000, 200, undef);
+try($FLEN-20000, 200, undef);
+
+$FLEN = 40960;
+
+# (44-55) Moves from end of file when file ends on a block boundary
+try($FLEN, 10000, 0);
+try($FLEN-10, 10000, 10);
+try($FLEN-100, 10000, 100);
+try($FLEN-1000, 200, 1000);
+try($FLEN-10000, 200, 10000);
+try($FLEN-20000, 200, 20000);
+try($FLEN, 10000, undef);
+try($FLEN-10, 10000, undef);
+try($FLEN-100, 10000, undef);
+try($FLEN-1000, 200, undef);
+try($FLEN-10000, 200, undef);
+try($FLEN-20000, 200, undef);
+
+sub try {
+  my ($src, $dst, $len) = @_;
+  open F, "> $file" or die "Couldn't open file $file: $!";
+  binmode F;
+
+  # The record has exactly 17 characters.  This will help ensure that
+  # even if _upcopy screws up, the data doesn't coincidentally
+  # look good because the remainder accidentally lines up.
+  my $d = substr("0123456789abcdef$:", -17);
+  my $recs = defined($FLEN) ?
+    int($FLEN/length($d))+1 : # enough to make up at least $FLEN
+    int(8192*5/length($d))+1; # at least 5 blocks' worth
+  my $oldfile = $d x $recs;
+  my $flen = defined($FLEN) ? $FLEN : $recs * 17;
+  substr($oldfile, $FLEN) = "" if defined $FLEN;  # truncate
+  print F $oldfile;
+  close F;
+
+  die "wrong length!" unless -s $file == $flen;
+
+  # If len is specified, use that.  If it's undef,
+  # then behave *as if* we had specified the whole rest of the file
+  my $expected = $oldfile;
+  if (defined $len) {
+    substr($expected, $dst, $len) = substr($expected, $src, $len);
+  } else {
+    substr($expected, $dst) = substr($expected, $src);
+  }
+
+  my $o = tie my @lines, 'Tie::File', $file or die $!;
+  local $SIG{ALRM} = sub { die "Alarm clock" };
+  my $a_retval = eval { alarm(5) unless $^P; $o->_upcopy($src, $dst, $len) };
+  my $err = $@;
+  undef $o; untie @lines;
+  if ($err) {
+    if ($err =~ /^Alarm clock/) {
+      print "# Timeout\n";
+      print "not ok $N\n"; $N++;
+      return;
+    } else {
+      $@ = $err;
+      die;
+    }
+  }
+
+  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);
+  unless ($alen == $xlen) {
+    print "# try(@_) expected file length $xlen, actual $alen!\n";
+  }
+  print $actual eq $expected ? "ok $N\n" : "not ok $N\n";
+  $N++;
+}
+
+
+
+use POSIX 'SEEK_SET';
+sub check_contents {
+  my @c = @_;
+  my $x = join $:, @c, '';
+  local *FH = $o->{fh};
+  seek FH, 0, SEEK_SET;
+#  my $open = open FH, "< $file";
+  my $a;
+  { local $/; $a = <FH> }
+  $a = "" unless defined $a;
+  if ($a eq $x) {
+    print "ok $N\n";
+  } else {
+    ctrlfix($a, $x);
+    print "not ok $N\n# expected <$x>, got <$a>\n";
+  }
+  $N++;
+
+  # now check FETCH:
+  my $good = 1;
+  my $msg;
+  for (0.. $#c) {
+    my $aa = $a[$_];
+    unless ($aa eq "$c[$_]$:") {
+      $msg = "expected <$c[$_]$:>, got <$aa>";
+      ctrlfix($msg);
+      $good = 0;
+    }
+  }
+  print $good ? "ok $N\n" : "not ok $N # $msg\n";
+  $N++;
+
+  print $o->_check_integrity($file, $ENV{INTEGRITY}) 
+      ? "ok $N\n" : "not ok $N\n";
+  $N++;
+}
+
+sub ctrlfix {
+  for (@_) {
+    s/\n/\\n/g;
+    s/\r/\\r/g;
+  }
+}
+
+END {
+  undef $o;
+  untie @a;
+  1 while unlink $file;
+}
+
diff --git a/lib/Tie/File/t/30_defer.t b/lib/Tie/File/t/30_defer.t
index 7503829..063b3a7 100644
--- a/lib/Tie/File/t/30_defer.t
+++ b/lib/Tie/File/t/30_defer.t
@@ -125,17 +125,14 @@ check_caches({map(($_ => "record$_$:"), 5..7)},
 check_contents($data);
 
 $a[2] = "recordC";              # That should flush the whole darn defer
-# Flushing the defer requires looking up the true lengths of records
-# 0..2, which flushes out the read cache, leaving only 1..2 there.
-# Then the splicer updates the cached versions of 1..2 to contain the
-# new data
-check_caches({1 => "recordB$:", 2 => "recordC$:"},
+# This shouldn't change the cache contents
+check_caches({map(($_ => "record$_$:"), 5..7)}, 
              {});               # URRRP
 check_contents(join("$:", qw(recordA recordB recordC 
                              record3 record4 record5 record6 record7)) . "$:");
 
 $a[3] = "recordD";         # even though we flushed, deferring is STILL ENABLED
-check_caches({1 => "recordB$:", 2 => "recordC$:"},
+check_caches({map(($_ => "record$_$:"), 5..7)},
              {3 => "recordD$:"}); 
 check_contents(join("$:", qw(recordA recordB recordC 
                              record3 record4 record5 record6 record7)) . "$:");
@@ -143,86 +140,84 @@ check_contents(join("$:", qw(recordA recordB recordC
 # Check readcache-deferbuffer interactions
 
 # (45-47) This should remove outdated data from the read cache
-$a[2] = "recordE";
-check_caches({1 => "recordB$:",                 },
-             {3 => "recordD$:", 2 => "recordE$:"}); 
+$a[5] = "recordE";
+check_caches({6 => "record6$:", 7 => "record7$:"},
+             {3 => "recordD$:", 5 => "recordE$:"}); 
 check_contents(join("$:", qw(recordA recordB recordC 
                              record3 record4 record5 record6 record7)) . "$:");
 
 # (48-51) This should read back out of the defer buffer
 # without adding anything to the read cache
 my $z;
-$z = $a[2];
+$z = $a[5];
 print $z eq "recordE" ? "ok $N\n" : "not ok $N\n";  $N++;
-check_caches({1 => "recordB$:",                 },
-             {3 => "recordD$:", 2 => "recordE$:"}); 
+check_caches({6 => "record6$:", 7 => "record7$:"},
+             {3 => "recordD$:", 5 => "recordE$:"}); 
 check_contents(join("$:", qw(recordA recordB recordC 
                              record3 record4 record5 record6 record7)) . "$:");
 
 # (52-55) This should repopulate the read cache with a new record
 $z = $a[0];
 print $z eq "recordA" ? "ok $N\n" : "not ok $N\n";  $N++;
-check_caches({1 => "recordB$:", 0 => "recordA$:"},
-             {3 => "recordD$:", 2 => "recordE$:"}); 
+check_caches({0 => "recordA$:", 6 => "record6$:", 7 => "record7$:"},
+             {3 => "recordD$:", 5 => "recordE$:"}); 
 check_contents(join("$:", qw(recordA recordB recordC 
                              record3 record4 record5 record6 record7)) . "$:");
 
 # (56-59) This should flush the LRU record from the read cache
-$z = $a[4];  $z = $a[5];
-print $z eq "record5" ? "ok $N\n" : "not ok $N\n";  $N++;
-check_caches({5 => "record5$:", 0 => "recordA$:", 4 => "record4$:"},
-             {3 => "recordD$:", 2 => "recordE$:"}); 
+$z = $a[4];
+print $z eq "record4" ? "ok $N\n" : "not ok $N\n";  $N++;
+check_caches({7 => "record7$:", 0 => "recordA$:", 4 => "record4$:"},
+             {3 => "recordD$:", 5 => "recordE$:"}); 
 check_contents(join("$:", qw(recordA recordB recordC 
                              record3 record4 record5 record6 record7)) . "$:");
 
 # (60-63) This should FLUSH the deferred buffer
-# In doing so, it will read in records 2 and 3, flushing 0 and 4
-# from the read cache, leaving 2, 3, and 5.
 $z = splice @a, 3, 1, "recordZ";
 print $z eq "recordD" ? "ok $N\n" : "not ok $N\n";  $N++;
-check_caches({5 => "record5$:", 3 => "recordZ$:", 2 => "recordE$:"},
+check_caches({7 => "record7$:", 0 => "recordA$:", 4 => "record4$:", 3 => "recordZ$:"},
              {}); 
-check_contents(join("$:", qw(recordA recordB recordE 
-                             recordZ record4 record5 record6 record7)) . "$:");
+check_contents(join("$:", qw(recordA recordB recordC 
+                             recordZ record4 recordE record6 record7)) . "$:");
 
 # (64-66) We should STILL be in deferred writing mode
 $a[5] = "recordX";
-check_caches({3 => "recordZ$:", 2 => "recordE$:"},
+check_caches({7 => "record7$:", 0 => "recordA$:", 4 => "record4$:", 3 => "recordZ$:"},
              {5 => "recordX$:"}); 
-check_contents(join("$:", qw(recordA recordB recordE 
-                             recordZ record4 record5 record6 record7)) . "$:");
+check_contents(join("$:", qw(recordA recordB recordC 
+                             recordZ record4 recordE record6 record7)) . "$:");
 
 # Fill up the defer buffer again
 $a[4] = "recordP";
 # (67-69) This should OVERWRITE the existing deferred record 
 # and NOT flush the buffer
 $a[5] = "recordQ";   
-check_caches({3 => "recordZ$:", 2 => "recordE$:"},
+check_caches({7 => "record7$:", 0 => "recordA$:", 3 => "recordZ$:"},
              {5 => "recordQ$:", 4 => "recordP$:"}); 
-check_contents(join("$:", qw(recordA recordB recordE 
-                             recordZ record4 record5 record6 record7)) . "$:");
-
+check_contents(join("$:", qw(recordA recordB recordC 
+                             recordZ record4 recordE record6 record7)) . "$:");
 
 # (70-72) Discard should just dump the whole deferbuffer
 $o->discard;
-check_caches({3 => "recordZ$:", 2 => "recordE$:"},
+check_caches({7 => "record7$:", 0 => "recordA$:", 3 => "recordZ$:"},
              {}); 
-check_contents(join("$:", qw(recordA recordB recordE 
-                             recordZ record4 record5 record6 record7)) . "$:");
+check_contents(join("$:", qw(recordA recordB recordC 
+                             recordZ record4 recordE record6 record7)) . "$:");
+
 # (73-75) NOW we are out of deferred writing mode
 $a[0] = "recordF";
-check_caches({3 => "recordZ$:", 2 => "recordE$:", 0 => "recordF$:"},
+check_caches({7 => "record7$:", 0 => "recordF$:", 3 => "recordZ$:"},
              {}); 
-check_contents(join("$:", qw(recordF recordB recordE 
-                             recordZ record4 record5 record6 record7)) . "$:");
+check_contents(join("$:", qw(recordF recordB recordC
+                             recordZ record4 recordE record6 record7)) . "$:");
 
 # (76-79) Last call--untying the array should flush the deferbuffer
 $o->defer;
 $a[0] = "flushed";
-check_caches({3 => "recordZ$:", 2 => "recordE$:"},
+check_caches({7 => "record7$:",                   3 => "recordZ$:"},
              {0 => "flushed$:" }); 
-check_contents(join("$:", qw(recordF recordB recordE 
-                             recordZ record4 record5 record6 record7)) . "$:");
+check_contents(join("$:", qw(recordF recordB recordC
+                             recordZ record4 recordE record6 record7)) . "$:");
 undef $o;
 untie @a;
 # (79) We can't use check_contents any more, because the object is dead
@@ -230,8 +225,8 @@ open F, "< $file" or die;
 binmode F;
 { local $/ ; $z = <F> }
 close F;
-my $x = join("$:", qw(flushed recordB recordE 
-                      recordZ record4 record5 record6 record7)) . "$:";
+my $x = join("$:", qw(flushed recordB recordC
+                      recordZ record4 recordE record6 record7)) . "$:";
 if ($z eq $x) {
   print "ok $N\n";
 } else {
@@ -326,6 +321,8 @@ sub ctrlfix {
 }
 
 END {
+  undef $o;
+  untie @a if tied @a;
   1 while unlink $file;
 }
 
diff --git a/lib/Tie/File/t/42_offset.t b/lib/Tie/File/t/42_offset.t
new file mode 100644
index 0000000..1762443
--- /dev/null
+++ b/lib/Tie/File/t/42_offset.t
@@ -0,0 +1,74 @@
+#!/usr/bin/perl
+
+# 2003-04-09 Tels: test the offset method from 0.94
+
+use Test::More;
+use strict;
+use File::Spec;
+
+use POSIX 'SEEK_SET';
+my $file = "tf$$.txt";
+
+BEGIN
+  {
+  $| = 1;
+  if ($ENV{PERL_CORE})
+    {
+    # testing with the core distribution
+    @INC = ( File::Spec->catdir(File::Spec->updir, 't', 'lib') );
+    }
+  unshift @INC, File::Spec->catdir(File::Spec->updir, 'lib');
+  chdir 't' if -d 't';
+  print "# INC = @INC\n";
+
+  plan tests => 24;
+
+  use_ok ('Tie::File');
+  }
+
+$/ = "#";	# avoid problems with \n\r vs. \n
+
+my @a;
+my $o = tie @a, 'Tie::File', $file, autodefer => 0;
+
+is (ref($o), 'Tie::File');
+
+is ($o->offset(0), 0, 'first one always there');
+is ($o->offset(1), undef, 'no offsets yet');
+
+$a[0] = 'Bourbon';
+is ($o->offset(0), 0, 'first is ok');
+is ($o->offset(1), 8, 'and second ok');
+is ($o->offset(2), undef, 'third undef');
+
+$a[1] = 'makes';
+is ($o->offset(0), 0, 'first is ok');
+is ($o->offset(1), 8, 'and second ok');
+is ($o->offset(2), 14, 'and third ok');
+is ($o->offset(3), undef, 'fourth undef');
+
+$a[2] = 'the baby';
+is ($o->offset(0), 0, 'first is ok');
+is ($o->offset(1), 8, 'and second ok');
+is ($o->offset(2), 14, 'and third ok');
+is ($o->offset(3), 23, 'and fourth ok');
+is ($o->offset(4), undef, 'fourth undef');
+
+$a[3] = 'grin';
+is ($o->offset(0), 0, 'first is ok');
+is ($o->offset(1), 8, 'and second ok');
+is ($o->offset(2), 14, 'and third ok');
+is ($o->offset(3), 23, 'and fourth ok');
+is ($o->offset(4), 28, 'and fifth ok');
+
+$a[4] = '!';
+is ($o->offset(5), 30, 'and fifth ok');
+$a[3] = 'water';
+is ($o->offset(4), 29, 'and fourth changed ok');
+is ($o->offset(5), 31, 'and fifth ok');
+
+END {
+  undef $o;
+  untie @a;
+  1 while unlink $file;
+}