diff options
author | Karl Berry <karl@freefriends.org> | 2014-04-23 21:46:20 +0000 |
---|---|---|
committer | Karl Berry <karl@freefriends.org> | 2014-04-23 21:46:20 +0000 |
commit | 300c1eb6d37d46078d448d6d58938d5a80cd68ff (patch) | |
tree | 23a0a8b9f8f5460b405119c4d3c163d2d488ca5e /Master/tlpkg/tlperl/lib/Search/Dict.pm | |
parent | ed55d86b7c5e18f6eccce80a1fb1423ca40a23b5 (diff) |
(tl)perl 5.18.2 for windows from siep
git-svn-id: svn://tug.org/texlive/trunk@33648 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Master/tlpkg/tlperl/lib/Search/Dict.pm')
-rw-r--r-- | Master/tlpkg/tlperl/lib/Search/Dict.pm | 32 |
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); |