From a0d0e21ea6ea90a22318550944fe6cb09ae10cda Mon Sep 17 00:00:00 2001
From: Larry Wall <lwall@netlabs.com>
Date: Mon, 17 Oct 1994 23:00:00 +0000
Subject: perl 5.000

[editor's note: this commit combines approximate 4 months of furious
releases of Andy Dougherty and Larry Wall - see pod/perlhist.pod for
details.  Andy notes that;

Alas neither my "Irwin AccuTrack" nor my DC 600A quarter-inch cartridge
backup tapes from that era seem to be readable anymore.  I guess 13 years
exceeds the shelf life for that backup technology :-(.
]
---
 lib/Search/Dict.pm | 52 ++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 52 insertions(+)
 create mode 100644 lib/Search/Dict.pm

(limited to 'lib/Search')

diff --git a/lib/Search/Dict.pm b/lib/Search/Dict.pm
new file mode 100644
index 0000000000..10aa4ff583
--- /dev/null
+++ b/lib/Search/Dict.pm
@@ -0,0 +1,52 @@
+package Search::Dict;
+require 5.000;
+require Exporter;
+
+@ISA = qw(Exporter);
+@EXPORT = qw(look);
+
+# Usage: look(*FILEHANDLE,$key,$dict,$fold)
+
+# 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,$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 =~ tr/A-Z/a-z/ if $fold;
+    $max = int($size / $blksize);
+    while ($max - $min > 1) {
+	$mid = int(($max + $min) / 2);
+	seek(FH,$mid * $blksize,0);
+	$_ = <FH> if $mid;		# probably a partial line
+	$_ = <FH>;
+	chop;
+	s/[^\w\s]//g if $dict;
+	tr/A-Z/a-z/ if $fold;
+	if ($_ lt $key) {
+	    $min = $mid;
+	}
+	else {
+	    $max = $mid;
+	}
+    }
+    $min *= $blksize;
+    seek(FH,$min,0);
+    <FH> if $min;
+    while (<FH>) {
+	chop;
+	s/[^\w\s]//g if $dict;
+	y/A-Z/a-z/ if $fold;
+	last if $_ ge $key;
+	$min = tell(FH);
+    }
+    seek(FH,$min,0);
+    $min;
+}
+
+1;
+
-- 
cgit v1.2.1