#!/usr/local/bin/perl
#
# talk    -- Golem request progam (typically for ``Talking to NPCs'')
# Version 1.5
#
#   Given a golem file location and user supplied message/request,
# determine what is the correct page to jump the user to in response.
#
# This is done by taking the user input `message',  simplifing it and
# preforming a simple table lookup for the document URL to jump the users
# WWW client to in response to the users input.
#
# Golem (n) :  A magically created being, which is able to perform
#              simple tasks as requested by its maker.
#
# A Golem created via this program could be...
#    NPCs:     people/monsters the adventurer meets to which can answer very
#                simple questions (word or two type) or perform a simple task.
#   Guards:    requiring only a password (they are not very talkative)
#   Locks:     needing a key with a particular word or label
#   Transport: specify a destination for transport
# And many other posibilities.
#             
# This cgi script is called from a `message' input form suppling the
# location of the talk data file (under the $WWW_DIR directory hardcoded
# below) as a QUERY_STRING in the URL call to this cgi-script. The form
# itself only requires one string "mesg" element into which the user can
# type the request, question, passwd, answer, as required for the
# situation. See examples below.
# 
# the location of the ``talk response file'' (minus the $SUFFIX) under the
# $WWW_DIR directory, hardcoded below.  EG: The location of this 
# file is    "$WWW_DIR/QUERY_STRING$SUFFIX" 
# 
#
# Example of a form to ``talk to the elf''
#     =======8<--------
#     <FORM METHOD=POST ACTION="/ant-bin/talk?forest/elves">
#     <DL><DT>You can ask the elf about something.. <BR>
#     <DD><INPUT TYPE=SUBMIT VALUE="Ask"> <INPUT NAME="mesg">
#     <DT>Or you can...
#     ...
#     =======8<--------
# Which will look up the Talk datafile   "$WWW_DIR/forest/elves$SUFFIX"
#              
#
# Example Talk Data File
#     =======8<--------
#     # Talk datafile for  Elven Encounter
#     #    `` Ask us about this forest ? ''
#     #
#     BASE_DIR       : forest          # directory to find response files
#     MAIL_TO        : anthony@cit.gu.edu.au
#     #
#     calain         : e_calain.html   # Who is speaking
#     name           : e_calain.html
#     who            : e_calain.html
#     hi             : e_calain.html
#     you            : e_elves.html    # about the elves
#     elf            : e_elves.html
#     # ---
#     forest         : e_forest.html   # general forest info
#     path           : e_forest.html
#     trail          : e_forest.html
#     green          : e_green.html    # coloured trails
#     yellow         : e_yellow.html
#     village        : e_village.html  # how to get to...
#     portal         : e_portal.html
#     castle         : e_castle.html
#     # ---
#     anthony        : e_anthony.html  # about people/monsters
#     dragon         : e_dragon.html
#     # ---
#     sex            : e_private.html  # not your concern
#     password       : e_unknown.html  # we don't know any passwords
#                    : e_blank.html    # adventurer did not say anything!
#     UNKNOWN        : e_unknown.html  # general unknown reply
#     VERBOSE        : e_verbose.html  # adventurer was overly verbose 
#     =======8<--------
#
# TALK DATA FORMAT
#
#    word...    : document     If mesg matches this word jump to given document
#
#    UNKNOWN    : document     Unknown response reply document (not verbose)
#    VERBOSE    : document     User was verbose (too many words given)
#
#    BASE_DIR   : path         Base directory (in my home) for documents
#    WORD_LIMIT : number       Maximum number of words before verbose (def 3)
#    MAIL_TO    : address..    Mail Unknown prases to this person(s)
#    SKIPMAIL                  Don't mail anyone about unknown documents
#
# For more information about the contents of this document please contact
# the author  Anthony Thyssen  <anthony@cit.gu.edu.au>.
#
#
# AUTHOR Anthony Thyssen    <anthony@cit.gu.edu.au>    3 May 1995
#
# -------------- MODIFY THE FOLLOWING TO SUIT YOUR SITE ---------------------
# --- Initialize  ---

# Directory prefix to locate the talk data file -- Your Home Directory
$WWW_DIR = "/home/anthony/www";

# The URL location of  $WWW_DIR  to prepend to BASE_DIR and response document
$WWW_URL = "http://www.cit.gu.edu.au/~anthony";

