#!/usr/local/bin/perl
#
# Web - MUSH spellchecking robot (perl version)
# Requires sock.pl and telnet.pl by David Noble
#
#
#############################################################################
require 'sock.pl';
require 'telnet.pl';

# routine for clean shutdown on error
sub abort {
  &sock'close_all;
  die "ended unexpectedly, but shut down cleanly\n";
}

srand;
$* = 1;
$hostname = "mellers1.psych.berkeley.edu";
$port = "4201";
$timeout = 1;
$login_prompt = 'WHO';
$web_name = 'Webster';
$web_pass = 'eccentrica';
$prefix = "BEGRBT" . rand(1000);
$suffix = "ENDRBT" . rand(1000);
$rumor_file = "/dunemush/mush/game/txt/Events/webrum";
$spell_prog = "/bin/spell";
$webster_prog = "/usr/local/bin/webster";
$local_dict = "/dunemush/mush/game/Webster/dune.dict";
$spelling_log = "/dunemush/mush/game/Webster/webspell.log";

##################################
#
# Big infinite loop
#

while (1) {

#############################################################################
#
#	Open the connection
#
if (!($session = &sock'open($hostname,$port)))
 {
  sleep 300;
  redo;
 }

#############################################################################
#
# Get to the login prompt
#
while (1) {
  $_ = &telnet'read($session, $timeout);
  &abort if &telnet'eof;
  print if ($debug);
  last if m/$login_prompt/o;
}
print $session "connect $web_name $web_pass\n"; # send a login name

#############################################################################
#
# The real webster stuff.
# Loop and wait for data read. If so, parse it.


#print $session "OUTPUTPREFIX $prefix";
#print $session "OUTPUTSUFFIX $suffix";
print $session "home\n";

until (&telnet'eof) {
  $_ = &telnet'read($session, $timeout);
  if ($counter++ > 1800) {
     print $session "think I'm not idle!\n";
     $counter = 0;
  }
  print if ($debug);
  exit if m/$web_pass/;
  if (/^(.*) pages: (.*)/) {
    undef $player, $command, $name, @text;
    $player = $1; ($command,$name,@text) = split(" ",$2);
    &define($player,$command,@text) if ($command =~ /define/i);
    &suggest($player,$command,@text) if ($command =~ /suggest/i);
    &spell($player,$name,@text) if ($command =~ /spell/i);
    &rumor($player,$command,@text) if ($command =~ /rumor/i);
  }
}

print $session "QUIT\n";



#############################################################################
#
# Get any exit messages
#
until (&telnet'eof) {
  $_ = &telnet'read($session, $timeout);
  print if ($debug);
}
print "\nWebster completed\n";

&sock'close($session);

################################
#
# Tail of big infinite loop

sleep(300);
}

###########################################################################
#
# Subroutine define - interface to Unix webster(1)
#
sub define {
  local($plr) = shift(@_);
  local($hdr) = shift(@_);
  local($word) = shift(@_);
  $word =~ s/[^-A-Za-z0-9]//g;
  local($command) = $webster_prog . " " . $word . " |";
  local(@answer);
  open(DEFINE,$command) || return;
  while (<DEFINE>) {
    chop;
    s/\[//g;
    s/\]//g;
    @answer = (@answer,$_);
  }
  close(DEFINE);
  print $session "page $plr=$word: " . join(" ",@answer) . "\n";
}

###########################################################################
#
# Subroutine suggest - interface to Unix webster(1)
#
sub suggest {
  local($plr) = shift(@_);
  local($hdr) = shift(@_);
  local($word) = shift(@_);
  $word =~ s/[^-A-Za-z0-9]//g;
  local($command) = $webster_prog . " -s " . $word . " |";
  local(@answer);
  open(SUGGEST,$command) || return;
  while (<SUGGEST>) {
    chop;
    s/\[//g;
    s/\]//g;
    @answer = (@answer,$_);
  }
  close(SUGGEST);
  print $session "page $plr=$word: " . join(" ",@answer) . "\n";
}

###########################################################################
#
# Subroutine spell - interface to Unix spell(1)
#
sub spell {
  local($plr) = shift(@_);
  local($atr) = shift(@_);
  local($text) = join(" ",@_);
  $tmpfile = "/tmp/web$$";
  open(TMP,"> $tmpfile");
  print TMP $text,"\n";
  close(TMP);
  local($command) = "$spell_prog +$local_dict $tmpfile |";
  local(@answer);
  open(SPELL,$command) || return;
  if ($pipe = <SPELL>) {
    do {
      chop($pipe);
      @answer = (@answer,$pipe);
    } while ($pipe = <SPELL>);
    close(SPELL);
    print $session "page ${plr}=${atr}: " . join(" ",@answer) . "\n";
    open(LOG,">> $spelling_log") || return;
    print LOG join(" ",@answer),"\n";
    close(LOG);
  } else {
    print $session "page $plr=$atr: No misspelled words\n";
    close(SPELL);
  }
  unlink($tmpfile);
}

###########################################################################
#
# Subroutine rumor - append a line to the rumor_file
#
sub rumor {
  local($plr) = shift(@_);
  local($hdr) = shift(@_);
  local($text) = join(" ",@_);
  if (length($text) < 10) {
    print $session "page $plr=You probably meant: events $text\n";
  } else {
    open(RUMOR,">> $rumor_file") || return;
    print RUMOR "${text}\n(by ${plr})\n\n";
    close(RUMOR);
    print $session "page $plr=Rumor noted!\n";
  }
}