You cannot select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
219 lines
6.1 KiB
Perl
219 lines
6.1 KiB
Perl
|
|
# infobot :: Kevin Lenzo (c) 1997
|
|
|
|
##
|
|
## doStatement --
|
|
##
|
|
## decide if $in is a statement, and if so,
|
|
## - update the dbm
|
|
## - return feedback statement
|
|
##
|
|
## otherwise return null.
|
|
##
|
|
|
|
sub doStatement {
|
|
return '' if (lc($who) eq lc($param{'nick'}));
|
|
|
|
my($msgType, $in) = @_;
|
|
|
|
$in =~ s/\\(\S+)/\#$1\#/g;
|
|
|
|
# switch person
|
|
|
|
$in =~ s/(^|\s)i am /$1$who is /i;
|
|
$in =~ s/(^|\s)my /$1$who\'s /ig;
|
|
$in =~ s/(^|\s)your /$1$param{'ident'}\'s /ig;
|
|
|
|
if ($addressed) {
|
|
$in =~ s/(^|\s)you are /$1$param{'ident'} is /i;
|
|
}
|
|
|
|
$in =~ s/^no,\s+//i; # don't want to complain if it's new but negative
|
|
|
|
|
|
if (getparam('plusplus')) {
|
|
$in =~ s/\W(--|\+\+)(\(.*?\)|[^(++)(--)\s]+)/$2$1/;
|
|
|
|
# Hacked to allow multiple karma per line and to fix
|
|
# related issues. foo++foo++ no longer becomes
|
|
# foofoo++++. - Masque, 12Apr2K
|
|
# ...and to allow only one karma point per item
|
|
# per line. - Masque, 13Apr2K
|
|
|
|
my %k_limit;
|
|
|
|
while ($in =~ s/(\(.*?\)|[^(++)(--)\s]+)(\+\+|--)//) {
|
|
my($term,$inc) = ($1,$2);
|
|
$term = lc($term);
|
|
next if exists $k_limit{$term};
|
|
$k_limit{$term} = 1;
|
|
|
|
# try to normalize phrases
|
|
$term =~ s/^\((.*)\)$/$1/;
|
|
$term =~ s/\s+/ /g;
|
|
|
|
if ($msgType !~ /public/i) {
|
|
&msg($who, "karma must be done in public!");
|
|
return "NOREPLY";
|
|
}
|
|
|
|
if (lc($term) eq lc($who)) {
|
|
&msg($who, "please don't karma yourself");
|
|
return 'NOREPLY';
|
|
}
|
|
|
|
# Whoops! Better make sure that we're adding karma to something existant.
|
|
next if $term eq "";
|
|
|
|
if ($inc eq '++') {
|
|
&postInc(plusplus => $term);
|
|
} elsif ($inc eq '--') {
|
|
&postDec(plusplus => $term);
|
|
}
|
|
}
|
|
return 'NOREPLY' if $karma;
|
|
}
|
|
|
|
my($theType);
|
|
my($lhs, $mhs, $rhs); # left hand side, uh.. middlehand side...
|
|
|
|
# the unignore hack...
|
|
# if we see this word, unignore all
|
|
my $magicword=getparam('unignoreWord');
|
|
if ($in =~ /$magicword/i) {
|
|
&clearAll('ignore');
|
|
&status("unignoring all ($who said the word)");
|
|
}
|
|
|
|
# check if we need to be addressed and if we are
|
|
if ((getparam('addressing') eq 'REQUIRE') && !$addressed) {
|
|
return 'NOREPLY';
|
|
}
|
|
|
|
# prefix www with http:// and ftp with ftp://
|
|
$in =~ s/ www\./ http:\/\/www\./ig;
|
|
$in =~ s/ ftp\./ ftp:\/\/ftp\./ig;
|
|
|
|
# look for a "type nugget". this should be externalized.
|
|
$theType = "";
|
|
$theType = "mailto" if ($in =~ /\bmailto:.+\@.+\..{2,}/i);
|
|
$theType = "mailto" if ($in =~ s/\b(\S+\@\S+\.\S{2,})/mailto:$1/gi);
|
|
$in =~ s/(mailto:)+/mailto:/g;
|
|
|
|
$theType = "about" if ($in =~ /\babout:/i);
|
|
$theType = 'afp' if ($in =~ /\bafp:/);
|
|
$theType = 'file' if ($in =~ /\bfile:/);
|
|
$theType = 'palace' if ($in =~ /\bpalace:/);
|
|
$theType = 'phoneto' if ($in =~ /\bphone(to)?:/);
|
|
if ($in =~ /\b(news|http|ftp|gopher|telnet):\s*\/\/[\-\w]+(\.[\-\w]+)+/) {
|
|
$theType = $1;
|
|
}
|
|
|
|
# here's where you set the behaviour.
|
|
if ((getparam('acceptUrl') =~ /\d+/) && $addressed
|
|
&& (getparam('acceptUrl') < $theUserLevel)) {
|
|
} else {
|
|
if (getparam('acceptUrl') eq 'REQUIRE') {
|
|
# require url type.
|
|
# &status("REJECTED non-URL entry") if ($param{VERBOSITY});
|
|
return 'NOREPLY' if ($theType eq "");
|
|
} elsif (getparam('acceptUrl') eq 'REJECT') {
|
|
&status("REJECTED URL entry") if ($param{VERBOSITY});
|
|
return 'NOREPLY' unless ($theType eq "");
|
|
} else {
|
|
# OPTIONAL
|
|
# you could put another filter here
|
|
}
|
|
}
|
|
|
|
# report status somewhere is we're doing that
|
|
&status("type $theType: $in") if $theType;
|
|
|
|
foreach $item (@verb) { # check for verb
|
|
if ($in =~ /(^|\s)$item(\s|$)/i) {
|
|
($lhs, $mhs, $rhs) = ($`, $&, $');
|
|
$lhs =~ tr/A-Z/a-z/;
|
|
$lhs =~ s/^\s*(the|da|an?)\s+//i; # discard article
|
|
$lhs =~ s/^\s*(.*?)\s*$/$1/;
|
|
$mhs =~ s/^\s*(.*?)\s*$/$1/;
|
|
$rhs =~ s/^\s*(.*?)\s*$/$1/;
|
|
|
|
# note : prevent access to globals in the eval
|
|
return '' unless ($lhs and $rhs);
|
|
|
|
my $maxkey = getparam("maxKeySize");
|
|
return "The key is too long (> $maxkey chars)."
|
|
if (length($lhs) > $maxkey);
|
|
|
|
if (length($message) > getparam('maxDataSize')) {
|
|
if ($msgType =~ /public/) {
|
|
if ($addressed) {
|
|
if (rand() > 0.5) {
|
|
&performSay("that entry is too long, ".$who);
|
|
} else {
|
|
&performSay("i'm sorry, but that entry is too long, $who");
|
|
}
|
|
}
|
|
} else {
|
|
&msg($who, "The text is too long");
|
|
}
|
|
return '';
|
|
}
|
|
|
|
return 'NOREPLY' if ($lhs eq 'NOREPLY');
|
|
|
|
my $failed = 0;
|
|
$lhs =~ /^(who|what|when|where|why|how)$/ and $failed++;
|
|
|
|
if (!$failed and !$addressed) {
|
|
# the arsenal of things to ignore if we aren't addressed directly
|
|
|
|
$lhs =~ /^(who|what|when|where|why|how|it) /i and $failed++;
|
|
$lhs =~ /^(this|that|these|those|they|you) /i and $failed++;
|
|
$lhs =~ /^(every(one|body)|we) /i and $failed++;
|
|
|
|
$lhs =~ /^\s*\*/ and $failed++; # server message
|
|
$lhs =~ /^\s*<+[-=]+/ and $failed++; # <--- arrows
|
|
$lhs =~ /^[\[<\(]\w+[\]>\)]/ and $failed++; # [nick] from bots
|
|
$lhs =~ /^heya?,? / and $failed++; # greetings
|
|
$lhs =~ /^\s*th(is|at|ere|ese|ose|ey)/i and $failed++; # contextless
|
|
$lhs =~ /^\s*it\'?s?\W/i and $failed++; # contextless clitic
|
|
$lhs =~ /^\s*if /i and $failed++; # hypothetical
|
|
$lhs =~ /^\s*how\W/i and $failed++; # too much trouble for now
|
|
$lhs =~ /^\s*why\W/i and $failed++; # too much trouble for now
|
|
$lhs =~ /^\s*h(is|er) /i and $failed++; # her name is
|
|
$lhs =~ /^\s*\D[\d\w]*\.{2,}/ and $failed++; # x...
|
|
$lhs =~ /^\s*so is/i and $failed++; # so is (no referent)
|
|
$lhs =~ /^\s*s+o+r+[ye]+\b/i and $failed++; # sorry
|
|
$lhs =~ /^\s*supposedly/i and $failed++;
|
|
$lhs =~ /^all / and $failed++; # all you have to do, all you guys...
|
|
} elsif (!$failed and $addressed) {
|
|
# things to skip if we ARE addressed
|
|
}
|
|
|
|
if ($failed) {
|
|
&status("statement: IGNORED <$who> $message");
|
|
return 'NOREPLY';
|
|
}
|
|
|
|
&status("statement: <$who> $message");
|
|
|
|
$lhs =~ s/\#(\S+)\#/$1/g;
|
|
# Avi++
|
|
$rhs =~ s/\#\|\#/\\\|/g;
|
|
$rhs =~ s/\#(\S+)\#/$1/g;
|
|
|
|
$lhs =~ s/\?+\s*$//; # strip the ? off the key
|
|
$lhs = &update($lhs, $mhs, $rhs);
|
|
|
|
return 'NOREPLY' if ($lhs eq 'NOREPLY');
|
|
|
|
last;
|
|
}
|
|
}
|
|
|
|
$lhs;
|
|
}
|
|
|
|
1;
|