#! /usr/bin/perl
###############################################################################
#
# File: th
# RCS: $Header: $
# Description: A program to access the thesaurus database.
# Author: Darryl Okahata
# Created: Tue Dec 17 15:26:46 1991
# Modified: Wed Dec 18 16:46:52 1991 (Darryl Okahata) darrylo@hpsrdmo
# Language: Perl
# Package: N/A
#
###############################################################################
##
## *******************************************************
## ***** THIS IS AN ALPHA TEST VERSION (Version 0.1) *****
## *******************************************************
##
## th -- A program to access the thesaurus database.
## Copyright (C) 1991 Darryl Okahata (
[email protected])
##
## This program is free software; you can redistribute it and/or modify
## it under the terms of the GNU General Public License as published by
## the Free Software Foundation; either version 1, or (at your option)
## any later version.
##
## This program is distributed in the hope that it will be useful,
## but WITHOUT ANY WARRANTY; without even the implied warranty of
## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
## GNU General Public License for more details.
##
## You should have received a copy of the GNU General Public License
## along with this program; if not, write to the Free Software
## Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
##
###############################################################################
##
## Usage:
##
## th <word> [<word> ...]
## Search the thesaurus for all entries that begin with
## "<word>".
##
## th -V <word> [<word> ...]
## Search the thesaurus for all entries that begin with
## "<word>". All displayed entries are separated by a line
## of dashes.
##
## th -W <word> [<word> ...]
## Search the thesaurus for the entry that contains
## "<word>" exactly.
##
## th -w <word> [<word> ...]
## Display all words in the thesaurus that begin with
## "<word>".
##
## th -w -v <word> [<word> ...]
## Display all words in the thesaurus that begin with
## "<word>". Alongside each word, the numbers of the
## entries that contain the word are displayed.
##
## th -n <number>
## Display thesaurus entry number "<number>". Unlike a
## word, only one number can be specified.
##
##
###############################################################################
$thesaurus_dir = "/obi/Roget";
###############################################################################
$thesaurus = "$thesaurus_dir/roget.txt";
$index_file = "$thesaurus_dir/offsets";
$word_index = "$thesaurus_dir/word-index";
###############################################################################
require "pwd.pl";
require 'look.pl';
require 'getopts.pl';
&initpwd;
&Getopts('wWn:vV');
###############################################################################
open (INPUT, "<$thesaurus") || die "Can't open \"$thesaurus\": $!\n";
open (WORDS, "<$word_index") || die "Can't open \"$word_index\": $!\n";
dbmopen(%indices, "$index_file", undef) ||
die "Can't open \"$thesaurus\": $!\n";
if ($opt_n) {
&lookup($opt_n);
exit (0);
}
foreach $word (@ARGV) {
&look(*WORDS, $word, 0, 1);
while (<WORDS>) {
if ($opt_W) {
last if (!/^$word\b/i);
} else {
last if (!/^$word/i);
}
next if (!/^(.+):(.+)$/);
$real_word = $1;
$numbers = $2;
if ($opt_w) {
if ($opt_v) {
print "$_";
} else {
print "$real_word\n";
}
} else {
@entries = ();
foreach $num (split(/[ \t]+/, $numbers)) {
next if (!$num);
for ($i = 0; $i < $#entries; ++$i) {
last if ($entries[$i] == $num);
}
if ($i >= $#entries) {
push(@entries, $num);
}
}
if (@entries) {
if ($opt_V) {
print "-------------------------------------------------------------------------------\n";
}
print "***** Word: $real_word\n\n";
foreach $num (sort bynumber @entries) {
&lookup($num);
}
}
}
}
}
dbmclose(%indices) || die "$!";
exit (0);
###############################################################################
sub lookup
{
local($entry) = @_;
local($location);
$location = $indices{$entry};
seek(INPUT, $location, 0) || die "$!";
while (<INPUT>) {
print $_;
last if (/^[ \t]*$/);
}
}
sub bynumber
{
$a <=> $b;
}
#
# Local Variables:
# mode: perl
# perl-indent-level: 4
# perl-continued-statement-offset: 4
# perl-continued-brace-offset: 0
# perl-brace-offset: -4
# perl-brace-imaginary-offset: 0
# perl-label-offset: -4
# End:
#