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