diff -ruN Tie-File-0.96/lib/Tie/File.pm Tie-File-0.97/lib/Tie/File.pm --- Tie-File-0.96/lib/Tie/File.pm 2003-05-28 01:05:41.000000000 +0900 +++ Tie-File-0.97/lib/Tie/File.pm 2006-06-14 04:31:19.000000000 +0900 @@ -7,14 +7,14 @@ sub O_ACCMODE () { O_RDONLY | O_RDWR | O_WRONLY } -$VERSION = "0.96"; +$VERSION = "0.97"; my $DEFAULT_MEMORY_SIZE = 1<<21; # 2 megabytes my $DEFAULT_AUTODEFER_THRESHHOLD = 3; # 3 records my $DEFAULT_AUTODEFER_FILELEN_THRESHHOLD = 65536; # 16 disk blocksful my %good_opt = map {$_ => 1, "-$_" => 1} qw(memory dw_size mode recsep discipline - autodefer autochomp autodefer_threshhold); + autodefer autochomp autodefer_threshhold concurrent); sub TIEARRAY { if (@_ % 2 != 0) { @@ -33,6 +33,10 @@ } } + if ($opts{concurrent}) { + croak("$pack: concurrent access not supported yet\n"); + } + unless (defined $opts{memory}) { # default is the larger of the default cache size and the # deferred-write buffer size (if specified) @@ -697,6 +701,8 @@ # moving everything in the block forwards to make room. # Instead of writing the last length($data) bytes from the block # (because there isn't room for them any longer) return them. +# +# Undefined $len means 'until the end of the file' sub _downcopy { my $blocksize = 8192; my ($self, $data, $pos, $len) = @_; @@ -707,11 +713,21 @@ : $len > $blocksize? $blocksize : $len; $self->_seekb($pos); read $fh, my($old), $readsize; + my $last_read_was_short = length($old) < $readsize; $data .= $old; - $self->_seekb($pos); - my $writable = substr($data, 0, $readsize, ""); + my $writable; + if ($last_read_was_short) { + # If last read was short, then $data now contains the entire rest + # of the file, so there's no need to write only one block of it + $writable = $data; + $data = ""; + } else { + $writable = substr($data, 0, $readsize, ""); + } last if $writable eq ""; + $self->_seekb($pos); $self->_write_record($writable); + last if $last_read_was_short && $data eq ""; $len -= $readsize if defined $len; $pos += $readsize; } @@ -1993,7 +2009,7 @@ =head1 SYNOPSIS - # This file documents Tie::File version 0.96 + # This file documents Tie::File version 0.97 use Tie::File; tie @array, 'Tie::File', filename or die ...; @@ -2411,14 +2427,14 @@ =head1 CONCURRENT ACCESS TO FILES Caching and deferred writing are inappropriate if you want the same -file to be accessed simultaneously from more than one process. You -will want to disable these features. You should do that by including -the C 0> option in your C calls; this will inhibit -caching and deferred writing. - -You will also want to lock the file while reading or writing it. You -can use the C<-Eflock> method for this. A future version of this -module may provide an 'autolocking' mode. +file to be accessed simultaneously from more than one process. Other +optimizations performed internally by this module are also +incompatible with concurrent access. A future version of this module will +support a C 1> option that enables safe concurrent access. + +Previous versions of this documentation suggested using C 0> for safe concurrent access. This was mistaken. Tie::File +will not support safe concurrent access before version 0.98. =head1 CAVEATS @@ -2516,7 +2532,7 @@ =head1 LICENSE -C version 0.96 is copyright (C) 2002 Mark Jason Dominus. +C version 0.97 is copyright (C) 2003 Mark Jason Dominus. This library is free software; you may redistribute it and/or modify it under the same terms as Perl itself. @@ -2544,7 +2560,7 @@ =head1 WARRANTY -C version 0.96 comes with ABSOLUTELY NO WARRANTY. +C version 0.97 comes with ABSOLUTELY NO WARRANTY. For details, see the license. =head1 THANKS diff -ruN Tie-File-0.96/t/00_version.t Tie-File-0.97/t/00_version.t --- Tie-File-0.96/t/00_version.t 2003-05-27 23:14:26.000000000 +0900 +++ Tie-File-0.97/t/00_version.t 2006-06-14 04:31:19.000000000 +0900 @@ -2,7 +2,7 @@ print "1..1\n"; -my $testversion = "0.96"; +my $testversion = "0.97"; use Tie::File; if ($Tie::File::VERSION != $testversion) { diff -ruN Tie-File-0.96/t/09_gen_rs.t Tie-File-0.97/t/09_gen_rs.t --- Tie-File-0.96/t/09_gen_rs.t 2003-05-28 00:43:25.000000000 +0900 +++ Tie-File-0.97/t/09_gen_rs.t 2006-06-14 04:31:19.000000000 +0900 @@ -1,6 +1,5 @@ #!/usr/bin/perl -use lib '/home/mjd/src/perl/Tie-File2/lib'; my $file = "tf$$.txt"; print "1..59\n"; @@ -147,7 +146,7 @@ # There's special-case code to fix the final record when it is read normally. # But the $#a forces it to be read from the cache, which skips the # termination. -$badrec = "world\nhello"; +$badrec = "world${RECSEP}hello"; if (setup_badly_terminated_file(1)) { tie(@a, "Tie::File", $file, mode => 0, recsep => $RECSEP) or die "Couldn't tie file: $!"; diff -ruN Tie-File-0.96/t/16_handle.t Tie-File-0.97/t/16_handle.t --- Tie-File-0.96/t/16_handle.t 2002-04-01 12:31:24.000000000 +0900 +++ Tie-File-0.97/t/16_handle.t 2006-06-14 04:31:19.000000000 +0900 @@ -79,7 +79,7 @@ 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 -ruN Tie-File-0.96/t/24_cache_loop.t Tie-File-0.97/t/24_cache_loop.t --- Tie-File-0.96/t/24_cache_loop.t 2002-04-06 04:33:29.000000000 +0900 +++ Tie-File-0.97/t/24_cache_loop.t 2006-06-14 04:31:19.000000000 +0900 @@ -43,6 +43,7 @@ alarm 5 unless $^P; @a = "record0" .. "record9"; print "ok 3\n"; +alarm 0; END { undef $o; diff -ruN Tie-File-0.96/t/28_mtwrite.t Tie-File-0.97/t/28_mtwrite.t --- Tie-File-0.96/t/28_mtwrite.t 2003-05-08 15:25:28.000000000 +0900 +++ Tie-File-0.97/t/28_mtwrite.t 2006-06-14 04:31:19.000000000 +0900 @@ -282,62 +282,6 @@ } } -# 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 = ; - } - close F; - - my ($alen, $xlen) = (length $actual, length $expected); - print "# try_all_doubles(@$a, @$b)\n"; - unless ($alen == $xlen) { - print "# expected file length $xlen, actual $alen!\n"; - } - print $actual eq $expected ? "ok $N\n" : "not ok $N\n"; - $N++; - } - } -} - sub ctrlfix { for (@_) { s/\n/\\n/g; diff -ruN Tie-File-0.96/t/29_downcopy.t Tie-File-0.97/t/29_downcopy.t --- Tie-File-0.96/t/29_downcopy.t 2003-05-08 15:25:24.000000000 +0900 +++ Tie-File-0.97/t/29_downcopy.t 2006-06-14 04:31:19.000000000 +0900 @@ -1,6 +1,6 @@ #!/usr/bin/perl # -# Unit tests of _twrite function +# Unit tests of _downcopy function # # _downcopy($self, $data, $pos, $len) # Write $data into a block of length $len at position $pos, @@ -235,8 +235,6 @@ try(32768, 9232, 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: $!"; @@ -275,7 +273,7 @@ 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; + undef $o; untie @lines; alarm(0); if ($err) { if ($err =~ /^Alarm clock/) { print "# Timeout\n"; @@ -363,4 +361,3 @@ untie @a; 1 while unlink $file; } - diff -ruN Tie-File-0.96/t/29a_upcopy.t Tie-File-0.97/t/29a_upcopy.t --- Tie-File-0.96/t/29a_upcopy.t 2003-05-08 15:25:21.000000000 +0900 +++ Tie-File-0.97/t/29a_upcopy.t 2006-06-14 04:31:19.000000000 +0900 @@ -129,7 +129,7 @@ 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; + undef $o; untie @lines; alarm(0); if ($err) { if ($err =~ /^Alarm clock/) { print "# Timeout\n";