# Default directory to use when BASE_DIR is not given
# This is normally supplied in the talk data file.
$BASE_DIR  = "";    

# The suffix talk data files are `hidden' under
# change this so people can't find your talk data
$SUFFIX  = '.talkrc';

# Who to mail to by default when MAIL_TO is not given or on an error
$MAIL_TO     = "anthony";                 # default mail for UNKNOWN
$MAIL_ERRORS = "anthony\@cit.gu.edu.au";  # for major errors  and faults

# The mail program to use for mailing unknown requests and errors
$mailprog = '/usr/lib/sendmail';

# -------------------- END OF USER MODIFICATIONS ---------------------

# --- Subroutines ---

sub error_head {
qq*
<HEAD><TITLE>Talk - Error Report</TITLE></HEAD>
<BODY><H1>Talk - Error Report</H1>

An error has been discovered while processing your talk request :- <P>

*
}

sub error_tail {
qq*
<P>
I don't know why you received this document.  May be you are trying to
cheat?  Or may be it was a mistake on my part? In any case I have notified
the dwarves of a possible problem and it will hopefully be fixed in a few
days. -- WWW Adventure Talk<P>
``Glad to be of Service'' -- the door in ``Hitchhikers Guide to the Galaxy''
*
}


sub addr {
qq*
<P><HR>
<ADDRESS>
Program: ``talk'' -- WWW Adventure Talk<BR>
Created: 17 January 1995 <BR>
Modified: 18 May 1995 <BR>
Author:
  <A HREF="http://www.cit.gu.edu.au/~anthony/anthony.html">Anthony Thyssen</A>,
  &lt;<A HREF="http://www.cit.gu.edu.au/~anthony/mail.shtml">
  anthony\@cit.gu.edu.au</A>&gt;
</ADDRESS>
*
}


sub output_error {
  print "Content-type: text/html\n\n";
  print &error_head;
  print "<B>", @_, "</B>\n";
  print &error_tail;
  print &addr;

  # Notify anthony that the program failed for some reason
  open (MAIL, "|$mailprog $MAIL_ERRORS")
      || &die( "Can't open $mailprog!" );

  # the mail message
  print MAIL
    "Subject: WWW Talk (Parse Error)\n",
    "Reply-To: $MAIL_ERRORS\n\n",
    "I failed to parse the following talk request\n\n",
    "   ``", @_, "''\n",
    "   talk datafile  : $talkfile\n",
    "   message given  : $origmesg\n",
    "   message parsed : $mesg\n\n",
    "from $ENV{'HTTP_FROM'} at $ENV{'REMOTE_HOST'}\n\n",
    "signed   WWW Adventure Talk program  ``talk''\n";

  close (MAIL);

  exit 0;
}


sub jump_to {
  local($url) = @_;

  print "Location: $url\n";
  print "Content-type: text/html\n\n";
  print "The reply to your message is <A HREF=\"$url\">here</A>.\n\n";
  print &addr;
  exit 0;
}


