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.
819 lines
21 KiB
Raku
819 lines
21 KiB
Raku
# Infobot extensions inside the distribution.
|
|
# Local extensions go in myRoutines.pl
|
|
|
|
# Kevin A. Lenzo
|
|
|
|
sub Extras {
|
|
# called after it decides if it's been addressed.
|
|
# you have access tothe global variables here,
|
|
# which is bad, but anyway.
|
|
|
|
# you can return 'NOREPLY' if you want to stop
|
|
# processing past this point but don't want
|
|
# an answer. if you don't return NOREPLY, it
|
|
# will let all the rest of the default processing
|
|
# go to it. think of it as 'catching' the event.
|
|
|
|
# $addressed is whether the infobot has been
|
|
# named or, if a private or standalone
|
|
# context, addressed is always 'true'
|
|
|
|
# $msgType can be 'public', 'private', maybe 'dcc_chat'
|
|
|
|
# $who is the sender of the message
|
|
|
|
# $message is the current state of the input, after
|
|
# the addressing stuff stripped off the name
|
|
|
|
# $origMessage is the text of the original message before
|
|
# any normalization or processing
|
|
|
|
# you have access to all the routines in urlIrc.pl too,
|
|
# of course.
|
|
|
|
# -- this section moved from Process.pl -- kl
|
|
|
|
if ($addressed and $message =~ m|^\s*(.*?)\s+=~\s+s\/(.+?)\/(.*?)\/([a-z]*);?\s*$|) {
|
|
# substitution: X =~ s/A/B/
|
|
|
|
my ($X, $oldpiece, $newpiece, $flags) = ($1, $2, $3, $4);
|
|
my $matched = 0;
|
|
my $subst = 0;
|
|
my $op = quotemeta($oldpiece);
|
|
my $np = $newpiece;
|
|
$X = lc($X);
|
|
|
|
foreach $d ("is","are") {
|
|
if ($r = get($d, $X)) {
|
|
my $old = $r;
|
|
$matched++;
|
|
if ($r =~ s/$op/$np/i) {
|
|
if (length($r) > getparam('maxDataSize')) {
|
|
if ($msgType =~ /private/) {
|
|
&msg($who, "That's too long, $who");
|
|
} else {
|
|
&say("That's too long, $who");
|
|
}
|
|
return 'NOREPLY';
|
|
}
|
|
set($d, $X, $r);
|
|
&status("update: '$X =$d=> $r'; was '$old'");
|
|
$subst++;
|
|
}
|
|
}
|
|
}
|
|
if ($matched) {
|
|
if ($subst) {
|
|
if ($msgType =~ /private/) {
|
|
&msg($who, "OK, $who");
|
|
} else {
|
|
&say("OK, $who");
|
|
}
|
|
return 'NOREPLY';
|
|
} else {
|
|
if ($msgType =~ /private/) {
|
|
&msg($who, "That doesn't contain '$oldpiece'");
|
|
} else {
|
|
&say("That doesn't contain '$oldpiece', $who");
|
|
}
|
|
}
|
|
} else {
|
|
if ($msgType =~ /private/) {
|
|
&msg($who, "I didn't have anything matching '$X'");
|
|
} else {
|
|
&say("I didn't have anything matching '$X', $who");
|
|
}
|
|
}
|
|
return 'NOREPLY';
|
|
} # end substitution
|
|
|
|
if ($addressed and IsFlag("S")) {
|
|
if ($message =~ s/^\s*say\s+(\S+)\s+(.*)//) {
|
|
&msg($1, $2);
|
|
&msg($who, "ok.");
|
|
return 'NOREPLY';
|
|
}
|
|
}
|
|
|
|
if (($addressed) && ($message =~ /^\s*help\b/i)) {
|
|
$message =~ s/^\s*help\s*//i;
|
|
$message =~ s/\W+$//;
|
|
&help($message);
|
|
return 'NOREPLY';
|
|
}
|
|
|
|
if ($message =~ s/^forget\s+((a|an|the)\s+)?//i) {
|
|
# cut off final punctuation
|
|
$message =~ s/[.!?]+$//;
|
|
#return 'no authorization to lobotomize';
|
|
#}
|
|
$k = &normquery($message);
|
|
$k = lc($k);
|
|
|
|
$found = 0;
|
|
|
|
foreach $d ("is", "are") {
|
|
if ($r = get($d, $k)) {
|
|
if (IsFlag("r") ne "r") {
|
|
performReply("you have no access to remove factoids");
|
|
return 'NOREPLY';
|
|
}
|
|
$found = 1 ;
|
|
&status("forget: <$who> $k =$d=> $r");
|
|
clear($d, $k);
|
|
$factoidCount--;
|
|
}
|
|
}
|
|
if ($found == 1) {
|
|
if ($msgType !~ /public/) {
|
|
&msg($who, "$who: I forgot $k");
|
|
} else {
|
|
&say("$who: I forgot $k");
|
|
}
|
|
$l = $who; $l =~ s/^=//;
|
|
$updateCount++;
|
|
return 'NOREPLY';
|
|
} else {
|
|
if ($msgType !~ /public/) {
|
|
&msg($who, "I didn't have anything matching $k");
|
|
return 'NOREPLY';
|
|
} else {
|
|
if ($addressed > 0) {
|
|
&say("$who, I didn't have anything matching $k");
|
|
return 'NOREPLY';
|
|
}
|
|
}
|
|
}
|
|
} # end forget
|
|
|
|
|
|
# Aldebaran++ !
|
|
if (getparam("shutup") and $message =~ /^\s*wake\s*up\s*$/i ) {
|
|
if ($msgType =~ /public/) {
|
|
if ($addressed) {
|
|
if (rand() > 0.5) {
|
|
&performSay("Ok, ".$who.", I'll start talking.");
|
|
&status("Changing to Optional mode");
|
|
# Oh shit. - Simon
|
|
$chanopts{Channel()}->{'addressing'} = 'OPTIONAL';
|
|
return 'NOREPLY';
|
|
} else {
|
|
&performSay(":O");
|
|
return 'NOREPLY';
|
|
}
|
|
}
|
|
} else {
|
|
&msg($who, "OK, I'll start talking.");
|
|
$param{'addressing'} = 'OPTIONAL';
|
|
&status("Changing to Optional mode");
|
|
return 'NOREPLY';
|
|
}
|
|
} # end wake up
|
|
|
|
if ($param{"shutup"} and $message =~ /^\s*shut\s*up\s*$/i ) {
|
|
if ($msgType =~ /public/) {
|
|
if ($addressed) {
|
|
if (rand() > 0.5) {
|
|
&performSay("Sorry, ".$who.", I'll keep my mouth shut. ");
|
|
$chanopts{Channel()}->{'addressing'} = 'REQUIRE';
|
|
&status("Changing to Require mode");
|
|
return 'NOREPLY';
|
|
} else {
|
|
&performSay(":X");
|
|
return 'NOREPLY';
|
|
}
|
|
}
|
|
} else {
|
|
&msg($who, "Sorry, I'll try to be quiet.");
|
|
$param{'addressing'} = 'REQUIRE';
|
|
&status("Changing to Require mode");
|
|
return 'NOREPLY';
|
|
}
|
|
} # end shut up
|
|
|
|
# -- from here down, 'tell' needs to be worked into the forkers.
|
|
# anything that just returns a value will be handled automatically,
|
|
# but anything that forks will require special handling.
|
|
|
|
# mendel++
|
|
if (getparam('zippy')) {
|
|
if (my $resp = zippy::get($message)) {
|
|
return $resp;
|
|
}
|
|
}
|
|
|
|
# Masque++
|
|
my $triggers = getparam("purldoc_trigger") if getparam('purldoc');
|
|
if (defined getparam('purldoc') and $message =~ s/^\s*$triggers\s+-?(\w+)/$1/) {
|
|
return &purldoc();
|
|
}
|
|
|
|
# from Chris Tessone: slashdot headlines
|
|
# "slashdot" or "slashdot headlines"
|
|
|
|
if (defined(getparam('slash')) and $message =~
|
|
/^\s*slashdot( headlines)?\W*\s*$/) {
|
|
my $headlines = &getslashdotheads();
|
|
return $headlines;
|
|
}
|
|
|
|
# internic or RIPE whois
|
|
if (getparam('allowInternic')) {
|
|
if ($message =~ /^(internic|ripe)(?: for)?\s+(\S+)$/i) {
|
|
my $where = $1;
|
|
my $what = $2;
|
|
&domain_summary($what, $where);
|
|
|
|
return 'NOREPLY';
|
|
}
|
|
}
|
|
|
|
# currency exchanger, bobby@bofh.dk
|
|
if( defined(getparam('exchange'))
|
|
and getparam('exchange')
|
|
and ( $message =~ /^\s*(?:ex)?change\s+/i or $message =~ /^\s*currenc(?:ies|y) for\s/i )){
|
|
|
|
&status("message($message)");
|
|
my $response='';
|
|
|
|
if ($pid = fork) {
|
|
# this takes some time, so fork.
|
|
return 'NOREPLY';
|
|
}
|
|
|
|
if ($message =~ /^\s*(?:ex)?change\s+([\d\.\,]+)\s+(\S+)\s+(?:into|to|for)\s+(\S+)/i) {
|
|
my($Amount,$From,$To) = ($1,$2,$3);
|
|
$From = uc $From; $To = uc $To;
|
|
&status("calling exchange($From, $To, $Amount) ...");
|
|
$response = &exchange($From, $To, $Amount);
|
|
# Change Finland, purl! No no. How about 'currency for'.
|
|
# } elsif( $message =~ /^\s*(?:ex)?change ([\w\s]+)/) {
|
|
} elsif( $message =~ /^\s*currenc(?:ies|y) for\s(?:the\s)?([\w\s]+)/i ) {
|
|
# looking up the currency for a country
|
|
my $Country = $1;
|
|
&status("calling exchange($Country) ...");
|
|
$response = &exchange($Country);
|
|
} else {
|
|
$response = "that doesn't look right";
|
|
}
|
|
|
|
&status("exchange got response($response)");
|
|
|
|
if($response =~ /^EXCHANGE: \S*/) {
|
|
&status($response);
|
|
} elsif ($msgType eq 'public') {
|
|
&say("$who: $response");
|
|
} else{
|
|
&msg($who, $response);
|
|
}
|
|
|
|
# exit the child or it gets weird
|
|
exit 0;
|
|
} # end excange
|
|
|
|
# Jonathan Feinberg's babel-bot -- jdf++
|
|
if (defined getparam('babel') &&
|
|
(1 or $addressed) &&
|
|
$message =~ m{
|
|
^\s*
|
|
(?:babel(?:fish)?|x|xlate|translate)
|
|
\s+
|
|
(to|from) # direction of translation (through)
|
|
\s+
|
|
($babel::lang_regex)\w* # which language?
|
|
\s*
|
|
(.+) # The phrase to be translated
|
|
}xoi) {
|
|
my $whom = $who; # building a closure, need lexical
|
|
my $callback = $msgType eq 'public' ?
|
|
sub{say("$who: $_[0]")} : sub{msg($who, $_[0])};
|
|
&babel::forking_babelfish(lc $1, lc $2, $3, $callback);
|
|
return 'NOREPLY';
|
|
} # end babel
|
|
|
|
# insult server. patch thanks to michael@limit.org
|
|
if (getparam('insult') and ($message =~ /^\s*insult (.*)\s*$/)) {
|
|
my $person = $1;
|
|
my $language = "english";
|
|
# Could have SWORN Simon patched this. Simon++ for the fix, either way. - 3Jul2K, Masque
|
|
# > purl, insult mountain dew
|
|
# <purl> mounta ist nichts aber ein gegorener Stapel des squishy Programmfehlerspit.
|
|
# if ($person =~ s/ in \s*($babel::lang_regex)\w*\s*$//xi) {
|
|
if ($person =~ s/ in \s*($babel::lang_regex)\w*\s*$//i) {
|
|
$language = lc($1);
|
|
}
|
|
$person = $who if $person =~ /^\s*me\s*$/i;
|
|
|
|
my $insult = &insult();
|
|
if ($person ne $who) {
|
|
$insult =~ s/^\s*You are/$person is/i;
|
|
}
|
|
|
|
if ($insult =~ /\S/) {
|
|
if (getparam('babel') and ($language ne "english")) {
|
|
my $whom = $who; # building a closure, need lexical
|
|
my $callback = $msgType eq 'public' ?
|
|
sub{say("$_[0]")} : sub{msg($whom, $_[0])};
|
|
&babel::forking_babelfish("to", $language, $insult, $callback);
|
|
return 'NOREPLY';
|
|
}
|
|
} else {
|
|
$insult = "No luck, $who";
|
|
}
|
|
|
|
return $insult;
|
|
} # end insult
|
|
|
|
if (getparam('weather') and ($message =~ /^\s*weather\s+(?:for\s+)?(.*?)\s*\?*\s*$/)) {
|
|
my $code = $1;
|
|
my $weath ;
|
|
if ($code =~ /^[a-zA-Z][a-zA-Z0-9]{3,4}$/) {
|
|
$weath = &Weather::NOAA::get($code);
|
|
} else {
|
|
$weath = "Try a 4-letter station code (see http://weather.noaa.gov/weather/curcond.html for locations and codes)";
|
|
}
|
|
# if ($msgType eq 'public') {
|
|
# &say("$who: $weath");
|
|
# } else {
|
|
&msg($who, $weath);
|
|
# }
|
|
return 'NOREPLY';
|
|
}
|
|
|
|
# This replaced 'metar'. Lotsa aviation stuff. Go look.
|
|
if(defined(getparam('aviation') or defined(getparam('metar'))) and
|
|
$message =~ /^(metar |
|
|
taf |
|
|
great[-\s]?circle |
|
|
zulutime |
|
|
tsd |
|
|
airport |
|
|
aviation)/xi)
|
|
{
|
|
my $callback = $msgType eq 'public' ?
|
|
sub{say("$who: $_[0]")} : sub{msg($who, $_[0])};
|
|
&Aviation::get($message, $callback);
|
|
return 'NOREPLY';
|
|
}
|
|
|
|
# from Simon: google searching
|
|
# modified to fork and generally search by oznoid
|
|
|
|
if(defined(getparam('wwwsearch')) and $message =~
|
|
/^\s*
|
|
(?:search\s+)?
|
|
($W3Search::regex)
|
|
\s+for\s+
|
|
[\'\"]?(.*?)[\'\"]?
|
|
\s*\?*\s*$
|
|
/ix ) {
|
|
my $callback = $msgType eq 'public' ?
|
|
sub{say("$who: $_[0]")} : sub{msg($who, $_[0])};
|
|
&W3Search::forking_W3Search($1,$2,getparam('wwwsearch'), $callback);
|
|
return 'NOREPLY';
|
|
}
|
|
|
|
# Adam Spiers' nickometer
|
|
if ($message =~ /^\s*(?:lame|nick)-?o-?meter(?: for)? (\S+)/i) {
|
|
my $term = $1;
|
|
if (lc($term) eq 'me') {
|
|
$term = $who;
|
|
}
|
|
|
|
$term =~ s/\?+\s*//;
|
|
|
|
my $percentage = &nickometer($term);
|
|
|
|
if ($percentage =~ /NaN/) {
|
|
$percentage = "off the scale";
|
|
} else {
|
|
# $percentage = sprintf("%0.4f", $percentage);
|
|
$percentage =~ s/\.0+$//;
|
|
$percentage .= '%';
|
|
}
|
|
|
|
if ($msgType eq 'public') {
|
|
&say("'$term' is $percentage lame, $who");
|
|
} else {
|
|
&msg($who, "the 'lame nick-o-meter' reading for $term is $percentage, $who");
|
|
}
|
|
|
|
return 'NOREPLY';
|
|
} # end nick-o-meter
|
|
|
|
if ($message =~ /^foldoc(?: for)?\s+(.*)/i) {
|
|
my ($terms) = $1;
|
|
$terms =~ s/\?\W*$//;
|
|
|
|
my $key= $terms;
|
|
$key =~ s/\s+$//;
|
|
$key =~ s/^\s+//;
|
|
$key =~ s/\W+/+/g;
|
|
|
|
my $reply = "$terms may be sought in foldoc at http://wombat.doc.ic.ac.uk/foldoc/foldoc.cgi?query=$key";
|
|
|
|
return $reply;
|
|
}
|
|
|
|
if ($message =~ /^(?:quote|stock price)(?: of| for)? ([A-Z]{1,6})\?*$/) {
|
|
my $reply = "stock quotes for $1 may be sought at http://quote.yahoo.com/q?s=$1\&d=v1";
|
|
|
|
return $reply;
|
|
}
|
|
|
|
if ($message =~ /^rot13\s+(.*)/i) {
|
|
# rot13 it
|
|
my $reply = $1;
|
|
$reply =~ y/A-Za-z/N-ZA-Mn-za-m/;
|
|
return $reply;
|
|
}
|
|
|
|
# search imdb
|
|
if ($message =~ s/^\s*(search )?imdb (for )?//) {
|
|
$check = $message;
|
|
my $url = $message;
|
|
|
|
# freeside++ for URL cleanup code
|
|
|
|
my $date = "";
|
|
if ($url =~ s/( \(\d+\))$//) { $date = $1; }
|
|
$url =~ s/^(The|A|An|Les) (.*)/$2, $1/i;
|
|
$url = "http://www.imdb.com/M/title-substring?title=$url$date&type=fuzzy";
|
|
$url =~ s/ /+/g;
|
|
$V = "-> "; $orig_lhs = $message; $theVerb= "is";
|
|
return "$message can be found at $url";
|
|
} # end imdb
|
|
|
|
if ($message =~ s/^\s*(search )?hyperarchive (for )?//) {
|
|
$message =~ /\w+/;
|
|
$check = $message;
|
|
my $q = $message;
|
|
$q =~ s/\W+//g;
|
|
$result = "http://hyperarchive.lcs.mit.edu/cgi-bin/NewSearch?key=$q";
|
|
$V = "-> "; $orig_lhs = $message; $theVerb= "is";
|
|
return "$message may be sought at $result";
|
|
}
|
|
|
|
# websters
|
|
if ($message =~ s/^\s*(search )?websters* (for )?//) {
|
|
$message =~ /\w+/;
|
|
$word = $&;
|
|
$check = $message;
|
|
my $q = $message;
|
|
$q =~ s/\W+/+/g;
|
|
$result = "http://work.ucsd.edu:5141/cgi-bin/http_webster?$word";
|
|
$V = "-> "; $orig_lhs = $message; $theVerb= "is";
|
|
return "$message may be sought at $result";
|
|
} # end websters
|
|
|
|
# -- from Question
|
|
|
|
# Now with INTENSE CASE INSENSITIVITY! SUNDAY SUNDAY SUNDAY!
|
|
if ($message =~ /^seen (\S+)/i) {
|
|
my $person = $1;
|
|
$person =~ s/\?*\s*$//;
|
|
my $seen = &get(seen => lc $person);
|
|
if ($seen) {
|
|
my ($when,$where,$what) = split /$;/, $seen;
|
|
my $howlong = time() - $when;
|
|
$when = localtime $when;
|
|
|
|
my $tstring = ($howlong % 60). " seconds ago";
|
|
$howlong = int($howlong / 60);
|
|
|
|
if ($howlong % 60) {
|
|
$tstring = ($howlong % 60). " minutes and $tstring";
|
|
}
|
|
$howlong = int($howlong / 60);
|
|
|
|
if ($howlong % 24) {
|
|
$tstring = ($howlong % 24). " hours, $tstring";
|
|
}
|
|
$howlong = int($howlong / 24);
|
|
|
|
if ($howlong % 365) {
|
|
$tstring = ($howlong % 365). " days, $tstring";
|
|
}
|
|
$howlong = int($howlong / 365);
|
|
if ($howlong > 0) {
|
|
$tstring = "$howlong years, $tstring";
|
|
}
|
|
|
|
if ($msgType =~ /public/) {
|
|
&performSay("$person was last seen on $where $tstring, saying: $what [$when]");
|
|
} else {
|
|
&msg($who, "$person was last seen on $where $tstring, saying: $what [$when]");
|
|
}
|
|
return 'NOREPLY';
|
|
}
|
|
|
|
if ($msgType =~ /public/) {
|
|
&performSay("I haven't seen '$person', $who");
|
|
} else {
|
|
&msg($who,"I haven't seen '$person', $who");
|
|
}
|
|
return 'NOREPLY';
|
|
}
|
|
|
|
if ($message =~ /^\s*heya?,? /) {
|
|
return 'NOREPLY' unless $addressed;
|
|
}
|
|
|
|
# Gotta be gender-neutral here... we're sensitive to purl's needs. :-)
|
|
if ($message =~ /(good(\s+fuckin[\'g]?)?\s+(bo(t|y)|g([ui]|r+)rl))|(bot(\s|\-)?snack)/i) {
|
|
&status("random praise [$msgType,$addressed]: $message");
|
|
if ($msgType =~ /public/) {
|
|
if ($addressed) {
|
|
if (rand() < .5) {
|
|
&performSay("thanks $who :)");
|
|
} else {
|
|
&performSay(":)");
|
|
}
|
|
}
|
|
} else {
|
|
&msg($who, ":)");
|
|
}
|
|
return 'NOREPLY';
|
|
}
|
|
|
|
if ($addressed) {
|
|
if ($message =~ /you (rock|rocks|rewl|rule|are so+ co+l)/) {
|
|
if ($msgType =~ /public/) {
|
|
if (rand() < .5) {
|
|
&performSay("thanks $who :)");
|
|
} else {
|
|
&performSay(":)");
|
|
}
|
|
return 'NOREPLY';
|
|
} else {
|
|
&msg($who, ":)");
|
|
}
|
|
}
|
|
if ($message =~ /thank(s| you)/i) {
|
|
if ($msgType =~ /public/) {
|
|
if (rand() < .5) {
|
|
&performSay($welcomes[int(rand(@welcomes))]." ".$who);
|
|
} else {
|
|
&performSay($who.": ".$welcomes[int(rand(@welcomes))]);
|
|
}
|
|
} else {
|
|
if (rand() < .5) {
|
|
&msg($who, $welcomes[int(rand(@welcomes))].", ".$who);
|
|
} else {
|
|
&msg($who, $welcomes[int(rand(@welcomes))]);
|
|
}
|
|
}
|
|
return 'NOREPLY';
|
|
}
|
|
}
|
|
|
|
if ($message =~ /^\s*(h(ello|i( there)?|owdy|ey|ola)|salut|bonjour|niihau|que\s*tal)( $param{nick})?\s*$/i) {
|
|
if (!$addressed and rand() > 0.35) {
|
|
# 65% chance of replying to a random greeting when not addressed
|
|
return 'NOREPLY';
|
|
}
|
|
|
|
my($r) = $hello[int(rand(@hello))];
|
|
if ($msgType =~ /public/) {
|
|
&performSay($r.", $who");
|
|
} else {
|
|
&msg($who, $r);
|
|
}
|
|
return 'NOREPLY';
|
|
}
|
|
|
|
if (($message =~ /^\s*(?:nslookup|dns)(?: for)?\s+(\S+)$/i) and getparam('allowDNS')) {
|
|
&status("DNS Lookup: $1");
|
|
&DNS($1);
|
|
return 'NOREPLY';
|
|
}
|
|
|
|
if (getparam('ispell') and ($message =~ s/^spell(ing)? (?:of |for )?//)) {
|
|
&status("Spell: $message");
|
|
&ispell($message);
|
|
return 'NOREPLY';
|
|
}
|
|
|
|
if (($message =~ /^traceroute (\S+)$/i) and getparam("allowTraceroute")) {
|
|
&status("traceroute to $1");
|
|
&troute($1);
|
|
return 'NOREPLY';
|
|
}
|
|
|
|
if ($message =~ /^crypt\s*\(\s*(\S+)\s*(?:,| )\s*(\S+)/) {
|
|
my $cr = crypt($1, $2);
|
|
if ($msgType =~ /private/) {
|
|
&msg($who, $cr);
|
|
} else {
|
|
&performSay($cr);
|
|
}
|
|
return 'NOREPLY';
|
|
}
|
|
|
|
# may not want to cut off all: all i know is ...
|
|
# but for now seem mostly content-free
|
|
|
|
if (getparam('allowLeave') =~ /$msgType/) {
|
|
if ($message =~ /(leave|part) ((\#|\&)\S+)/i) {
|
|
if (IsFlag("o") or $addressed) {
|
|
if (IsFlag("c") ne "c") {
|
|
&performReply("you don't have the channel flag");
|
|
return 'NOREPLY';
|
|
}
|
|
&channel($2);
|
|
&performSay("goodbye, $who.");
|
|
&status("PART $2 <$who>");
|
|
&part($2);
|
|
return 'NOREPLY';
|
|
}
|
|
}
|
|
}
|
|
|
|
if ($msgType !~ /public/) {
|
|
# accept only msgs leaves/joins
|
|
my($ok_to_join);
|
|
|
|
if ($message =~ /join ([\&\#]\S+)(?:\s+(\S+))?/i) {
|
|
# Thanks to Eden Li (tile) for the channel key patch
|
|
my($which, $key) = ($1, $2);
|
|
$key = defined ($key) ? " $key" : "";
|
|
foreach $chan (split(/\s+/, $param{'allowed_channels'})) {
|
|
if (lc($which) eq lc($chan)) {
|
|
$ok_to_join = $which . $key;
|
|
last;
|
|
}
|
|
}
|
|
if (IsFlag("o")) { $ok_to_join = $which.$key };
|
|
if ($ok_to_join) {
|
|
if (IsFlag("c") ne "c") {
|
|
&msg($who, "You don't have the channel flag");
|
|
return 'NOREPLY';
|
|
}
|
|
joinChan($ok_to_join);
|
|
&status("JOIN $ok_to_join <$who>");
|
|
&msg($who, "joining $ok_to_join")
|
|
unless ($channel eq &channel());
|
|
sleep(1);
|
|
# my $temp = &channel();
|
|
# &performSay("hello, $who.");
|
|
# &channel($temp);
|
|
return 'NOREPLY';
|
|
} else {
|
|
&msg($who, "I am not allowed to join that channel.");
|
|
return 'NOREPLY';
|
|
}
|
|
}
|
|
}
|
|
|
|
if (IsFlag("s") eq "s") {
|
|
if ($message =~ /^\s*(scan|search)\s*for\s+/i) {
|
|
if ($^O =~ /(win|mac)/i) {
|
|
# can't fork
|
|
&search($message);
|
|
} else {
|
|
&status("forking off: $message");
|
|
if (my $cpid = fork) {
|
|
# do nothing if we're the parent
|
|
} else {
|
|
# we're the child
|
|
&search($message);
|
|
&status("child exit: $message");
|
|
exit 0;
|
|
}
|
|
}
|
|
return 'NOREPLY';
|
|
}
|
|
}
|
|
|
|
if (getparam('allowConv')) {
|
|
if ($message =~ /^\s*(asci*|chr) (\d+)\s*$/) {
|
|
$num = $2;
|
|
if ($num < 32) {
|
|
$num += 64;
|
|
$res = "^".chr($num);
|
|
} else {
|
|
$res = chr($2);
|
|
}
|
|
if ($num == 0) { $res = "NULL"; } ;
|
|
return "ascii ".$2." is \'".$res."\'";
|
|
}
|
|
if ($message =~ /^\s*ord (.)\s*$/) {
|
|
$res = $1;
|
|
if (ord($res) < 32) {
|
|
$res = chr(ord($res) + 64);
|
|
if ($res eq chr(64)) {
|
|
$res = 'NULL';
|
|
} else {
|
|
$res = '^'.$res;
|
|
}
|
|
}
|
|
return "\'$res\' is ascii ".ord($1);
|
|
}
|
|
}
|
|
|
|
if (getparam('plusplus')) {
|
|
my $message2 = $message;
|
|
|
|
# Fixes the "soandso? has neutral karma" bug. - Masque, 12Apr2k
|
|
if ($message2 =~ s/^(?:karma|score)\s+(?:for\s+)?(.*?)\??$/$1/) {
|
|
|
|
# Some people prefer to have a factoid for their karma.
|
|
# This was the default behavior, pre-0.43.
|
|
$answer = &doQuestion($msgType, $message, $msgFilter);
|
|
return $answer if $answer;
|
|
|
|
$message2 = lc($message2);
|
|
$message2 =~ s/\s+/ /g;
|
|
&status("Karma string is currently \'$message2\'");
|
|
$message2 ||= "blank karma";
|
|
if ($message2 eq "me") {
|
|
$message2 = lc($who);
|
|
}
|
|
my $karma = &get(plusplus => $message2);
|
|
if ($karma) {
|
|
return "$message2 has karma of $karma";
|
|
} else {
|
|
return "$message2 has neutral karma";
|
|
}
|
|
}
|
|
}
|
|
|
|
if (($addressed) && ($message =~ /^statu?s/)) {
|
|
$upString = &timeToString(time()-$startTime);
|
|
$eTime = &get("is", "the qEpochDate");
|
|
return "Since $setup_time, there have been $updateCount "
|
|
. "modifications and $questionCount questions. "
|
|
. "I have been awake for $upString this session, "
|
|
. "and currently reference $factoidCount factoids. "
|
|
. "Addressing is in ".lc(getparam('addressing'))." mode.";
|
|
}
|
|
|
|
# divine added routine (boojum++)
|
|
if ($message =~ /^(8-?ball|divine)\s+(.*)/i) {
|
|
my %m8ball = ('original' => 'shakes the psychic black sphere...',
|
|
'sarcastic' => 'shakes the psychic purple sphere...',
|
|
'userdef' => 'shakes the psychic prismatic sphere...',
|
|
);
|
|
|
|
if (!@m8_answers) {
|
|
my $answer_file = getparam('magic8_answers') || "$param{miscdir}/magic8.txt";
|
|
|
|
print "reading from $answer_file\n";
|
|
|
|
if (open MAGIC8, "<$answer_file") {
|
|
while (<MAGIC8>) {
|
|
chomp;
|
|
push @m8_answers, $_;
|
|
}
|
|
} else {
|
|
@m8_answers = ('the Magic Ball is cloudy or missing a fact file.');
|
|
}
|
|
}
|
|
|
|
my ($type, $reply) = split /\s+=>\s+/, $m8_answers[rand(@m8_answers)];
|
|
|
|
if ($msgType eq 'public') {
|
|
&say("\cAACTION $m8ball{$type}\cA");
|
|
&say("It says '$reply,' $who");
|
|
} else {
|
|
&msg($who, "\cAACTION $m8ball{$type} \cA");
|
|
&msg($who, "It says '$reply'.");
|
|
}
|
|
return 'NOREPLY';
|
|
} # end divine
|
|
|
|
# excuse server. bobby@bofh.dk
|
|
if (getparam('excuse') and
|
|
($message =~ /^\s*(?:give\s+(.*)\s+an\s+excuse|excuse\s*(.*))\s*$/)) {
|
|
&status("excuses...");
|
|
if ($1 ne 'in') {
|
|
$person = $1 || "me";
|
|
}
|
|
|
|
$person = $who if $person =~ /^\s*me\s*$/i;
|
|
|
|
&status("calling &excuse()...");
|
|
my $excuse = "$who: " . &excuse();
|
|
if ($person ne $who) {
|
|
$excuse =~ s/^\s*Your excuse is/$who\'s excuse is/i;
|
|
}
|
|
|
|
if (not $excuse) {
|
|
$excuse = "No luck getting an excuse, $who";
|
|
}
|
|
|
|
if ($msgType eq 'public') {
|
|
&say($excuse);
|
|
} else {
|
|
&msg($who, $excuse);
|
|
}
|
|
return 'NOREPLY';
|
|
} # end excuse
|
|
|
|
return undef;
|
|
}
|
|
|
|
|
|
1;
|
|
|