src/Factoids/Statement.pl

   1 ###
   2 ### Statement.pl: Kevin Lenzo  (c) 1997
   3 ###
   4
   5 ##
   6 ##  doStatement --
   7 ##
   8 ##      decide if $in is a statement, and if so,
   9 ##              - update the db
  10 ##              - return feedback statement
  11 ##
  12 ##      otherwise return
  13 ##              - null for confused.
  14 ##
  15
  16 # use strict;   # TODO
  17
  18 sub doStatement {
  19     my($in) = @_;
  20
  21     $in =~ s/\\(\S+)/\#$1\#/g;  # fix the backslash.
  22     $in =~ s/^no([, ]+)//i;     # 'no, '.
  23
  24     # check if we need to be addressed and if we are
  25     return unless ($learnok);
  26
  27     my($urlType) = '';
  28
  29     # prefix www with http:// and ftp with ftp://
  30     $in =~ s/ www\./ http:\/\/www\./ig;
  31     $in =~ s/ ftp\./ ftp:\/\/ftp\./ig;
  32
  33     $urlType = 'about'   if ($in =~ /\babout:/i);
  34     $urlType = 'afp'     if ($in =~ /\bafp:/);
  35     $urlType = 'file'    if ($in =~ /\bfile:/);
  36     $urlType = 'palace'  if ($in =~ /\bpalace:/);
  37     $urlType = 'phoneto' if ($in =~ /\bphone(to)?:/);
  38     if ($in =~ /\b(news|http|ftp|gopher|telnet):\s*\/\/[\-\w]+(\.[\-\w]+)+/) {
  39         $urlType = $1;
  40     }
  41
  42     # acceptUrl.
  43     if (&IsParam('acceptUrl')) {
  44         if ($param{'acceptUrl'} eq 'REQUIRE') {         # require url type.
  45             return if ($urlType eq '');
  46         } elsif ($param{'acceptUrl'} eq 'REJECT') {
  47             &status("REJECTED URL entry") if (&IsParam('VERBOSITY'));
  48             return unless ($urlType eq '');
  49         } else {
  50             # OPTIONAL
  51         }
  52     }
  53
  54     # learn statement. '$lhs is|are $rhs'
  55     if ($in =~ /(^|\s)(is|are)(\s|$)/i) {
  56         my($lhs, $mhs, $rhs) = ($`, $&, $');
  57
  58         # allows factoid arguments to be updated. -lear.
  59         $lhs =~ s/^(cmd: )?(.*)/$1||'' . lc $2/e;
  60
  61         # discard article.
  62         $lhs =~ s/^(the|da|an?)\s+//i;
  63
  64         # remove excessive initial and final whitespaces.
  65         $lhs =~ s/^\s+|\s+$//g;
  66         $mhs =~ s/^\s+|\s+$//g;
  67         $rhs =~ s/^\s+|\s+$//g;
  68
  69         # break if either lhs or rhs is NULL.
  70         if ($lhs eq '' or $rhs eq '') {
  71             return "NOT-A-STATEMENT";
  72         }
  73
  74         # lets check if it failed.
  75         if (&validFactoid($lhs,$rhs) == 0) {
  76             if ($addressed) {
  77                 &status("IGNORE statement: <$who> $message");
  78                 &performReply( &getRandom(keys %{ $lang{'confused'} }) );
  79             }
  80             return;
  81         }
  82
  83         # uncomment to prevent HUNGRY learning of rhs with whitespace
  84         #return if (!$addressed and $lhs =~ /\s+/);
  85         &::DEBUG("doStatement: $in:$lhs:$mhs:$rhs");
  86
  87         &status("statement: <$who> $message");
  88
  89         # change "#*#" back to '*' because of '\' sar to '#blah#'.
  90         $lhs =~ s/\#(\S+)\#/$1/g;
  91         $rhs =~ s/\#(\S+)\#/$1/g;
  92
  93         $lhs =~ s/\?+\s*$//;    # strip off '?'.
  94
  95         # verify the update statement whether there are any weird
  96         # characters.
  97         ### this can be simplified.
  98         foreach (split //, $lhs.$rhs) {
  99             my $ord = ord $_;
 100             if ($ord > 170 and $ord < 220) {
 101                 &status("statement: illegal character '$_' $ord.");
 102                 &performAddressedReply("i'm not going to learn illegal characters");
 103                 return;
 104             }
 105         }
 106
 107         # success.
 108         return if (&update($lhs, $mhs, $rhs));
 109     }
 110
 111     return 'CONTINUE';
 112 }
 113
 114 1;
 115
 116 # vim:ts=4:sw=4:expandtab:tw=80