X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FTie%2FFile.pm;h=dfd86cd1de67464b2cb1d07b8aa742240485b016;hb=cf0d1c66a0d97cdcc6938d91401fa36b9b5a67ac;hp=26014dddc85ab0f510c25b7afcd6c23190485a19;hpb=07275143b4e1e59494d5cc98fdc4e0f06235b0e9;p=p5sagit%2Fp5-mst-13.2.git diff --git a/lib/Tie/File.pm b/lib/Tie/File.pm index 26014dd..dfd86cd 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.95"; +$VERSION = "0.97_01"; 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) @@ -89,12 +93,17 @@ sub TIEARRAY { unless (seek $file, 1, SEEK_SET) { croak "$pack: your filehandle does not appear to be seekable"; } - seek $file, 0, SEEK_SET # put it back + seek $file, 0, SEEK_SET; # put it back $fh = $file; # setting binmode is the user's problem } elsif (ref $file) { croak "usage: tie \@array, $pack, filename, [option => value]..."; } else { - $fh = \do { local *FH }; # only works in 5.005 and later + # $fh = \do { local *FH }; # XXX this is buggy + if ($] < 5.006) { + # perl 5.005 and earlier don't autovivify filehandles + require Symbol; + $fh = Symbol::gensym(); + } sysopen $fh, $file, $opts{mode}, 0666 or return; binmode $fh; ++$opts{ourfh}; @@ -647,7 +656,7 @@ sub _mtwrite { if (@_) { $unwritten = $self->_downcopy($data, $end, $_[1] - $end); } else { - # Make the file longer to accomodate the last segment that doesn' + # Make the file longer to accommodate the last segment that doesn' $unwritten = $self->_downcopy($data, $end); } } @@ -692,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) = @_; @@ -702,11 +713,21 @@ 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); + last if $last_read_was_short && $data eq ""; $len -= $readsize if defined $len; $pos += $readsize; } @@ -896,8 +917,7 @@ sub _read_record { $rec = <$fh>; } return unless defined $rec; - if (! $self->{sawlastrec} && - substr($rec, -$self->{recseplen}) ne $self->{recsep}) { + if (substr($rec, -$self->{recseplen}) ne $self->{recsep}) { # improperly terminated final record --- quietly fix it. # my $ac = substr($rec, -$self->{recseplen}); # $ac =~ s/\n/\\n/g; @@ -1989,7 +2009,7 @@ Tie::File - Access the lines of a disk file via a Perl array =head1 SYNOPSIS - # This file documents Tie::File version 0.95 + # This file documents Tie::File version 0.97 use Tie::File; tie @array, 'Tie::File', filename or die ...; @@ -2407,14 +2427,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 @@ -2512,7 +2532,7 @@ any news of importance, will be available at =head1 LICENSE -C version 0.95 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. @@ -2540,7 +2560,7 @@ For licensing inquiries, contact the author at: =head1 WARRANTY -C version 0.95 comes with ABSOLUTELY NO WARRANTY. +C version 0.97 comes with ABSOLUTELY NO WARRANTY. For details, see the license. =head1 THANKS @@ -2562,7 +2582,9 @@ optimizations. Additional thanks to: Edward Avis / Mattia Barbon / +Tom Christiansen / Gerrit Haase / +Gurusamy Sarathy / Jarkko Hietaniemi (again) / Nikola Knezevic / John Kominetz /