From: Jarkko Hietaniemi Date: Wed, 18 Jun 2003 17:31:50 +0000 (+0000) Subject: Upgrade to Tie::File 0.97. X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=bc2f65e02ab268c64852d8d5a231dbdd758c29db;p=p5sagit%2Fp5-mst-13.2.git Upgrade to Tie::File 0.97. p4raw-id: //depot/perl@19813 --- diff --git a/lib/Tie/File.pm b/lib/Tie/File.pm index 851e63a..2539324 100644 --- a/lib/Tie/File.pm +++ b/lib/Tie/File.pm @@ -7,14 +7,14 @@ use Fcntl 'O_CREAT', 'O_RDWR', 'LOCK_EX', 'LOCK_SH', 'O_WRONLY', 'O_RDONLY'; sub O_ACCMODE () { O_RDONLY | O_RDWR | O_WRONLY } -$VERSION = "0.96"; +$VERSION = "0.97"; my $DEFAULT_MEMORY_SIZE = 1<<21; # 2 megabytes my $DEFAULT_AUTODEFER_THRESHHOLD = 3; # 3 records my $DEFAULT_AUTODEFER_FILELEN_THRESHHOLD = 65536; # 16 disk blocksful my %good_opt = map {$_ => 1, "-$_" => 1} qw(memory dw_size mode recsep discipline - autodefer autochomp autodefer_threshhold); + autodefer autochomp autodefer_threshhold concurrent); sub TIEARRAY { if (@_ % 2 != 0) { @@ -33,6 +33,10 @@ sub TIEARRAY { } } + if ($opts{concurrent}) { + croak("$pack: concurrent access not supported yet\n"); + } + unless (defined $opts{memory}) { # default is the larger of the default cache size and the # deferred-write buffer size (if specified) @@ -697,6 +701,8 @@ sub _upcopy { # moving everything in the block forwards to make room. # Instead of writing the last length($data) bytes from the block # (because there isn't room for them any longer) return them. +# +# Undefined $len means 'until the end of the file' sub _downcopy { my $blocksize = 8192; my ($self, $data, $pos, $len) = @_; @@ -707,10 +713,19 @@ sub _downcopy { : $len > $blocksize? $blocksize : $len; $self->_seekb($pos); read $fh, my($old), $readsize; + my $last_read_was_short = length($old) < $readsize; $data .= $old; - $self->_seekb($pos); - my $writable = substr($data, 0, $readsize, ""); + my $writable; + if ($last_read_was_short) { + # If last read was short, then $data now contains the entire rest + # of the file, so there's no need to write only one block of it + $writable = $data; + $data = ""; + } else { + $writable = substr($data, 0, $readsize, ""); + } last if $writable eq ""; + $self->_seekb($pos); $self->_write_record($writable); $len -= $readsize if defined $len; $pos += $readsize; @@ -1993,7 +2008,7 @@ Tie::File - Access the lines of a disk file via a Perl array =head1 SYNOPSIS - # This file documents Tie::File version 0.96 + # This file documents Tie::File version 0.97 use Tie::File; tie @array, 'Tie::File', filename or die ...; @@ -2411,14 +2426,14 @@ C<-Eautodefer()> recovers the current value of the autodefer setting. =head1 CONCURRENT ACCESS TO FILES Caching and deferred writing are inappropriate if you want the same -file to be accessed simultaneously from more than one process. You -will want to disable these features. You should do that by including -the C 0> option in your C calls; this will inhibit -caching and deferred writing. +file to be accessed simultaneously from more than one process. Other +optimizations performed internally by this module are also +incompatible with concurrent access. A future version of this module will +support a C 1> option that enables safe concurrent access. -You will also want to lock the file while reading or writing it. You -can use the C<-Eflock> method for this. A future version of this -module may provide an 'autolocking' mode. +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 +2531,7 @@ any news of importance, will be available at =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 +2559,7 @@ For licensing inquiries, contact the author at: =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 --git a/lib/Tie/File/t/00_version.t b/lib/Tie/File/t/00_version.t index 68e13ff..3dd51c0 100644 --- a/lib/Tie/File/t/00_version.t +++ b/lib/Tie/File/t/00_version.t @@ -2,7 +2,7 @@ print "1..1\n"; -my $testversion = "0.96"; +my $testversion = "0.97"; use Tie::File; if ($Tie::File::VERSION != $testversion) { diff --git a/lib/Tie/File/t/09_gen_rs.t b/lib/Tie/File/t/09_gen_rs.t index 43b7140..041131f 100644 --- a/lib/Tie/File/t/09_gen_rs.t +++ b/lib/Tie/File/t/09_gen_rs.t @@ -1,6 +1,5 @@ #!/usr/bin/perl -use lib '/home/mjd/src/perl/Tie-File2/lib'; my $file = "tf$$.txt"; print "1..59\n"; diff --git a/lib/Tie/File/t/28_mtwrite.t b/lib/Tie/File/t/28_mtwrite.t index d21d03a..50e306d 100644 --- a/lib/Tie/File/t/28_mtwrite.t +++ b/lib/Tie/File/t/28_mtwrite.t @@ -282,62 +282,6 @@ sub try_all_triples { } } -# Each element of @TRIES has [start, oldlen, newlen] -# Try them pairwise -sub xxtry_all_doubles { - print "# Trying double regions.\n"; - my %reg; # regions - for my $i (0 .. $#TRIES) { - $a = $TRIES[$i]; - ($reg{a}{st}, $reg{a}{ol}, $reg{a}{nl}) = @{$TRIES[$i]}; - next if $reg{a}{st} + $reg{a}{ol} >= $FLEN; - next if $reg{a}{st} + $reg{a}{nl} >= $FLEN; - for my $j (0 .. $#TRIES){ - $b = $TRIES[$j]; - ($reg{b}{st}, $reg{b}{ol}, $reg{b}{nl}) = @{$TRIES[$j]}; - next if $reg{b}{st} + $reg{b}{ol} >= $FLEN; - next if $reg{b}{st} + $reg{b}{nl} >= $FLEN; - - next if $reg{b}{st} < $reg{a}{st} + $reg{a}{ol}; # Overlapping regions -# $reg{b}{st} -= $reg{a}{ol} - $reg{a}{nl}; - - open F, "> $file" or die "Couldn't open file $file: $!"; - binmode F; - print F $oldfile; - close F; - die "wrong length!" unless -s $file == $FLEN; - - my $expected = $oldfile; - for ('b', 'a') { - $reg{$_}{nd} = $_ x $reg{$_}{nl}; - substr($expected, $reg{$_}{st}, $reg{$_}{ol}, $reg{$_}{nd}); - } - - my $o = tie my @lines, 'Tie::File', $file or die $!; - $o->_mtwrite($reg{a}{nd}, $reg{a}{st}, $reg{a}{ol}, - $reg{b}{nd}, $reg{b}{st}, $reg{b}{ol}, - ); - undef $o; untie @lines; - - open F, "< $file" or die "Couldn't open file $file: $!"; - binmode F; - my $actual; - { local $/; - $actual = ; - } - close F; - - my ($alen, $xlen) = (length $actual, length $expected); - print "# try_all_doubles(@$a, @$b)\n"; - unless ($alen == $xlen) { - print "# expected file length $xlen, actual $alen!\n"; - } - print $actual eq $expected ? "ok $N\n" : "not ok $N\n"; - $N++; - } - } -} - sub ctrlfix { for (@_) { s/\n/\\n/g; diff --git a/lib/Tie/File/t/29_downcopy.t b/lib/Tie/File/t/29_downcopy.t index 24f9597..d9c7ecb 100644 --- a/lib/Tie/File/t/29_downcopy.t +++ b/lib/Tie/File/t/29_downcopy.t @@ -1,6 +1,6 @@ #!/usr/bin/perl # -# Unit tests of _twrite function +# Unit tests of _downcopy function # # _downcopy($self, $data, $pos, $len) # Write $data into a block of length $len at position $pos, @@ -235,8 +235,6 @@ try(35272, 6728, 0); # old=x> new 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: $!"; @@ -363,4 +361,3 @@ END { untie @a; 1 while unlink $file; } -