lib/look.pl

   1 ;# Usage: &look(*FILEHANDLE,$key,$dict,$fold)
   2 #
   3 # This library is no longer being maintained, and is included for backward
   4 # compatibility with Perl 4 programs which may require it.
   5 # This legacy library is deprecated and will be removed in a future
   6 # release of perl.
   7 #
   8 # In particular, this should not be used as an example of modern Perl
   9 # programming techniques.
  10
  11 ;# Sets file position in FILEHANDLE to be first line greater than or equal
  12 ;# (stringwise) to $key.  Pass flags for dictionary order and case folding.
  13
  14 sub look {
  15     local(*FH,$key,$dict,$fold) = @_;
  16     local($max,$min,$mid,$_);
  17     local($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
  18        $blksize,$blocks) = stat(FH);
  19     $blksize = 8192 unless $blksize;
  20     $key =~ s/[^\w\s]//g if $dict;
  21     $key = lc $key if $fold;
  22     $max = int($size / $blksize);
  23     while ($max - $min > 1) {
  24         $mid = int(($max + $min) / 2);
  25         seek(FH,$mid * $blksize,0);
  26         $_ = <FH> if $mid;              # probably a partial line
  27         $_ = <FH>;
  28         chop;
  29         s/[^\w\s]//g if $dict;
  30         $_ = lc $_ if $fold;
  31         if ($_ lt $key) {
  32             $min = $mid;
  33         }
  34         else {
  35             $max = $mid;
  36         }
  37     }
  38     $min *= $blksize;
  39     seek(FH,$min,0);
  40     <FH> if $min;
  41     while (<FH>) {
  42         chop;
  43         s/[^\w\s]//g if $dict;
  44         $_ = lc $_ if $fold;
  45         last if $_ ge $key;
  46         $min = tell(FH);
  47     }
  48     seek(FH,$min,0);
  49     $min;
  50 }
  51
  52 1;