This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
default warnLevel and dieLevel to 0 in debugger (from Tom
[perl5.git] / lib / Search / Dict.pm
CommitLineData
a0d0e21e
LW
1package Search::Dict;
2require 5.000;
3require Exporter;
4
5@ISA = qw(Exporter);
6@EXPORT = qw(look);
7
5be1dfc7 8=head1 NAME
a0d0e21e 9
5be1dfc7
HF
10Search::Dict, look - search for key in dictionary file
11
12=head1 SYNOPSIS
13
14 use Search::Dict;
15 look *FILEHANDLE, $key, $dict, $fold;
16
17=head1 DESCRIPTION
18
19Sets file position in FILEHANDLE to be first line greater than or equal
20(stringwise) to I<$key>. Returns the new file position, or -1 if an error
21occurs.
22
23The flags specify dictionary order and case folding:
24
25If I<$dict> is true, search by dictionary order (ignore anything but word
26characters and whitespace).
27
28If I<$fold> is true, ignore case.
29
30=cut
a0d0e21e
LW
31
32sub look {
33 local(*FH,$key,$dict,$fold) = @_;
5be1dfc7
HF
34 local($_);
35 my(@stat) = stat(FH)
36 or return -1;
37 my($size, $blksize) = @stat[7,11];
38 $blksize ||= 8192;
a0d0e21e 39 $key =~ s/[^\w\s]//g if $dict;
df76f08a 40 $key = lc $key if $fold;
5be1dfc7 41 my($min, $max, $mid) = (0, int($size / $blksize));
a0d0e21e
LW
42 while ($max - $min > 1) {
43 $mid = int(($max + $min) / 2);
5be1dfc7
HF
44 seek(FH, $mid * $blksize, 0)
45 or return -1;
46 <FH> if $mid; # probably a partial line
a0d0e21e
LW
47 $_ = <FH>;
48 chop;
49 s/[^\w\s]//g if $dict;
df76f08a 50 $_ = lc $_ if $fold;
5be1dfc7 51 if (defined($_) && $_ lt $key) {
a0d0e21e
LW
52 $min = $mid;
53 }
54 else {
55 $max = $mid;
56 }
57 }
58 $min *= $blksize;
5be1dfc7
HF
59 seek(FH,$min,0)
60 or return -1;
a0d0e21e 61 <FH> if $min;
5be1dfc7
HF
62 for (;;) {
63 $min = tell(FH);
40da2db3 64 defined($_ = <FH>)
5be1dfc7 65 or last;
a0d0e21e
LW
66 chop;
67 s/[^\w\s]//g if $dict;
df76f08a 68 $_ = lc $_ if $fold;
a0d0e21e 69 last if $_ ge $key;
a0d0e21e
LW
70 }
71 seek(FH,$min,0);
72 $min;
73}
74
751;