X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2Flook.pl;h=ccc9b6162ae0f8885f316b854f48c2fdc4c3bd54;hb=e323741737633027a4605d074649eee3af027cf2;hp=ebbaa73a3d61d613becdd7426fa1c6d713b87413;hpb=a687059cbaf2c6fdccb5e0fae2aee80ec15625a8;p=p5sagit%2Fp5-mst-13.2.git diff --git a/lib/look.pl b/lib/look.pl index ebbaa73..ccc9b61 100644 --- a/lib/look.pl +++ b/lib/look.pl @@ -1,27 +1,31 @@ ;# Usage: &look(*FILEHANDLE,$key,$dict,$fold) - +# +# This library is no longer being maintained, and is included for backward +# compatibility with Perl 4 programs which may require it. +# +# In particular, this should not be used as an example of modern Perl +# programming techniques. +# ;# Sets file position in FILEHANDLE to be first line greater than or equal ;# (stringwise) to $key. Pass flags for dictionary order and case folding. sub look { - local(*FH,$key,$fold) = @_; + local(*FH,$key,$dict,$fold) = @_; local($max,$min,$mid,$_); local($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime, $blksize,$blocks) = stat(FH); $blksize = 8192 unless $blksize; $key =~ s/[^\w\s]//g if $dict; - $key =~ y/A-Z/a-z/ if $fold; - $max = $size + $blksize - 1; - $max -= $size % $blksize; - while ($max - $min > $blksize) { - $mid = ($max + $min) / 2; - die "look: internal error" if $mid % $blksize; - seek(FH,$mid,0); - $_ = ; # probably a partial line + $key = lc $key if $fold; + $max = int($size / $blksize); + while ($max - $min > 1) { + $mid = int(($max + $min) / 2); + seek(FH,$mid * $blksize,0); + $_ = if $mid; # probably a partial line $_ = ; chop; s/[^\w\s]//g if $dict; - y/A-Z/a-z/ if $fold; + $_ = lc $_ if $fold; if ($_ lt $key) { $min = $mid; } @@ -29,11 +33,13 @@ sub look { $max = $mid; } } + $min *= $blksize; seek(FH,$min,0); + if $min; while () { chop; s/[^\w\s]//g if $dict; - y/A-Z/a-z/ if $fold; + $_ = lc $_ if $fold; last if $_ ge $key; $min = tell(FH); }