src/Factoids/Statement.pl

   1
   2 # infobot :: Kevin Lenzo  (c) 1997
   3
   4 ##
   5 ##  doStatement --
   6 ##
   7 ##      decide if $in is a statement, and if so,
   8 ##              - update the dbm
   9 ##              - return feedback statement
  10 ##
  11 ##      otherwise return
  12 ##              - null for confused.
  13 ##              - NOREPLY not to respond.
  14 ##
  15
  16 if (&IsParam("useStrict")) { use strict; }
  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 'NOREPLY' 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     # look for a "type nugget". this should be externalized.
  34     $urlType = "mailto" if ($in =~ /\bmailto:.+\@.+\..{2,}/i);
  35     $urlType = "mailto" if ($in =~ s/\b(\S+\@\S+\.\S{2,})/mailto:$1/gi);
  36     $in =~ s/(mailto:)+/mailto:/g;
  37
  38     $urlType = "about"   if ($in =~ /\babout:/i);
  39     $urlType = 'afp'     if ($in =~ /\bafp:/);
  40     $urlType = 'file'    if ($in =~ /\bfile:/);
  41     $urlType = 'palace'  if ($in =~ /\bpalace:/);
  42     $urlType = 'phoneto' if ($in =~ /\bphone(to)?:/);
  43     if ($in =~ /\b(news|http|ftp|gopher|telnet):\s*\/\/[\-\w]+(\.[\-\w]+)+/) {
  44         $urlType = $1;
  45     }
  46
  47     # acceptUrl.
  48     if (&IsParam("acceptUrl")) {
  49         if ($param{'acceptUrl'} eq 'REQUIRE') {         # require url type.
  50             return 'NOREPLY' if ($urlType eq "");
  51         } elsif ($param{'acceptUrl'} eq 'REJECT') {
  52             &status("REJECTED URL entry") if (&IsParam("VERBOSITY"));
  53             return 'NOREPLY' unless ($urlType eq "");
  54         } else {
  55             # OPTIONAL
  56         }
  57     }
  58
  59     # learn statement. '$lhs is|are $rhs'
  60     if ($in =~ /(^|\s)(is|are)(\s|$)/i) {
  61         my($lhs, $mhs, $rhs) = ($`, $&, $');
  62
  63         $lhs =~ tr/A-Z/a-z/;
  64         $lhs =~ s/^(the|da|an?)\s+//i; # discard article
  65
  66         # remove excessive initial and final whitespaces.
  67         $lhs =~ s/^\s+|\s+$//g;
  68         $mhs =~ s/^\s+|\s+$//g;
  69         $rhs =~ s/^\s+|\s+$//g;
  70
  71         # break if either lhs or rhs is NULL.
  72         if ($lhs eq "" or $rhs eq "") {
  73             return 'NOREPLY';
  74         }
  75
  76         # lets check if it failed.
  77         if (&validFactoid($lhs,$rhs) == 0) {
  78             if ($addressed) {
  79                 &status("IGNORE statement: <$who> $message");
  80                 &performReply( &getRandom(keys %{$lang{'confused'}}) );
  81             }
  82             return 'NOREPLY';
  83         }
  84
  85         return 'NOREPLY' if (!$addressed and $lhs =~ /\s+/);
  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 chan 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 'NOREPLY';
 104             }
 105         }
 106
 107         return &update($lhs, $mhs, $rhs);
 108     }
 109
 110     return '';
 111 }
 112
 113 1;