# --- Main Proceedure ---
# If run outside the CGI environment
# 
if ( ! defined $ENV{"REQUEST_METHOD"} ) {

  die("Usage: talk  talk_datafile\n")  if $#ARGV != 0;

  $errors = $say_count = $doc_count = 0;

  while( <> ) {
    s/#.*$//;         # remove comments
    next if /^\s*$/;  # skip blank lines
    s/\s+/ /g;        # remove extra space
    s/ $//;           #    end of line
    s/ :/:/g;         #    before seperator
    s/: /:/g;         #    after seperator

    ($say, $doc) = split(/:/);

    # Base Directory Tag (Multiple allowed)
    if ( $say eq "BASE_DIR" ) {
      $BASE_DIR = $doc;
      if ( ! -d join('/',$WWW_DIR, $BASE_DIR) ) {
        print "ABORTING -- Invalid Base Directory -- ABORT\n";
        print join('/',$WWW_DIR, $BASE_DIR), "\n";
        print "Sorry 'bout that Chief! -- WWW Adventure Talk\n";
        exit 0;
      }
      next;
    }
   
    # Find Duplicates for anything else
    if ( ! defined $sayings{$say} ) {
      $sayings{$say}++;
    } else {
      print "Duplicate saying \"$say\" found!\n";
    }

    # Other Non-Document Tags.
    if ( $say eq "SKIPMAIL" ) {
      print "I will skip sending mail for unknown responses.\n";
      next;
    }
    if ( $say eq "MAIL_TO" ) {
      print "Mail for unknown responses re-directed to\n\t$doc.\n";
      next;
    }
    if ( $say eq "WORD_LIMIT" ) {
      if ( $doc =~ /\D/ ) {
        print "Non-Numeric Word Limit Found \"$doc\".";
        next;
      }
      print "Wordy replies have more than $doc words.\n";
      next;
    }
   
    # Document Tags
    $say_count++;  # count of number of responses (including unknonw/verbose)
    if ( ! -f join('/',$WWW_DIR, $BASE_DIR, $doc) ) {
      print "$doc -- not found for \"$say\"\n";
      $errors++;
      next;
    }
    if ( ! defined $documents{$doc} ) {
      $documents{$doc}++;
      $doc_count++;
    }
    # special documents
    if ( $say eq "UNKNOWN" ) { $UNKNOWN = $doc; next; }
    if ( $say eq "VERBOSE" ) { $VERBOSE = $doc; next; }

    if ( $say =~ /[^a-z0-9 ]/ ) {
      print "Invalid Special or Saying \"$say\"\n";
      $errors++;
      next;
    }
  }

  if ( ! defined $UNKNOWN ) {
    print "Data File Error : Missing the UNKNOWN response!\n";
    $errors++;
  }

  print "Found $say_count replies refering to $doc_count documents\n";
  print $errors ? "WARNING: $errors errors found!"
                : "No errors found!", " -- WWW Adventure Talk\n";
  exit 0;
}

# OK at this point we are definitely CGI usage.

# --- Read Arguments ---
sub clean_arg {
  local($arg) = @_;
  $arg =~ tr/+/ /;
  $arg =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
  $arg =~ s/^\s+//;           # no spaces at start
  $arg =~ s/\s+$//;           # no spaces at end
  return( $arg );
}

# For Debugging
#print "Content-type: text/plain\n\n";

# Get the post variables
read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
foreach $arg ( split(/&/, $buffer) ) {
  local($name, $value) = split(/=/, $arg.'='); # get the value (and if defined)
  $FORM{$name} = &clean_arg($value);           # save the variable
  #print "FORM{$name} = \"$FORM{$name}\"\n";   # Debug Line
}

# form supplied get arguments
$talkfile=&clean_arg($ENV{'QUERY_STRING'});

$origmesg = $mesg = $FORM{"mesg"};

