home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / perl_mlb.zip / look.pl < prev    next >
Text File  |  1997-11-25  |  1KB  |  45 lines
  1. ;# Usage: &look(*FILEHANDLE,$key,$dict,$fold)
  2.  
  3. ;# Sets file position in FILEHANDLE to be first line greater than or equal
  4. ;# (stringwise) to $key.  Pass flags for dictionary order and case folding.
  5.  
  6. sub look {
  7.     local(*FH,$key,$dict,$fold) = @_;
  8.     local($max,$min,$mid,$_);
  9.     local($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
  10.        $blksize,$blocks) = stat(FH);
  11.     $blksize = 8192 unless $blksize;
  12.     $key =~ s/[^\w\s]//g if $dict;
  13.     $key = lc $key if $fold;
  14.     $max = int($size / $blksize);
  15.     while ($max - $min > 1) {
  16.     $mid = int(($max + $min) / 2);
  17.     seek(FH,$mid * $blksize,0);
  18.     $_ = <FH> if $mid;        # probably a partial line
  19.     $_ = <FH>;
  20.     chop;
  21.     s/[^\w\s]//g if $dict;
  22.     $_ = lc $_ if $fold;
  23.     if ($_ lt $key) {
  24.         $min = $mid;
  25.     }
  26.     else {
  27.         $max = $mid;
  28.     }
  29.     }
  30.     $min *= $blksize;
  31.     seek(FH,$min,0);
  32.     <FH> if $min;
  33.     while (<FH>) {
  34.     chop;
  35.     s/[^\w\s]//g if $dict;
  36.     $_ = lc $_ if $fold;
  37.     last if $_ ge $key;
  38.     $min = tell(FH);
  39.     }
  40.     seek(FH,$min,0);
  41.     $min;
  42. }
  43.  
  44. 1;
  45.