lib/Search/Dict.pm

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