lib/Search/Dict.pm

   1 package Search::Dict;
   2 require 5.000;
   3 require Exporter;
   4
   5 @ISA = qw(Exporter);
   6 @EXPORT = qw(look);
   7
   8 =head1 NAME
   9
  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
  31
  32 sub look {
  33     local(*FH,$key,$dict,$fold) = @_;
  34     local($_);
  35     my(@stat) = stat(FH)
  36         or return -1;
  37     my($size, $blksize) = @stat[7,11];
  38     $blksize ||= 8192;
  39     $key =~ s/[^\w\s]//g if $dict;
  40     $key =~ tr/A-Z/a-z/ if $fold;
  41     my($min, $max, $mid) = (0, int($size / $blksize));
  42     while ($max - $min > 1) {
  43         $mid = int(($max + $min) / 2);
  44         seek(FH, $mid * $blksize, 0)
  45             or return -1;
  46         <FH> if $mid;                   # probably a partial line
  47         $_ = <FH>;
  48         chop;
  49         s/[^\w\s]//g if $dict;
  50         tr/A-Z/a-z/ if $fold;
  51         if (defined($_) && $_ lt $key) {
  52             $min = $mid;
  53         }
  54         else {
  55             $max = $mid;
  56         }
  57     }
  58     $min *= $blksize;
  59     seek(FH,$min,0)
  60         or return -1;
  61     <FH> if $min;
  62     for (;;) {
  63         $min = tell(FH);
  64         $_ = <FH>
  65             or last;
  66         chop;
  67         s/[^\w\s]//g if $dict;
  68         y/A-Z/a-z/ if $fold;
  69         last if $_ ge $key;
  70     }
  71     seek(FH,$min,0);
  72     $min;
  73 }
  74
  75 1;