lisch@mentor.com (Ray Lischner) (11/13/90)
Here is a simple package to help do table lookups, permitting
non-ambiguous abbreviations. For example:
foreach $day (('Sunday', 'Monday', 'Tuesday', 'Wednesday', 'Thursday',
'Friday', 'Saturday'))
{
$days{$day} = ++$nday;
}
...
require 'lookup.pl';
do {
local($d);
chop($d = <STDIN>);
$daynum = &lookup'lookupi($d, *days);
} while (! $daynum);
# the full day name is in $lookup'found
...
Anyway, here it is:
#!/bin/sh
# This is a shell archive (shar 3.47)
# made 11/13/1990 01:29 UTC by lisch@mntgfx.UUCP
#
# existing files will NOT be overwritten unless -c is specified
#
# This shar contains:
# length mode name
# ------ ---------- ------------------------------------------
# 2300 -r--r--r-- lookup.pl
#
# ============= lookup.pl ==============
if test -f 'lookup.pl' -a X"$1" != X"-c"; then
echo 'x - skipping lookup.pl (File already exists)'
else
echo 'x - extracting lookup.pl (Text)'
sed 's/^X//' << 'SHAR_EOF' > 'lookup.pl' &&
# $Header: //lisch/local_user/lisch/sca/a_s/RCS/lookup.pl,v 1.2 90/11/12 17:20:19 lisch Exp $
#
# Lookup a word in an associative array and return the value.
# Abbreviations are allowed. If a word is unknown or ambiguous,
# print a message and return "undef". If a word is found, save
# the full key in $found.
#
# &lookup uses the word, as is
# &lookupi uses a case-insensitive comparison.
#
# The user can redefine the subroutines used for error messages:
# &unknown($word) is called for an unknown word
# &ambiguous($word, $list) is called for an ambiguous word; @ambig is a list of
# potential matches
#
# $Log: lookup.pl,v $
# Revision 1.2 90/11/12 17:20:19 lisch
# added lookupi, error message handlers
#
# Revision 1.1 90/11/09 16:40:48 lisch
# Initial revision
#
X
package lookup;
X
$found = ''; # actual key found
@ambig = (); # ambiguous matches
X
sub unknown
{
X print "$0: unknown word: ", @_, "\n";
}
X
sub ambiguous
{
X local($word) = shift(@_);
X print "$0: ambiguous word: ", $word, ", for: ", join(', ', @_), "\n";
}
X
sub lookup
{
X local($word, *array) = @_;
X @ambig = ();
X if (defined $array{$word}) {
X $found = $word;
X $array{$word};
X } else {
X local($key, $ambig);
X $found = undef;
X
X eval <<EOF;
X foreach \$key (keys %array)
X {
X next if \$key !~ /^$word/;
X if (\$#ambig >= \$[) {
X push(\@ambig, \$key);
X } elsif (\$found) {
X push(\@ambig, \$found);
X push(\@ambig, \$key);
X } else {
X \$found = \$key;
X }
X }
EOF
X
X if (! $found) {
X &unknown($word);
X undef;
X } elsif ($#ambig >= $[) {
X &ambiguous($word, @ambig);
X $found = undef;
X } else {
X $array{$found};
X }
X }
}
X
sub lookupi
{
X local($word, *array) = @_;
X @ambig = ();
X if (defined $array{$word}) {
X $found = $word;
X $array{$word};
X } else {
X local($key, $ambig);
X $found = undef;
X
X eval <<EOF;
X foreach \$key (keys %array)
X {
X next if \$key !~ /^$word/i;
X if (\$#ambig >= \$[) {
X push(\@ambig, \$key);
X } elsif (\$found) {
X push(\@ambig, \$found);
X push(\@ambig, \$key);
X } else {
X \$found = \$key;
X }
X }
EOF
X
X if (! $found) {
X &unknown($word);
X undef;
X } elsif ($#ambig >= $[) {
X &ambiguous($word, @ambig);
X $found = undef;
X } else {
X $array{$found};
X }
X }
}
X
1;
SHAR_EOF
chmod 0444 lookup.pl ||
echo 'restore of lookup.pl failed'
Wc_c="`wc -c < 'lookup.pl'`"
test 2300 -eq "$Wc_c" ||
echo 'lookup.pl: original size 2300, current size' "$Wc_c"
fi
exit 0
--
Ray Lischner UUCP: {uunet,apollo,decwrl}!mntgfx!lisch