#!/usr/athena/bin/perl
###############################################################################
#
# File:		munge1
# RCS:		$Header: $
# Description:
# Author:	Darryl Okahata
# Created:	Tue Dec 17 15:26:46 1991
# Modified:     Wed Dec 18 16:48:02 1991 (Darryl Okahata) darrylo@hpsrdmo
# Language:	Perl
# Package:	N/A
#
###############################################################################

$thesaurus = "roget.txt";

###############################################################################

open (INPUT, "<$thesaurus") || die "Can't open \"$thesaurus\": $!\n";

$current_index = 0;
$phase = 0;
while (<INPUT>) {
    chop;
    if ($phase == 0) {
	if (/^[ \t]*\#([0-9]+)\.[ \t]*(.*)$/oi) {
	    $current_index = $1;
	    $end = $2;
	    $phase = 1;
	    $line = $end;
	}
    } elsif ($phase == 1) {
	if (/^[ \t]*$/) {
	    &do_line($line, $current_index);
	    $line = '';
	    $phase = 0;
	} elsif (/^[ \t]+/) {
	    &do_line($line, $current_index);
	    $line = $_;
	} else {
	    $line = "$line $_";
	}
    }
}

exit (0);

###############################################################################

sub do_line
{
    local($line, $current_index) = @_;
    local($w);

    if ($line =~ /^[ \t]*Phr\./) {
	return;
    }
    if ($line =~ /^[ \t]*Int\./) {
	return;
    }
    if ($line =~ /^[ \t]*[NV]\.[ \t]*/) {
	s/^[ \t]*[NV]\.[ \t]*//;
    }
    if ($line =~ /^[ \t]*Ad[vj]\.[ \t]*/) {
	s/^[ \t]*Ad[vj]\.[ \t]*//;
    }
    while ($line =~ s/"[^\"]*"[ \t]*(\[[^\]\[]+\])?//) {
    }
    foreach $w (split(/[|!\n,;]+/, $line)) {
	if ($w) {
	    &enter_word($w, $current_index);
	}
    }
}

sub enter_word
{
    local($w, $index) = @_;

    $w =~ y/A-Z/a-z/;
    if ($w =~ /^[ \t]*(.+)\.?[ \t]*$/o) {
	$w = $1;
    }
    if ($w =~ /^(.+)\.+[ \t]*$/) {
	$w = $1;
    }
    if ($w =~ /^\[?([^][]+)\]?$/) {
	$w = $1;
    }
    if ($w =~ /^([a-z][-a-z0-9]*[ \t]+\&c\.*[ \t]*(\(.*\))?)[ \t]*([0-9]+)/) {
#	$w = $1;
#	$index = $3;
	return;
    } elsif ($w !~ /^[a-z]/) {
	return;
    } elsif ($w =~ /[ \t]+/) {
	return;
    }
    do {
	if ($w =~ /^[ \t]+(.+)$/o) {
	    $w = $1;
	}
	if ($w =~ /^(.+)[ \t]+$/o) {
	    $w = $1;
	}
	while ($w =~ s/\.\./\./) {
	}
    } until (($w !~ /[ \t]+$/) && ($w !~ /\.\./));
    print "$w, $index\n";
}


#
# 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:
#