Commit | Line | Data |
---|---|---|
a0d0e21e LW |
1 | package Search::Dict; |
2 | require 5.000; | |
3 | require Exporter; | |
4 | ||
5 | @ISA = qw(Exporter); | |
6 | @EXPORT = qw(look); | |
7 | ||
5be1dfc7 | 8 | =head1 NAME |
a0d0e21e | 9 | |
5be1dfc7 HF |
10 | Search::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 | ||
19 | Sets 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 | |
21 | occurs. | |
22 | ||
23 | The flags specify dictionary order and case folding: | |
24 | ||
25 | If I<$dict> is true, search by dictionary order (ignore anything but word | |
26 | characters and whitespace). | |
27 | ||
28 | If I<$fold> is true, ignore case. | |
29 | ||
30 | =cut | |
a0d0e21e LW |
31 | |
32 | sub 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 | ||
75 | 1; |