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 warn( "The 'look.pl' legacy library is deprecated and will be"
  12       . " removed in the next major release of perl." );
  13
  14 ;# Sets file position in FILEHANDLE to be first line greater than or equal
  15 ;# (stringwise) to $key.  Pass flags for dictionary order and case folding.
  16
  17 sub look {
  18     local(*FH,$key,$dict,$fold) = @_;
  19     local($max,$min,$mid,$_);
  20     local($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
  21        $blksize,$blocks) = stat(FH);
  22     $blksize = 8192 unless $blksize;
  23     $key =~ s/[^\w\s]//g if $dict;
  24     $key = lc $key if $fold;
  25     $max = int($size / $blksize);
  26     while ($max - $min > 1) {
  27         $mid = int(($max + $min) / 2);
  28         seek(FH,$mid * $blksize,0);
  29         $_ = <FH> if $mid;              # probably a partial line
  30         $_ = <FH>;
  31         chop;
  32         s/[^\w\s]//g if $dict;
  33         $_ = lc $_ if $fold;
  34         if ($_ lt $key) {
  35             $min = $mid;
  36         }
  37         else {
  38             $max = $mid;
  39         }
  40     }
  41     $min *= $blksize;
  42     seek(FH,$min,0);
  43     <FH> if $min;
  44     while (<FH>) {
  45         chop;
  46         s/[^\w\s]//g if $dict;
  47         $_ = lc $_ if $fold;
  48         last if $_ ge $key;
  49         $min = tell(FH);
  50     }
  51     seek(FH,$min,0);
  52     $min;
  53 }
  54
  55 1;