This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Redo moving Text::ParseWords from lib to ext
[perl5.git] / lib / look.pl
CommitLineData
a687059c 1;# Usage: &look(*FILEHANDLE,$key,$dict,$fold)
a6d71656
GS
2#
3# This library is no longer being maintained, and is included for backward
4# compatibility with Perl 4 programs which may require it.
dae35969
S
5# This legacy library is deprecated and will be removed in a future
6# release of perl.
a6d71656
GS
7#
8# In particular, this should not be used as an example of modern Perl
9# programming techniques.
dae35969
S
10
11warn( "The 'look.pl' legacy library is deprecated and will be"
12 . " removed in the next major release of perl." );
13
a687059c
LW
14;# Sets file position in FILEHANDLE to be first line greater than or equal
15;# (stringwise) to $key. Pass flags for dictionary order and case folding.
16
17sub look {
fe14fcc3 18 local(*FH,$key,$dict,$fold) = @_;
a687059c
LW
19 local($max,$min,$mid,$_);
20 local($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
21 $blksize,$blocks) = stat(FH);
22 $blksize = 8192 unless $blksize;
23 $key =~ s/[^\w\s]//g if $dict;
55497cff 24 $key = lc $key if $fold;
ac58e20f
LW
25 $max = int($size / $blksize);
26 while ($max - $min > 1) {
27 $mid = int(($max + $min) / 2);
28 seek(FH,$mid * $blksize,0);
29 $_ = <FH> if $mid; # probably a partial line
a687059c
LW
30 $_ = <FH>;
31 chop;
32 s/[^\w\s]//g if $dict;
55497cff 33 $_ = lc $_ if $fold;
a687059c
LW
34 if ($_ lt $key) {
35 $min = $mid;
36 }
37 else {
38 $max = $mid;
39 }
40 }
ac58e20f 41 $min *= $blksize;
a687059c 42 seek(FH,$min,0);
ac58e20f 43 <FH> if $min;
a687059c
LW
44 while (<FH>) {
45 chop;
46 s/[^\w\s]//g if $dict;
55497cff 47 $_ = lc $_ if $fold;
a687059c
LW
48 last if $_ ge $key;
49 $min = tell(FH);
50 }
51 seek(FH,$min,0);
52 $min;
53}
54
551;