Change 15026 by jhi@alpha on 2002/03/04 23:42:28
Upgrade to Tie::File 0.17 from mjd.
Affected files ...
.... //depot/perl/lib/Tie/File.pm#6 edit
.... //depot/perl/lib/Tie/File/t/05_size.t#2 edit
.... //depot/perl/lib/Tie/File/t/16_handle.t#3 edit
.... //depot/perl/lib/Tie/File/t/17_misc_meth.t#2 edit
Differences ...
==== //depot/perl/lib/Tie/File.pm#6 (text) ====
Index: perl/lib/Tie/File.pm
--- perl/lib/Tie/File.pm.~1~ Mon Mar 4 16:45:05 2002
+++ perl/lib/Tie/File.pm Mon Mar 4 16:45:05 2002
@@ -5,7 +5,7 @@
use Fcntl 'O_CREAT', 'O_RDWR', 'LOCK_EX';
require 5.005;
-$VERSION = "0.16";
+$VERSION = "0.17";
# Idea: The object will always contain an array of byte offsets
# this will be filled in as is necessary and convenient.
@@ -153,9 +153,9 @@
# file gets shorter
$self->_seek($len);
$self->_chop_file;
- $#{$self->{offsets}} = $len-1;
- my @cached = grep $_ > $len, keys %{$self->{cache}};
- delete @{$self->{cache}}{@cached} if @cached;
+ $#{$self->{offsets}} = $len;
+ my @cached = grep $_ >= $len, keys %{$self->{cache}};
+ $self->_uncache(@cached);
}
sub PUSH {
@@ -208,8 +208,7 @@
$self->_seek($n);
$self->_chop_file;
$#{$self->{offsets}}--;
- delete $self->{cached}{$n};
- @{$self->{lru}} = grep $_ != $n, @{$self->{lru}};
+ $self->_uncache($n);
# perhaps in this case I should also remove trailing null records?
} else {
$self->STORE($n, "");
@@ -302,8 +301,7 @@
$self->{cached} += length($new) - length($cached);
$self->{cache}{$_} = $new;
} else {
- delete $self->{cache}{$_};
- $self->{cached} -= length($cached);
+ $self->_uncache($_);
}
}
# update the read cache, part 2
@@ -471,6 +469,16 @@
$self->_cache_flush if $self->{cached} > $self->{cachesize};
}
+sub _uncache {
+ my $self = shift;
+ for my $n (@_) {
+ my $cached = delete $self->{cache}{$n};
+ next unless defined $cached;
+ @{$self->{lru}} = grep $_ != $n, @{$self->{lru}};
+ $self->{cached} -= length($cached);
+ }
+}
+
sub _check_cache {
my ($self, $n) = @_;
my $rec;
@@ -549,7 +557,12 @@
my ($self, $file, $warn) = @_;
my $good = 1;
- unless ($self->{offsets}[0] == 0) {
+
+ if (not defined $self->{offsets}[0]) {
+ $warn && print STDERR "# offset 0 is missing!\n";
+ $good = 0;
+ } elsif ($self->{offsets}[0] != 0) {
+ $warn && print STDERR "# offset 0 is missing!\n";
$warn && print STDERR "# rec 0: offset <$self->{offsets}[0]> s/b 0!\n";
$good = 0;
}
@@ -605,7 +618,7 @@
}
for (keys %{$self->{cache}}) {
unless (exists $seen{$_}) {
- print "# $record $_ is in the cache but not the LRU queue\n";
+ print "# record $_ is in the cache but not the LRU queue\n";
$good = 0;
}
}
@@ -621,7 +634,7 @@
=head1 SYNOPSIS
- # This file documents Tie::File version 0.16
+ # This file documents Tie::File version 0.17
tie @array, 'Tie::File', filename or die ...;
@@ -801,7 +814,8 @@
opened read-only will work as long as you don't try to write to them.
Handles must be attached to seekable sources of data---that means no
pipes or sockets. If you try to supply a non-seekable handle, the
-C<tie> call will abort your program.
+C<tie> call will try to abort your program. This feature is not yet
+supported under VMS.
=head1 CAVEATS
@@ -825,9 +839,9 @@
through 999,999, and so on. The relocation is done using block
writes, however, so it's not as slow as it might be.
-A future version of this module will provide a mechanism for getting
-better performance in such cases, by deferring the writing until it
-can be done all at once.
+A soon-to-be-released version of this module will provide a mechanism
+for getting better performance in such cases, by deferring the writing
+until it can be done all at once.
=head2 Efficiency Note 2
@@ -876,7 +890,7 @@
=head1 LICENSE
-C<Tie::File> version 0.16 is copyright (C) 2002 Mark Jason Dominus.
+C<Tie::File> version 0.17 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.
@@ -904,7 +918,7 @@
=head1 WARRANTY
-C<Tie::File> version 0.16 comes with ABSOLUTELY NO WARRANTY.
+C<Tie::File> version 0.17 comes with ABSOLUTELY NO WARRANTY.
For details, see the license.
=head1 THANKS
@@ -920,6 +934,7 @@
More thanks to:
Gerrit Haase /
+Nick Ing-Simmons /
Tassilo von Parseval /
H. Dieter Pearcey /
Peter Somu /
==== //depot/perl/lib/Tie/File/t/05_size.t#2 (text) ====
Index: perl/lib/Tie/File/t/05_size.t
--- perl/lib/Tie/File/t/05_size.t.~1~ Mon Mar 4 16:45:05 2002
+++ perl/lib/Tie/File/t/05_size.t Mon Mar 4 16:45:05 2002
@@ -10,7 +10,7 @@
my $data = "rec0$/rec1$/rec2$/";
my ($o, $n);
-print "1..10\n";
+print "1..15\n";
my $N = 1;
use Tie::File;
@@ -44,26 +44,39 @@
$N++;
# STORESIZE
-# 6 Make it longer:
+# (6-7) Make it longer:
+populate();
$#a = 4;
check_contents("$data$/$/");
-# 7 Make it longer again:
+# (8-9) Make it longer again:
+populate();
$#a = 6;
check_contents("$data$/$/$/$/");
-# 8 Make it shorter:
+# (10-11) Make it shorter:
+populate();
$#a = 4;
check_contents("$data$/$/");
-# 9 Make it shorter again:
+# (12-13) Make it shorter again:
+populate();
$#a = 2;
check_contents($data);
-# 10 Get rid of it completely:
+# (14-15) Get rid of it completely:
+populate();
$#a = -1;
check_contents('');
+# In the past, there was a bug in STORESIZE that it didn't correctly
+# remove deleted records from the the cache. This wasn't detected
+# because these tests were all done with an empty cache. populate()
+# will ensure that the cache is fully populated.
+sub populate {
+ my $z;
+ $z = $a[$_] for 0 .. $#a;
+}
sub check_contents {
my $x = shift;
@@ -79,6 +92,9 @@
print "not ok $N\n# expected <$x>, got <$a>\n";
}
$N++;
+ my $integrity = $o->_check_integrity($file, $ENV{INTEGRITY});
+ print $integrity ? "ok $N\n" : "not ok $N \# integrity\n";
+ $N++;
}
==== //depot/perl/lib/Tie/File/t/16_handle.t#3 (text) ====
Index: perl/lib/Tie/File/t/16_handle.t
--- perl/lib/Tie/File/t/16_handle.t.~1~ Mon Mar 4 16:45:05 2002
+++ perl/lib/Tie/File/t/16_handle.t Mon Mar 4 16:45:05 2002
@@ -5,6 +5,11 @@
my $file = "tf$$.txt";
+if ($^O =~ /vms/i) {
+ print "1..0\n";
+ exit;
+}
+
print "1..39\n";
my $N = 1;
==== //depot/perl/lib/Tie/File/t/17_misc_meth.t#2 (text) ====
Index: perl/lib/Tie/File/t/17_misc_meth.t
--- perl/lib/Tie/File/t/17_misc_meth.t.~1~ Mon Mar 4 16:45:05 2002
+++ perl/lib/Tie/File/t/17_misc_meth.t Mon Mar 4 16:45:05 2002
@@ -4,7 +4,6 @@
# EXTEND, CLEAR, DELETE, EXISTS
#
-use lib '/home/mjd/src/perl/Tie-File2/lib';
my $file = "tf$$.txt";
1 while unlink $file;
End of Patch.
