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         }
  47         elsif ( $param{'acceptUrl'} eq 'REJECT' ) {
  48             &status("REJECTED URL entry") if ( &IsParam('VERBOSITY') );
  49             return unless ( $urlType eq '' );
  50         }
  51         else {
  52
  53             # OPTIONAL
  54         }
  55     }
  56
  57     # learn statement. '$lhs is|are $rhs'
  58     if ( $in =~ /(^|\s)(is|are)(\s|$)/i ) {
  59         my ( $lhs, $mhs, $rhs ) = ( $`, $&, $' );
  60
  61         # allows factoid arguments to be updated. -lear.
  62         $lhs =~ s/^(cmd: )?(.*)/$1||'' . lc $2/e;
  63
  64         # discard article.
  65         $lhs =~ s/^(the|da|an?)\s+//i;
  66
  67         # remove excessive initial and final whitespaces.
  68         $lhs =~ s/^\s+|\s+$//g;
  69         $mhs =~ s/^\s+|\s+$//g;
  70         $rhs =~ s/^\s+|\s+$//g;
  71
  72         # break if either lhs or rhs is NULL.
  73         if ( $lhs eq '' or $rhs eq '' ) {
  74             return "NOT-A-STATEMENT";
  75         }
  76
  77         # lets check if it failed.
  78         if ( &validFactoid( $lhs, $rhs ) == 0 ) {
  79             if ($addressed) {
  80                 &status("IGNORE statement: <$who> $message");
  81                 &performReply( &getRandom( keys %{ $lang{'confused'} } ) );
  82             }
  83             return;
  84         }
  85
  86         # uncomment to prevent HUNGRY learning of rhs with whitespace
  87         #return if (!$addressed and $lhs =~ /\s+/);
  88         &::DEBUG("doStatement: $in:$lhs:$mhs:$rhs");
  89
  90         &status("statement: <$who> $message");
  91
  92         # change "#*#" back to '*' because of '\' sar to '#blah#'.
  93         $lhs =~ s/\#(\S+)\#/$1/g;
  94         $rhs =~ s/\#(\S+)\#/$1/g;
  95
  96         $lhs =~ s/\?+\s*$//;    # strip off '?'.
  97
  98         # verify the update statement whether there are any weird
  99         # characters.
 100         ### this can be simplified.
 101         foreach ( split //, $lhs . $rhs ) {
 102             my $ord = ord $_;
 103             if ( $ord > 170 and $ord < 220 ) {
 104                 &status("statement: illegal character '$_' $ord.");
 105                 &performAddressedReply(
 106                     "i'm not going to learn illegal characters");
 107                 return;
 108             }
 109         }
 110
 111         # success.
 112         return if ( &update( $lhs, $mhs, $rhs ) );
 113     }
 114
 115     return 'CONTINUE';
 116 }
 117
 118 1;
 119
 120 # vim:ts=4:sw=4:expandtab:tw=80