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) {
}
}
+ 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)
# 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) = @_;
: $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;
=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 ...;
=head1 CONCURRENT ACCESS TO FILES
Caching and deferred writing are inappropriate if you want the same
-file to be accessed simultaneously from more than one process. You
-will want to disable these features. You should do that by including
-the C<memory =E<gt> 0> option in your C<tie> calls; this will inhibit
-caching and deferred writing.
+file to be accessed simultaneously from more than one process. Other
+optimizations performed internally by this module are also
+incompatible with concurrent access. A future version of this module will
+support a C<concurrent =E<gt> 1> option that enables safe concurrent access.
-You will also want to lock the file while reading or writing it. You
-can use the C<-E<gt>flock> method for this. A future version of this
-module may provide an 'autolocking' mode.
+Previous versions of this documentation suggested using C<memory
+=E<gt> 0> for safe concurrent access. This was mistaken. Tie::File
+will not support safe concurrent access before version 0.98.
=head1 CAVEATS
=head1 LICENSE
-C<Tie::File> version 0.96 is copyright (C) 2002 Mark Jason Dominus.
+C<Tie::File> version 0.97 is copyright (C) 2003 Mark Jason Dominus.
This library is free software; you may redistribute it and/or modify
it under the same terms as Perl itself.
=head1 WARRANTY
-C<Tie::File> version 0.96 comes with ABSOLUTELY NO WARRANTY.
+C<Tie::File> version 0.97 comes with ABSOLUTELY NO WARRANTY.
For details, see the license.
=head1 THANKS
}
}
-# 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;
#!/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,
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: $!";
untie @a;
1 while unlink $file;
}
-
projects / platform / upstream / perl.git / commitdiff