This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Remove stale code from Thread.xs.
[perl5.git] / lib / look.pl
CommitLineData
a687059c
LW
1;# Usage: &look(*FILEHANDLE,$key,$dict,$fold)
2
3;# Sets file position in FILEHANDLE to be first line greater than or equal
4;# (stringwise) to $key. Pass flags for dictionary order and case folding.
5
6sub look {
fe14fcc3 7 local(*FH,$key,$dict,$fold) = @_;
a687059c
LW
8 local($max,$min,$mid,$_);
9 local($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
10 $blksize,$blocks) = stat(FH);
11 $blksize = 8192 unless $blksize;
12 $key =~ s/[^\w\s]//g if $dict;
55497cff 13 $key = lc $key if $fold;
ac58e20f
LW
14 $max = int($size / $blksize);
15 while ($max - $min > 1) {
16 $mid = int(($max + $min) / 2);
17 seek(FH,$mid * $blksize,0);
18 $_ = <FH> if $mid; # probably a partial line
a687059c
LW
19 $_ = <FH>;
20 chop;
21 s/[^\w\s]//g if $dict;
55497cff 22 $_ = lc $_ if $fold;
a687059c
LW
23 if ($_ lt $key) {
24 $min = $mid;
25 }
26 else {
27 $max = $mid;
28 }
29 }
ac58e20f 30 $min *= $blksize;
a687059c 31 seek(FH,$min,0);
ac58e20f 32 <FH> if $min;
a687059c
LW
33 while (<FH>) {
34 chop;
35 s/[^\w\s]//g if $dict;
55497cff 36 $_ = lc $_ if $fold;
a687059c
LW
37 last if $_ ge $key;
38 $min = tell(FH);
39 }
40 seek(FH,$min,0);
41 $min;
42}
43
441;