$mesg =~ tr/A-Z/a-z/;    # lowercase letters
$mesg =~ s/[-_`']+//g;   # remove non-space punctuation
$mesg =~ s/[^\w\s]+/ /g; # other punctuation becomes a space
$mesg =~ s/\s+/ /g;      # all spaces as a single space
$mesg =~ s/^ //;         # no spaces at start
$mesg =~ s/ $//;         # no spaces at end

$words = split(/ /, $mesg); # number of words given originally

# Remove all question verbs and prepositions in an effort to simplify the
# users reply (NOTE: remove a space around word and do not leave message
# blank)
1 while ( # START words of a message
          $mesg =~ s/^(how|when|where|why|who|what|which|was|were) //
       || $mesg =~ s/^(want|would|there|will|has|have|do|can|way) //
       || $mesg =~ s/^(howd|wheres|whos|whats|hast|lets|about|any) //
       || $mesg =~ s/^(use|did|does|may|get|going) //
          # ANYWHERE but at End of message
       || $mesg =~ s/\b(to|is|it|in|are|of|a|an|am|the|ye|be|and) //
       || $mesg =~ s/\b(i|thee|thy|thou|you|your|yours|me|mine) //
       || $mesg =~ s/\b(that|this|for|with|know) //
          # END of message
       || $mesg =~ s/ (to|there|it|where|for)$//
       );

# Simplify some other words (EG: plurals)
1 while ( $mesg =~ s/\b(dragon|scroll|map|key|sword|shield)s\b/$1/
       || $mesg =~ s/\b(monster|beast|path|trail|stone|spell)s\b/$1/ );

# For debugging
#print "Content-type: text/plain\n\n";
#print "talkfile = \"$talkfile\"\n";
#print "origmesg = \"$origmesg\"\n";
#print "mesg     = \"$mesg\"\n";
#print "\n";

# --- Check Arguments ---

&output_error("Form error, Illegal Request ``$ENV{'REQUEST_METHOD'}''!\n".
              "Hey what are you trying to do without a form?\n")
   unless $ENV{"REQUEST_METHOD"} eq 'POST';

&output_error("Form error, No message given at all!\n".
              "Hey what are you trying to do without a form?\n")
   unless defined $FORM{"mesg"};

&output_error("Just who are you trying to talk to? A Mutant?") 
  if  $talkfile =~ /[][|^;&<>*?$\\`'"\s]/;

&output_error("Just who are you trying to talk to? Someones Parent?") 
  if  $talkfile =~ /\.\./;

&output_error("You haven't said what golem is handling the request!")
  if  $talkfile eq '';

&output_error("Hmm, I can't seem to find that particular golem!")
  if ! -f "$WWW_DIR/$talkfile$SUFFIX";

&output_error("That golem is not readable! I can't read minds you know!")
  if ! -r "$WWW_DIR/$talkfile$SUFFIX";

# --- Do The Appropriate Action ---

open( FILE, "$WWW_DIR/$talkfile$SUFFIX" ) 
  || &output_error("Can't Open Golem Data File : $!");

#
# I assume that the data file has been checked using this program
# and that is ok to use.
#
$WORD_LIMIT=3;  # default word limit  (if more than this user was verbose!)

while(<FILE>) {
  s/#.*$//;         # remove comments
  next if /^\s*$/;  # skip blank lines
  s/\s+/ /g;        # remove extra space
  s/ $//;           #    end of line
  s/ :/:/g;         #    before seperator
  s/: /:/g;         #    after seperator

  ($say, $doc) = split(/:/);

  if ( $say eq "SKIPMAIL"   ) { $SKIPMAIL   = 1;      next; }
  if ( $say eq "MAIL_TO"    ) { $MAIL_TO    = $doc;   next; }
  if ( $say eq "BASE_DIR"   ) { $BASE_DIR   = $doc;   next; }
  if ( $say eq "UNKNOWN"    ) { $UNKNOWN    = $doc;   next; }
  if ( $say eq "VERBOSE"    ) { $VERBOSE    = $doc;   next; }
  if ( $say eq "WORD_LIMIT" ) { $WORD_LIMIT = $doc+0; next; }

  if( $say eq $mesg ) {
    &output_error("Document not found!")
       if ! -f join('/',$WWW_DIR, $BASE_DIR, $doc);
    $doc = "$BASE_DIR/$doc";      # add BASE
    $doc =~ s|/index.s?html$|/|;  # remove any index file!
    $doc =~ s|/+|/|g;             # remove doubled //
    $doc =~ s|^/||g;              # remove / at start
    &jump_to( join('/',$WWW_URL, $doc) );
  }
}
close(FILE);

# The reply was NOT found!

# Set flags appropriate to the current situation.
$unknown    = (defined $UNKNOWN);
$is_verbose = ($words > $WORD_LIMIT);
$verbose    = (defined $VERBOSE && $is_verbose);

if( ! $SKIPMAIL ) {

  # No answer known so notify author of the attempt so 
  # the talk can be expanded if the answer is valid.
  open (MAIL, "|$mailprog $MAIL_TO")
      || &output_error( "Can't open $mailprog!\n" );

  # the mail message
  print MAIL
    "Subject: WWW Talk (Unknown Mesg)\n",
    "Reply-To: $MAIL_ERRORS\n\n",
    "I received the following unknown message\n",
    "from $ENV{'HTTP_FROM'} at $ENV{'REMOTE_HOST'}\n\n",
    "   talk datafile  : $talkfile\n",
    "   message given  : $origmesg\n",
    "   message parsed : $mesg\n",
    $verbose      ? "   This message was given the VERBOSE response!\n"
    : $is_verbose ? "   Verbose but no verbose response available!\n"
    : $unknown    ? "   Unknown Response Given!\n" 
                  : "   ERROR --- Missing UNKNOWN Response --- ERROR\n",
    "\nsigned   WWW Adventure Talk program  ``talk''\n";

  close (MAIL);
}

# Ok done, jump verbose/unknown response if available
&jump_to( join('/',$WWW_URL, $BASE_DIR, $VERBOSE) )  if $verbose;
&jump_to( join('/',$WWW_URL, $BASE_DIR, $UNKNOWN) )  if $unknown;
 
# Error no Unknown page found
&output_error("Data File Error : Missing Unknown Response Document!");

# ----------------------------------------------------------------