2 ### Statement.pl: Kevin Lenzo (c) 1997
8 ## decide if $in is a statement, and if so,
10 ## - return feedback statement
13 ## - null for confused.
18 use Encode qw(decode_utf8);
23 $in =~ s/\\(\S+)/\#$1\#/g; # fix the backslash.
24 $in =~ s/^no([, ]+)//i; # 'no, '.
26 # check if we need to be addressed and if we are
27 return unless ($learnok);
31 # prefix www with http:// and ftp with ftp://
32 $in =~ s/ www\./ http:\/\/www\./ig;
33 $in =~ s/ ftp\./ ftp:\/\/ftp\./ig;
35 $urlType = 'about' if ( $in =~ /\babout:/i );
36 $urlType = 'afp' if ( $in =~ /\bafp:/ );
37 $urlType = 'file' if ( $in =~ /\bfile:/ );
38 $urlType = 'palace' if ( $in =~ /\bpalace:/ );
39 $urlType = 'phoneto' if ( $in =~ /\bphone(to)?:/ );
40 if ( $in =~ /\b(news|http|ftp|gopher|telnet):\s*\/\/[\-\w]+(\.[\-\w]+)+/ ) {
45 if ( &IsParam('acceptUrl') ) {
46 if ( $param{'acceptUrl'} eq 'REQUIRE' ) { # require url type.
47 return if ( $urlType eq '' );
49 elsif ( $param{'acceptUrl'} eq 'REJECT' ) {
50 &status("REJECTED URL entry") if ( &IsParam('VERBOSITY') );
51 return unless ( $urlType eq '' );
59 # learn statement. '$lhs is|are $rhs'
60 if ( $in =~ /(^|\s)(is|are)(\s|$)/i ) {
61 my ( $lhs, $mhs, $rhs ) = ( $`, $&, $' );
63 # Quit if they are over the limits. Check done here since Core.pl calls
64 # this mid sub and Question.pl needs its own check as well. NOTE: $in is
65 # used in this place since lhs and rhs are really undefined for unwanted
66 # teaching. Mainly, the "is" could be anywhere within a 510 byte or so
67 # block of text, so the total size was choosen since the sole purpose of
68 # this logic is to not hammer the db with pointless factoids that were
69 # only meant to be general conversation.
73 &::getChanConfDefault( 'minVolunteerLength', 2, $chan ) or
74 $param{'addressing'} =~ m/require/i ) and not $addressed;
78 &::getChanConfDefault( 'maxVolunteerLength', 512, $chan ) or
79 $param{'addressing'} =~ m/require/i ) and not $addressed;
81 # allows factoid arguments to be updated. -lear.
82 $lhs =~ s/^(cmd: )?(.*)/$1||'' . lc $2/e;
85 $lhs =~ s/^(the|da|an?)\s+//i;
87 # remove excessive initial and final whitespaces.
88 $lhs =~ s/^\s+|\s+$//g;
89 $mhs =~ s/^\s+|\s+$//g;
90 $rhs =~ s/^\s+|\s+$//g;
92 # break if either lhs or rhs is NULL.
93 if ( $lhs eq '' or $rhs eq '' ) {
94 return "NOT-A-STATEMENT";
97 # lets check if it failed.
98 if ( &validFactoid( $lhs, $rhs ) == 0 ) {
100 &status("IGNORE statement: <$who> $message");
101 &performReply( &getRandom( keys %{ $lang{'confused'} } ) );
106 # uncomment to prevent HUNGRY learning of rhs with whitespace
107 #return if (!$addressed and $lhs =~ /\s+/);
108 &::DEBUG("doStatement: $in:$lhs:$mhs:$rhs");
110 &status("statement: <$who> $message");
112 # change "#*#" back to '*' because of '\' sar to '#blah#'.
113 $lhs =~ s/\#(\S+)\#/$1/g;
114 $rhs =~ s/\#(\S+)\#/$1/g;
116 $lhs =~ s/\?+\s*$//; # strip off '?'.
118 # verify the update statement whether there are any weird
120 ### this can be simplified.
121 for my $temp ($lhs,$rhs ) {
122 $temp = decode_utf8($temp);
123 if ($temp =~ /([^[:print:]])/ or $temp =~ /\N{U+FFFD}/) {
124 &status("statement: illegal character '$1' ".ord($1).".");
125 &performAddressedReply(
126 "i'm not going to learn illegal characters");
131 return if ( &update( $lhs, $mhs, $rhs ) );
139 # vim:ts=4:sw=4:expandtab:tw=80