summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl/lib/Search/Dict.pm
diff options
context:
space:
mode:
Diffstat (limited to 'Master/tlpkg/tlperl/lib/Search/Dict.pm')
-rw-r--r--Master/tlpkg/tlperl/lib/Search/Dict.pm32
1 files changed, 26 insertions, 6 deletions
diff --git a/Master/tlpkg/tlperl/lib/Search/Dict.pm b/Master/tlpkg/tlperl/lib/Search/Dict.pm
index 5fe6f73b041..f34d2220e5e 100644
--- a/Master/tlpkg/tlperl/lib/Search/Dict.pm
+++ b/Master/tlpkg/tlperl/lib/Search/Dict.pm
@@ -2,9 +2,18 @@ package Search::Dict;
require 5.000;
require Exporter;
+my $fc_available;
+BEGIN {
+ $fc_available = '5.015008';
+ if ( $] ge $fc_available ) {
+ require feature;
+ 'feature'->import('fc'); # string avoids warning on old Perls <sigh>
+ }
+}
+
use strict;
-our $VERSION = '1.04';
+our $VERSION = '1.07';
our @ISA = qw(Exporter);
our @EXPORT = qw(look);
@@ -60,12 +69,19 @@ sub look {
}
$comp = sub { $_[0] cmp $_[1] } unless defined $comp;
local($_);
- my(@stat) = stat($fh)
- or return -1;
+ my $fno = fileno $fh;
+ my @stat;
+ if ( defined $fno && $fno >= 0 && ! tied *{$fh} ) { # real, open file
+ @stat = eval { stat($fh) }; # in case fileno lies
+ }
my($size, $blksize) = @stat[7,11];
+ $size = do { seek($fh,0,2); my $s = tell($fh); seek($fh,0,0); $s }
+ unless defined $size;
$blksize ||= 8192;
$key =~ s/[^\w\s]//g if $dict;
- $key = lc $key if $fold;
+ if ( $fold ) {
+ $key = $] ge $fc_available ? fc($key) : lc($key);
+ }
# find the right block
my($min, $max) = (0, int($size / $blksize));
my $mid;
@@ -78,7 +94,9 @@ sub look {
$_ = $xfrm->($_) if defined $xfrm;
chomp;
s/[^\w\s]//g if $dict;
- $_ = lc $_ if $fold;
+ if ( $fold ) {
+ $_ = $] ge $fc_available ? fc($_) : lc($_);
+ }
if (defined($_) && $comp->($_, $key) < 0) {
$min = $mid;
}
@@ -98,7 +116,9 @@ sub look {
$_ = $xfrm->($_) if defined $xfrm;
chomp;
s/[^\w\s]//g if $dict;
- $_ = lc $_ if $fold;
+ if ( $fold ) {
+ $_ = $] ge $fc_available ? fc($_) : lc($_);
+ }
last if $comp->($_, $key) >= 0;
}
seek($fh,$min,0);