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