#!/usr/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;
$* = 0;
$hostname = "<address>";
$port = "<port>";
$timeout = 1;
$login_prompt = 'WHO';
$web_name = 'Webster';
$web_pass = 'WebsPword';
$prefix = "BEGRBT" . rand(1000);
$suffix = "ENDRBT" . rand(1000);
$rumor_file = "<location of rumor file>";
$spell_prog = "/usr/bin/spell";
$spell_opts = "-B -m -S -a";
$webster_prog = "/usr/local/bin/webster";
$local_dict = "<location of local dictionary>";
$spelling_log = "<location of spelling log>";

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

while (1) {

#############################################################################
#
#	Open the connection
#
if (!($session = &sock'open($hostname,$port)))
 {
  sleep 60;
  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);
  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);
    &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(60);
}

###########################################################################
#
# 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 spell - interface to Unix ispell(1)
#
sub spell {
  local($plr) = shift(@_);
  local($atr) = shift(@_);
  local($text) = join(" ",@_);
  local($multilines) = $*;
  $* = 0;  # restored at end of subroutine -MJB-
  $tmpfile = "/tmp/web$$";
  open(TMP,"> $tmpfile");
  # ! enters terse mode in ispell, ^ is for safety's sake -MJB-
  # If you really want to understand all this 'man ispell'
  print TMP "!\n^",$text,"\n";
  close(TMP);
  # ispell interface. -a is pipe mode. good stuff. -MJB-
  local($command) = "cat $tmpfile | $spell_prog $spell_opts -a -p$local_dict |";
  local(@answer, @result, $word);
  open(SPELL,$command) || return;
  if ($pipe = <SPELL>) {
    do {
      chop($pipe);
      unless ($pipe =~ /^(@.*|)$/) {
	 @answer = (@answer, $pipe);
	 @result = split(' ',$pipe);
	 $word = $result[1];
	 if ($pipe =~ /^[&\?]/) {
	   @result = splice(@result,4);
           print $session "@pemit *${plr}=${atr} - ${word}: ", join(" ",@result), "\n";
	 } else {
	   print $session "@pemit *${plr}=${atr}: ${word} - Sorry, I don't know how to spell that word.\n";
	 }
      }
    } while ($pipe = <SPELL>);
    close(SPELL);
    print $session "@pemit *${plr}=${atr}: No spelling errors\n" unless @answer;
    open(LOG,">> $spelling_log") || return;
    print LOG "SPELL: ${plr} - ", join(" ",@answer),"\n" if @answer;
    close(LOG);
  } else {
    print $session "page $plr=$atr: No misspelled words\n";
    close(SPELL);
  }
  unlink($tmpfile);
  $* = $multilines;
}

###########################################################################
#
# 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";
  }
}