BotModules/Infobot.bm

   1 # -*- Mode: perl; tab-width: 4; indent-tabs-mode: nil; -*-
   2 ################################
   3 # Infobot Module               #
   4 ################################
   5 # some of these ideas are stolen from infobot, of course.
   6 # see www.infobot.org
   7
   8 package BotModules::Infobot;
   9 use vars qw(@ISA);
  10 @ISA = qw(BotModules);
  11 use AnyDBM_File;
  12 use Fcntl;
  13 1;
  14
  15 # XXX "mozbot is a bot" fails (gets handled as a Tell of "is a bot" :-/)
  16 # XXX "who is foo" responds "I don't know what is foo" (should respond "I don't know _who_ is foo")
  17
  18 # it seems tie() works on scope and not on reference counting, so as
  19 # soon as the thing it is tying goes out of scope (even if the variable
  20 # in question still has active references) it loses its magic.
  21 our $factoids = {'is' => {}, 'are' => {}};
  22 tie(%{$factoids->{'is'}}, 'AnyDBM_File', 'factoids-is', O_RDWR|O_CREAT, 0666);
  23 tie(%{$factoids->{'are'}}, 'AnyDBM_File', 'factoids-are', O_RDWR|O_CREAT, 0666);
  24
  25 sub Help {
  26     my $self = shift;
  27     my ($event) = @_;
  28     return {
  29         '' => 'Keeps track of factoids and returns them on request. '.
  30             'To set factoids, just tell me something in the form \'apple is a company\' or \'apples are fruit\'. '.
  31             'To find out about something, say \'apple?\' or \'what are apples\'. '.
  32             'To correct me, you can use any of: \'no, apple is a fruit\', \'apple =~ s/company/fruit/\', or \'apple is also a fruit\'. '.
  33             'To make me forget a factoid, \'forget apple\'. '.
  34             'You can use \'|\' to separate several alternative answers.',
  35         'who' => 'If a definition contains $who, then it will be replaced by the name of the person who asked the question.',
  36         'reply' => 'If a definition starts with <reply> then when responding the initial prefix will be skipped. '.
  37             'e.g., \'apples are <reply>mm, apples\' will mean that \'what are apples\' will get the response \'mm, apples\'.',
  38         'action' => 'If a definition starts with <action> then when responding the definition will be used as an action. '.
  39             'e.g., \'apples are <action>eats one\' will mean that \'what are apples\' will get the response \'* bot eats one\'.',
  40         'alias' => 'If a definition starts with <alias> then it will be treated as a symlink to whatever follows. '.
  41             'e.g., \'crab apples are <alias>apples\' and \'apples are fruit\' will mean that \'what are crab apples\' will get the response \'apples are fruit\'.',
  42         'status' => 'Reports on how many factoids are in the database.',
  43         'tell' => 'Make me tell someone something. e.g., \'tell pikachu what apples are\' or \'tell fred about me\'.',
  44         'literal' => 'To find out exactly what is stored for an entry apples, you would say to me: literal apples',
  45         'remember' => 'If you are having trouble making me remember something (for example \'well, foo is bar\' '.
  46             'getting treated as \'foo\' is \'bar\'), then you can prefix your statement with \'remember:\' '.
  47             '(following the \'no,\' if you are changing an entry). For example, \'remember: well, foo is bar\'. '.
  48             'Note that \'well, foo?\' is treated as \'what is foo\' not is \'what is well, foo\', so this is not always useful.',
  49         'no' => 'To correct an entry, prefix your statement with \'no,\'. '.
  50             'For example, \'no, I am good\' to correct your entry from \'is bad\' to \'is good\'. :-)',
  51     };
  52 }
  53
  54 # RegisterConfig - Called when initialised, should call registerVariables
  55 sub RegisterConfig {
  56     my $self = shift;
  57     $self->SUPER::RegisterConfig(@_);
  58     $self->registerVariables(
  59       # [ name, save?, settable? ]
  60         ['autoLearn', 1, 1, ['*']], # in the auto* variables, '*' means 'all channels'
  61         ['autoHelp', 1, 1, []],
  62         ['autoEdit', 1, 1, []],
  63         ['neverLearn', 1, 1, []], # the never* variables override the auto* variables
  64         ['neverHelp', 1, 1, []],
  65         ['neverEdit', 1, 1, []],
  66         ['eagerToHelp', 1, 1, 1], # whether to even need the "?" on questions
  67         ['autoIgnore', 1, 1, []], # list of nicks for which to always turn off auto*
  68         ['teachers', 1, 1, []], # list of users who may teach, leave blank to allow anyone to teach
  69         ['factoidPositions', 0, 0, {'is' => {}, 'are' => {}}],
  70         ['friendBots', 1, 1, []],
  71         ['prefixes', 1, 1, ['', 'I have heard that ', '', 'Maybe ', 'I seem to recall that ', '', 'iirc, ', '',
  72                             'Was it not... er, someone, who said: ', '', 'Well, ', 'um... ', 'Oh, I know this one! ',
  73                             '', 'everyone knows that! ', '', 'hmm... I think ', 'well, duh. ']],
  74         ['researchNotes', 0, 0, {}],
  75         ['pruneDelay', 1, 1, 120], # how frequently to look through the research notes and remove expired items
  76         ['queryTimeToLive', 1, 1, 600], # queries can be remembered up to ten minutes by default
  77         ['dunnoTimeToLive', 1, 1, 604800], # DUNNO queries can be remembered up to a week by default
  78         ['noIdeaDelay', 1, 1, 2], # how long to wait before admitting lack of knowledge
  79         ['questions', 0, 0, 0], # how many questions there have been since the last load
  80         ['edits', 0, 0, 0], # how many edits (learning, editing, forgetting) there have been since the last load
  81         ['interbots', 0, 0, 0], # how many times we have spoken with other bots
  82         ['maxInChannel', 1, 1, 200], # beyond this answers are /msged
  83     );
  84 }
  85
  86 # Schedule - called when bot connects to a server, to install any schedulers
  87 # use $self->schedule($event, $delay, $times, $data)
  88 # where $times is 1 for a single event, -1 for recurring events,
  89 # and a positive number for an event that occurs that many times.
  90 sub Schedule {
  91     my $self = shift;
  92     my ($event) = @_;
  93     $self->schedule($event, \$self->{'pruneDelay'}, -1, 'pruneInfobot');
  94     $self->SUPER::Schedule($event);
  95 }
  96
  97 sub Unload {
  98     # just to make sure...
  99     untie(%{$factoids->{'is'}});
 100     untie(%{$factoids->{'are'}});
 101 }
 102
 103 sub Told {
 104     my $self = shift;
 105     my ($event, $message) = @_;
 106     if ($message =~ /^\s*status[?\s]*$/osi) {
 107         my $sum = $self->countFactoids();
 108         my $questions = $self->{'questions'} == 1 ? "$self->{'questions'} question" : "$self->{'questions'} questions";
 109         my $edits = $self->{'edits'} == 1 ? "$self->{'edits'} edit" : "$self->{'edits'} edits";
 110         my $interbots = $self->{'interbots'} == 1 ? "$self->{'interbots'} time" : "$self->{'interbots'} times";
 111         my $friends = @{$self->{'friendBots'}} == 1 ? (scalar(@{$self->{'friendBots'}}).' bot friend') : (scalar(@{$self->{'friendBots'}}).' bot friends');
 112         $self->targettedSay($event, "I have $sum factoids in my database and $friends to help me answer questions. ".
 113                             "Since the last reload, I've been asked $questions, performed $edits, and spoken with other bots $interbots.", 1);
 114     } elsif ($event->{'channel'} eq '' and $message =~ /^:INFOBOT:DUNNO <(\S+)> (.*)$/) {
 115         $self->ReceivedDunno($event, $1, $2) unless $event->{'from'} eq $event->{'nick'};
 116     } elsif ($event->{'channel'} eq '' and $message =~ /^:INFOBOT:QUERY <(\S+)> (.*)$/) {
 117         $self->ReceivedQuery($event, $2, $1) unless $event->{'from'} eq $event->{'nick'};
 118     } elsif ($event->{'channel'} eq '' and $message =~ /^:INFOBOT:REPLY <(\S+)> (.+?) =(is|are)?=> (.*)$/) {
 119         $self->ReceivedReply($event, $3, $2, $1, $4) unless $event->{'from'} eq $event->{'nick'};
 120     } elsif ($message =~ /^\s*literal\s+(.+?)\s*$/) {
 121         $self->Literal($event, $1);
 122     } elsif ($event->{level} < 10) {
 123         # make this module a very low priority
 124         return 10;
 125     } elsif (not $self->DoFactoidCheck($event, $message, 1)) {
 126         return $self->SUPER::Told(@_);
 127     }
 128     return 0; # we've dealt with it, no need to do anything else.
 129 }
 130
 131 sub Baffled {
 132     my $self = shift;
 133     my ($event, $message) = @_;
 134     return 10 unless $event->{level} >= 10; # make this module a very low priority
 135     if (not $self->DoFactoidCheck($event, $message, 2)) {
 136         return $self->SUPER::Heard(@_);
 137     }
 138     return 0; # we've dealt with it, no need to do anything else.
 139 }
 140
 141 sub Heard {
 142     my $self = shift;
 143     my ($event, $message) = @_;
 144     return 10 unless $event->{level} >= 10; # make this module a very low priority
 145     if (not $self->DoFactoidCheck($event, $message, 0)) {
 146         return $self->SUPER::Heard(@_);
 147     }
 148     return 0; # we've dealt with it, no need to do anything else.
 149 }
 150
 151 sub DoFactoidCheck {
 152     my $self = shift;
 153     my ($event, $message, $direct) = @_;
 154     # $direct is one of: 0 = heard, 1 = told, 2 = baffled
 155
 156     my $shortMessage;
 157     if ($message =~ /^\s* (?:\w+[:.!\s]+\s+)?
 158                           (?:(?:well|and|or|yes|[uh]+m*|o+[oh]*[k]+(?:a+y+)?|still|well|so|a+h+|o+h+)[:,.!?\s]+|)*
 159                           (?:(?:geez?|boy|du+des?|golly|gosh|wow|whee|wo+ho+)[:,.!\s]+|)*
 160                           (?:(?:heya?|hello|hi)(?:\s+there)?(?:\s+peoples?|\s+kids?|\s+folks?)[:,!.?\s]+)*
 161                           (?:(?:geez?|boy|du+des?|golly|gosh|wow|whee|wo+ho+)[:,.!\s]+|)*
 162                           (?:tell\s+me[,\s]+)?
 163                           (?:(?:(?:stupid\s+)?q(?:uestion)?|basically)[:,.!\s]+)*
 164                           (?:tell\s+me[,\s]+)?
 165                           (?:(?:does\s+)?(?:any|ne)\s*(?:1|one|body)\s+know[,\s]+|)?
 166                           (.*)
 167                       \s*$/osix) {
 168         $shortMessage = $1;
 169     }
 170     $self->debug("message: '$message'");
 171     $self->debug("shortMessage: '$shortMessage'");
 172
 173     if ($message =~ /^\s*tell\s+(\S+)\s+about\s+me(?:[,\s]+please)?[\s!?.]*$/osi) {
 174         $self->GiveFactoid($event,
 175                                 undef, # database
 176                      $event->{'from'}, # what
 177                               $direct,
 178                                   $1); # who
 179     } elsif ($message =~ /^\s*tell\s+(\S+)\s+about\s+(.+?)(?:[,\s]+please)?[\s!?.]*$/osi) {
 180         $self->GiveFactoid($event,
 181                                 undef, # database
 182                                    $2, # what
 183                               $direct,
 184                                   $1); # who
 185     } elsif ($message =~ /^\s*tell\s+(\S+)\s+(?:what|who|where)\s+(?:am\s+I|I\s+am)(?:[,\s]+please)?[\s!?.]*$/osi) {
 186         $self->GiveFactoid($event,
 187                                  'is', # database
 188                      $event->{'from'}, # what
 189                               $direct,
 190                                   $1); # who
 191     } elsif ($message =~ /^\s*tell\s+(\S+)\s+(?:what|who|where)\s+(is|are)\s+(.+?)(?:[,\s]+please)?[\s!?.]*$/osi) {
 192         $self->GiveFactoid($event,
 193                                lc($2), # database
 194                                    $3, # what
 195                               $direct,
 196                                   $1); # who
 197     } elsif ($message =~ /^\s*tell\s+(\S+)\s+(?:what|who|where)\s+(.+?)\s+(is|are)(?:[,\s]+please)?[\s!?.]*$/osi) {
 198         $self->GiveFactoid($event,
 199                                lc($3), # database
 200                                    $2, # what
 201                               $direct,
 202                                   $1); # who
 203     } elsif ($message =~ /^\s*(.+?)\s*=~\s*s?\/(.+?)\/(.*?)\/(i)?(g)?(i)?\s*$/osi) {
 204         $self->EditFactoid($event,
 205                                    $1, # subject
 206                                    $2, # first part to remove
 207                                    $3, # second part to remove
 208                           defined($5), # global?
 209            defined($4) || defined($6), # case insensitive?
 210                            $direct);
 211     } elsif ($message =~ /^\s*forget\s+(?:about\s+)?me\s*$/osi) {
 212         $self->ForgetFactoid($event, $event->{'from'}, $direct);
 213     } elsif ($message =~ /^\s*forget\s+(?:about\s+)?(.+?)\s*$/osi) {
 214         $self->ForgetFactoid($event, $1, $direct);
 215     } elsif ($shortMessage =~ /^(?:what|where|who)
 216                                 (?:\s+the\s+hell|\s+on\s+earth|\s+the\s+fuck)?
 217                                \s+ (is|are) \s+ (.+?) [?!\s]* $/osix) {
 218         $self->GiveFactoid($event,
 219                                lc($1), # is/are (optional)
 220                                    $2, # subject
 221                               $direct);
 222     } elsif ($shortMessage =~ /^(?:(?:where|how)
 223                                    (?:\s+the\s+hell|\s+on\s+earth|\s+the\s+fuck)?
 224                                    \s+ can \s+ (?:i|one|s?he|we) \s+ (?:find|learn|read)
 225                                    (?:\s+about)?
 226                                  | how\s+about
 227                                  | what\'?s)
 228                                  \s+ (.+?) [?!\s]* $/osix) {
 229         $self->GiveFactoid($event,
 230                                 undef, # is/are (optional)
 231                                    $1, # subject
 232                               $direct);
 233     } elsif ($shortMessage =~ /^(.+?) \s+ (is|are) \s+ (?:what|where|who) [?!\s]* $/osix) {
 234         $self->GiveFactoid($event,
 235                                lc($2), # is/are (optional)
 236                                    $1, # subject
 237                              $direct);
 238     } elsif ($shortMessage =~ /^(?:what|where|who)
 239                                 (?:\s+the\s+hell|\s+on\s+earth|\s+the\s+fuck)? \s+
 240                                 (?:am\s+I|I\s+am) [?\s]* $/osix) {
 241         $self->GiveFactoid($event,
 242                                  'is', # am => is
 243                      $event->{'from'}, # subject
 244                              $direct);
 245     } elsif ($shortMessage =~ /^(no\s*, (\s*\Q$event->{'nick'}\E\s*,)? \s+)? (?:remember\s*:\s+)? (.+?) \s+ (is|are) \s+ (also\s+)? (.*?[^?\s]) \s* $/six) {
 246         # the "remember:" prefix can be used to delimit the start of the actual content, if necessary.
 247         $self->SetFactoid($event,
 248                           defined($1) &&
 249                           ($direct || defined($2)),
 250                                        # replace existing answer?
 251                                    $3, # subject
 252                                lc($4), # is/are
 253                           defined($5), # add to existing answer?
 254                                    $6, # object
 255                            $direct || defined($2));
 256     } elsif ($shortMessage =~ /^(no\s*, (?:\s*\Q$event->{'nick'}\E\s*,)? \s+)? (?:remember\s*:\s+)? I \s+ am \s+ (also\s+)? (.+?) $/osix) {
 257         # the "remember:" prefix can be used to delimit the start of the actual content, if necessary.
 258         $self->SetFactoid($event,
 259                           defined($1), # replace existing answer?
 260                      $event->{'from'}, # subject
 261                                  'is', # I am = Foo is
 262                           defined($2), # add to existing answer?
 263                                    $3, # object
 264                              $direct);
 265     } elsif ((not $direct or $direct == 2) and $shortMessage =~ /^(.+?)\s+(is|are)[?\s]*(\?)?[?\s]*$/osi) {
 266         $self->GiveFactoid($event,
 267                                lc($2), # is/are (optional)
 268                                    $1, # subject
 269                               $direct)
 270           if ($3 or ($direct == 2 and $self->{'eagerToHelp'}));
 271     } elsif ((not $direct or $direct == 2) and $shortMessage =~ /^(.+?)[?!.\s]*(\?)?[?!.\s]*$/osi) {
 272         $self->GiveFactoid($event,
 273                                 undef, # is/are (optional)
 274                                    $1, # subject
 275                               $direct)
 276           if ($2 or ($direct == 2 and $self->{'eagerToHelp'}));
 277     } else {
 278         return 0;
 279     }
 280     return 1;
 281 }
 282
 283 sub SetFactoid {
 284     my $self = shift;
 285     my($event, $replace, $subject, $database, $add, $object, $direct, $fromBot) = @_;
 286     if ($direct or $self->allowed($event, 'Learn')) {
 287
 288         teacher: {
 289             if (@{$self->{'teachers'}}) {
 290                 foreach my $user (@{$self->{'teachers'}}) {
 291                     if ($user eq $event->{'userName'}) {
 292                         last teacher;
 293                     }
 294                 }
 295                 return 0;
 296             }
 297         }
 298
 299         # update the database
 300         if (not $replace) {
 301             $subject = $self->CanonicalizeFactoid($database, $subject);
 302         } else {
 303             my $oldSubject = $self->CanonicalizeFactoid($database, $subject);
 304             if (defined($factoids->{$database}->{$oldSubject})) {
 305                 delete($factoids->{$database}->{$oldSubject});
 306             }
 307         }
 308         if ($replace or not defined($factoids->{$database}->{$subject})) {
 309             $self->debug("Learning that $subject $database '$object'.");
 310             $factoids->{$database}->{$subject} = $object;
 311         } elsif (not $add) {
 312             my @what = split(/\|/o, $factoids->{$database}->{$subject});
 313             local $" = '\' or \'';
 314             if (not defined($fromBot)) {
 315                 if (@what == 1 and $what[0] eq $object) {
 316                     $self->targettedSay($event, 'Yep, that\'s what I thought. Thanks for confirming it.', $direct);
 317                 } else {
 318                     # XXX "that's one of the alternatives, sure..."
 319                     $self->targettedSay($event, "But $subject $database '@what'...", $direct);
 320                 }
 321             }
 322             return 0; # failed to update database
 323         } else {
 324             $self->debug("Learning that $subject $database also '$object'.");
 325             $factoids->{$database}->{$subject} .= "|$object";
 326         }
 327         if (not defined($fromBot)) {
 328             $self->targettedSay($event, 'ok', $direct);
 329         }
 330         if (defined($self->{'researchNotes'}->{lc($subject)})) {
 331             my @queue = @{$self->{'researchNotes'}->{lc($subject)}};
 332             foreach my $entry (@queue) {
 333                 my($eventE, $typeE, $databaseE, $subjectE, $targetE, $directE, $visitedAliasesE, $timeE) = @$entry;
 334                 if ($typeE eq 'QUERY') {
 335                     if ((defined($targetE) and $event->{'from'} ne $targetE) or
 336                         ($event->{'from'} ne $eventE->{'from'} and
 337                          ($event->{'channel'} eq '' or $event->{'channel'} ne $eventE->{'channel'}))) {
 338                         my($how, $what, $propagated) = $self->GetFactoid($eventE, $databaseE, $subjectE,
 339                                                                          $targetE, $directE, $visitedAliasesE, $event->{'from'});
 340                         if (defined($how)) {
 341                             if (defined($targetE)) {
 342                                 $self->debug("I now know what '$subject' $database, so telling $targetE, since $eventE->{'from'} told me to.");
 343                             } else {
 344                                 $self->debug("I now know what '$subject' $database, so telling $eventE->{'from'} who wanted to know.");
 345                             }
 346                             $self->factoidSay($eventE, $how, $what, $directE, $targetE);
 347                             $entry->[1] = 'OLD';
 348                         } else {
 349                             # either $propagated, or database doesn't match requested database, or internal error
 350                             $self->debug("I now know what '$subject' $database, but for some reason that ".
 351                                          "didn't help me help $eventE->{'from'} who needed to know what '$subjectE' $databaseE.");
 352                         }
 353                     }
 354                 } elsif ($typeE eq 'DUNNO') {
 355                     my $who = defined($targetE) ? $targetE : $eventE->{'from'};
 356                     $self->directSay($eventE, ":INFOBOT:REPLY <$who> $subject =$database=> $factoids->{$database}->{$subject}");
 357                     $entry->[1] = 'OLD';
 358                 }
 359             }
 360         }
 361         $self->{'edits'}++;
 362         return 1;
 363     } else {
 364         return 0;
 365     }
 366 }
 367
 368 sub GiveFactoid {
 369     my $self = shift;
 370     my($event, $database, $subject, $direct, $target) = @_;
 371     if ($direct or $self->allowed($event, 'Help')) {
 372         if ($target =~ m/^$event->{'nick'}$/i) {
 373             $self->targettedSay($event, 'Oh, yeah, great idea, get me to talk to myself.', $direct);
 374         } else {
 375             if (lc($subject) eq 'you') {
 376                 # first, skip some words that are handled by other commonly-used modules
 377                 # in particular, 'who are you' is handled by Greeting.bm
 378                 return;
 379             }
 380             $self->{'questions'}++;
 381             my($how, $what, $propagated) = $self->GetFactoid($event, $database, $subject, $target, $direct);
 382             if (not defined($how)) {
 383                 $self->scheduleNoIdea($event, $database, $subject, $direct, $propagated);
 384             } else {
 385                 $self->debug("Telling $event->{'from'} about $subject.");
 386                 $self->factoidSay($event, $how, $what, $direct, $target);
 387             }
 388         }
 389     }
 390 }
 391
 392 sub Literal {
 393     my $self = shift;
 394     my($event, $subject) = @_;
 395     my $is = $self->CanonicalizeFactoid('is', $subject);
 396     my $are = $self->CanonicalizeFactoid('are', $subject);
 397     if (defined($is) or defined($are)) {
 398         local $" = '\' or \'';
 399         if (defined($factoids->{'is'}->{$is})) {
 400             my @what = split(/\|/o, $factoids->{'is'}->{$is});
 401             $self->targettedSay($event, "$is is '@what'.", 1);
 402         }
 403         if (defined($factoids->{'are'}->{$are})) {
 404             my @what = split(/\|/o, $factoids->{'are'}->{$is});
 405             $self->targettedSay($event, "$are are '@what'.", 1);
 406         }
 407     } else {
 408         $self->targettedSay($event, "I have no record of anything called '$subject'.", 1);
 409     }
 410 }
 411
 412 sub scheduleNoIdea {
 413     my $self = shift;
 414     my($event, $database, $subject, $direct, $propagated) = @_;
 415     if (ref($propagated)) {
 416         $self->schedule($event, \$self->{'noIdeaDelay'}, 1, 'noIdea', $database, $subject, $direct, $propagated);
 417     } else {
 418         $self->noIdea($event, $database, $subject, $direct);
 419     }
 420 }
 421
 422 sub GetFactoid {
 423     my $self = shift;
 424     my($event, $originalDatabase, $subject, $target, $direct, $visitedAliases, $friend) = @_;
 425     if (not defined($visitedAliases)) {
 426         $visitedAliases = {};
 427     }
 428     my $database;
 429     ($database, $subject) = $self->FindFactoid($originalDatabase, $subject);
 430     if (defined($factoids->{$database}->{$subject})) {
 431         my @alternatives = split(/\|/o, $factoids->{$database}->{$subject});
 432         my $answer;
 433         if (@alternatives) {
 434             if (not defined($self->{'factoidPositions'}->{$database}->{$subject})
 435                 or $self->{'factoidPositions'}->{$database}->{$subject} >= scalar(@alternatives)) {
 436                 $self->{'factoidPositions'}->{$database}->{$subject} = 0;
 437             }
 438             $answer = @alternatives[$self->{'factoidPositions'}->{$database}->{$subject}];
 439             $self->{'factoidPositions'}->{$database}->{$subject}++;
 440         } else {
 441             $answer = @alternatives[0];
 442         }
 443         my $who = defined($target) ? $target : $event->{'from'};
 444         $answer =~ s/\$who/$who/go;
 445         if ($answer =~ /^<alias>(.*)$/o) {
 446             if ($visitedAliases->{$1}) {
 447                 return ('msg', "see $subject", 0);
 448             } else {
 449                 $visitedAliases->{$subject}++;
 450                 my($how, $what, $propagated) = $self->GetFactoid($event, undef, $1, $target, $direct, $visitedAliases);
 451                 if (not defined($how)) {
 452                     return ('msg', "see $1", $propagated);
 453                 } else {
 454                     return ($how, $what, $propagated);
 455                 }
 456             }
 457         } elsif ($answer =~ /^<action>/o) {
 458             $answer =~ s/^<action>\s*//o;
 459             return ('me', $answer, 0);
 460         } else {
 461             if ($answer =~ /^<reply>/o) {
 462                 $answer =~ s/^<reply>\s*//o;
 463             } else {
 464                 # pick a 'random' prefix
 465                 my $prefix = $self->{'prefixes'}->[$event->{'time'} % @{$self->{'prefixes'}}];
 466                 if (lc($who) eq lc($subject)) {
 467                     $answer = "${prefix}you are $answer";
 468                 } else {
 469                     $answer = "$prefix$subject $database $answer";
 470                 }
 471                 if (defined($friend)) {
 472                     $answer = "$friend knew: $answer";
 473                 }
 474             }
 475             return ('msg', $answer, 0);
 476         }
 477     } else {
 478         # we have no idea what this is
 479         return (undef, undef, $self->Research($event, $originalDatabase, $subject, $target, $direct, $visitedAliases));
 480     }
 481 }
 482
 483 sub CanonicalizeFactoid {
 484     my $self = shift;
 485     my($database, $subject) = @_;
 486     if (not defined($factoids->{$database}->{$subject})) {
 487         while (my $key = each %{$factoids->{$database}}) {
 488             if (lc($key) eq lc($subject)) {
 489                 $subject = $key;
 490                 # can't return or 'each' iterator won't be reset XXX
 491             }
 492         }
 493     }
 494     return $subject;
 495 }
 496
 497 sub FindFactoid {
 498     my $self = shift;
 499     my($database, $subject) = @_;
 500     if (not defined($database)) {
 501         $database = 'is';
 502         $subject = $self->CanonicalizeFactoid('is', $subject);
 503         if (not defined($factoids->{'is'}->{$subject})) {
 504             $subject = $self->CanonicalizeFactoid('are', $subject);
 505             if (defined($factoids->{'are'}->{$subject})) {
 506                 $database = 'are';
 507             }
 508         }
 509     } else {
 510         $subject = $self->CanonicalizeFactoid($database, $subject);
 511     }
 512     return ($database, $subject);
 513 }
 514
 515 sub EditFactoid {
 516     my $self = shift;
 517     my($event, $subject, $search, $replace, $global, $caseInsensitive, $direct) = @_;
 518     if ($direct or $self->allowed($event, 'Edit')) {
 519         my $database;
 520         ($database, $subject) = $self->FindFactoid($database, $subject);
 521         if (not defined($factoids->{$database}->{$subject})) {
 522             $self->targettedSay($event, "Er, I don't know about this $subject thingy...", $direct);
 523             return;
 524         }
 525         $self->debug("Editing the $subject entry.");
 526         my @output;
 527         foreach my $factoid (split(/\|/o, $factoids->{$database}->{$subject})) {
 528             $search = $self->sanitizeRegexp($search);
 529             if ($global and $caseInsensitive) {
 530                 $factoid =~ s/$search/$replace/gi;
 531             } elsif ($global) {
 532                 $factoid =~ s/$search/$replace/g;
 533             } elsif ($caseInsensitive) {
 534                 $factoid =~ s/$search/$replace/i;
 535             } else {
 536                 $factoid =~ s/$search/$replace/;
 537             }
 538             push(@output, $factoid);
 539         }
 540         $factoids->{$database}->{$subject} = join('|', @output);
 541         $self->targettedSay($event, 'ok', $direct);
 542         $self->{'edits'}++;
 543     }
 544 }
 545
 546 sub ForgetFactoid {
 547     my $self = shift;
 548     my($event, $subject, $direct) = @_;
 549     if ($direct or $self->allowed($event, 'Edit')) {
 550         my $count = 0;
 551         my $database;
 552         foreach my $db ('is', 'are') {
 553             ($database, $subject) = $self->FindFactoid($db, $subject);
 554             if (defined($factoids->{$database}->{$subject})) {
 555                 delete($factoids->{$database}->{$subject});
 556                 $count++;
 557             }
 558         }
 559         if ($count) {
 560             $self->targettedSay($event, "I've forgotten what I knew about '$subject'.", $direct);
 561             $self->{'edits'}++;
 562         } else {
 563             $self->targettedSay($event, "I never knew anything about '$subject' in the first place!", $direct);
 564         }
 565     }
 566 }
 567
 568 # interbot communications
 569 sub Research {
 570     my $self = shift;
 571     my($event, $database, $subject, $target, $direct, $visitedAliases) = @_;
 572     if (not @{$self->{'friendBots'}}) {
 573         # no bots to ask, bail out
 574         return 0;
 575     }
 576     # now check that we need to ask the bots about it:
 577     my $asked = 0;
 578     if (not defined($self->{'researchNotes'}->{$subject})) {
 579         $self->{'researchNotes'}->{$subject} = [];
 580     } else {
 581         entry: foreach my $entry (@{$self->{'researchNotes'}->{lc($subject)}}) {
 582             my($eventE, $typeE, $databaseE, $subjectE, $targetE, $directE, $visitedAliasesE, $timeE) = @$entry;
 583             if ($typeE eq 'QUERY') {
 584                 $asked++; # at least one bot was already asked quite recently
 585                 if ((defined($targetE) and lc($targetE) eq lc($targetE)) or
 586                     (not defined($targetE) and lc($event->{'from'}) eq lc($eventE->{'from'}))) {
 587                     # already queued
 588                     return 1;
 589                 }
 590             }
 591         }
 592     }
 593     # remember to tell these people about $subject if we ever find out about it:
 594     my $entry = [$event, 'QUERY', $database, $subject, $target, $direct, $visitedAliases, $event->{'time'}];
 595     push(@{$self->{'researchNotes'}->{lc($subject)}}, $entry);
 596     my $who = defined($target) ? $target : $event->{'from'};
 597     if (not $asked) {
 598         # not yet asked, so ask each bot about $subject
 599         foreach my $bot (@{$self->{'friendBots'}}) {
 600             next if $bot eq $event->{'nick'};
 601             local $event->{'from'} = $bot;
 602             $self->directSay($event, ":INFOBOT:QUERY <$who> $subject");
 603         }
 604         $self->{'interbots'}++;
 605         return $entry; # return reference to entry so that we can check if it has been replied or not
 606     } else {
 607         return $asked;
 608     }
 609 }
 610
 611 sub ReceivedReply {
 612     my $self = shift;
 613     my($event, $database, $subject, $target, $object) = @_;
 614     $self->{'interbots'}++;
 615     if (not $self->SetFactoid($event, 0, $subject, $database, 0, $object, 1, 1) and
 616         defined($self->{'researchNotes'}->{lc($subject)})) {
 617         # we didn't believe $event->{'from'}, but we might as well
 618         # tell any users that were wondering.
 619         foreach my $entry (@{$self->{'researchNotes'}->{lc($subject)}}) {
 620             my($eventE, $typeE, $databaseE, $subjectE, $targetE, $directE, $visitedAliasesE, $timeE) = @$entry;
 621             if ($typeE eq 'QUERY') {
 622                 $self->factoidSay($eventE, 'msg', "According to $event->{'from'}, $subject $database '$object'.", $directE, $targetE);
 623             } elsif ($typeE eq 'DUNNO') {
 624                 my $who = defined($targetE) ? $targetE : $eventE->{'from'};
 625                 $self->directSay($eventE, ":INFOBOT:REPLY <$who> $subject =$database=> $object");
 626             }
 627             $entry->[1] = 'OLD';
 628         }
 629     }
 630 }
 631
 632 sub ReceivedQuery {
 633     my $self = shift;
 634     my($event, $subject, $target) = @_;
 635     $self->{'interbots'}++;
 636     if (not $self->tellBot($event, $subject, $target)) {
 637         # in the spirit of embrace-and-extend, we're going to say that
 638         # :INFOBOT:DUNNO means "I don't know, but if you ever find
 639         # out, please tell me".
 640         $self->directSay($event, ":INFOBOT:DUNNO <$event->{'nick'}> $subject");
 641     }
 642 }
 643
 644 sub ReceivedDunno {
 645     my $self = shift;
 646     my($event, $target, $subject) = @_;
 647     $self->{'interbots'}++;
 648     if (not $self->tellBot($event, $subject, $target)) {
 649         # store the request
 650         push(@{$self->{'researchNotes'}->{lc($subject)}}, [$event, 'DUNNO', undef, $1, $target, 0, {}, $event->{'time'}]);
 651     }
 652 }
 653
 654 sub tellBot {
 655     my $self = shift;
 656     my($event, $subject, $target) = @_;
 657     my $count = 0;
 658     my $database;
 659     foreach my $db ('is', 'are') {
 660         ($database, $subject) = $self->FindFactoid($db, $subject);
 661         if (defined($factoids->{$database}->{$subject})) {
 662             $self->directSay($event, ":INFOBOT:REPLY <$target> $subject =$database=> $factoids->{$database}->{$subject}");
 663             $count++;
 664         }
 665     }
 666     return $count;
 667 }
 668
 669 sub Scheduled {
 670     my $self = shift;
 671     my ($event, @data) = @_;
 672     if ($data[0] eq 'pruneInfobot') {
 673         my $now = $event->{'time'};
 674         foreach my $key (keys %{$self->{'researchNotes'}}) {
 675             my @new;
 676             foreach my $entry (@{$self->{'researchNotes'}->{$key}}) {
 677                 my($eventE, $typeE, $databaseE, $subjectE, $targetE, $directE, $visitedAliasesE, $timeE) = @$entry;
 678                 if (($typeE eq 'QUERY' and ($now - $timeE) < $self->{'queryTimeToLive'}) or
 679                     ($typeE eq 'DUNNO' and ($now - $timeE) < $self->{'dunnoTimeToLive'})) {
 680                     push(@new, $entry);
 681                 }
 682             }
 683             if (@new) {
 684                 $self->{'researchNotes'}->{$key} = \@new;
 685             } else {
 686                 delete($self->{'researchNotes'}->{$key});
 687             }
 688         }
 689     } elsif ($data[0] eq 'noIdea') {
 690         my(undef, $database, $subject, $direct, $propagated) = @data;
 691         my($eventE, $typeE, $databaseE, $subjectE, $targetE, $directE, $visitedAliasesE, $timeE) = @$propagated;
 692         # in theory, $eventE = $event, $databaseE = $database,
 693         # $subjectE = $subject, $targetE depends on if this was
 694         # triggered by a tell, $directE = $direct, $visitedAliasesE is
 695         # opaque, and $timeE is opaque.
 696         if ($typeE ne 'OLD') {
 697             $self->noIdea($event, $database, $subject, $direct);
 698         }
 699     } else {
 700         $self->SUPER::Scheduled($event, @data);
 701     }
 702 }
 703
 704
 705 # internal helper routines
 706
 707 sub factoidSay {
 708     my $self = shift;
 709     my($event, $how, $what, $direct, $target) = @_;
 710     if (defined($target)) {
 711         $self->targettedSay($event, "told $target", 1);
 712         my $helper = $event->{'from'};
 713         local $event->{'from'} = $target;
 714         if ($how eq 'me') {
 715             $self->directEmote($event, $what);
 716         } else {
 717             if (length($what)) {
 718                 $self->directSay($event, "$helper wanted you to know: $what");
 719             }
 720         }
 721     } elsif ($how eq 'me') {
 722         $self->emote($event, $what);
 723     } else {
 724         if ($event->{'channel'} eq '' or length($what) < $self->{'maxInChannel'}) {
 725             $self->targettedSay($event, $what, 1);
 726         } else {
 727             if ($direct) {
 728                 $self->targettedSay($event, substr($what, 0, $self->{'maxInChannel'}) . '... (rest /msged)' , 1);
 729                 $self->directSay($event, $what);
 730             } else {
 731                 $self->targettedSay($event, substr($what, 0, $self->{'maxInChannel'}) . '... (there is more; ask me in a /msg)' , 1);
 732             }
 733         }
 734     }
 735 }
 736
 737 sub targettedSay {
 738     my $self = shift;
 739     my($event, $message, $direct) = @_;
 740     if ($direct and length($message)) {
 741         $self->say($event, "$event->{from}: $message");
 742     }
 743 }
 744
 745 sub countFactoids {
 746     my $self = shift;
 747     # don't want to use keys() as that would load the whole database index into memory.
 748     my $sum = 0;
 749     while (my $factoid = each %{$factoids->{'is'}}) { $sum++; }
 750     while (my $factoid = each %{$factoids->{'are'}}) { $sum++; }
 751     return $sum;
 752 }
 753
 754 sub allowed {
 755     my $self = shift;
 756     my($event, $type) = @_;
 757     if ($event->{'channel'} ne '') {
 758         foreach my $user (@{$self->{'autoIgnore'}}) {
 759             if ($user eq $event->{'from'}) {
 760                 return 0;
 761             }
 762         }
 763         foreach my $channel (@{$self->{"never$type"}}) {
 764             if ($channel eq $event->{'channel'} or
 765                 $channel eq '*') {
 766                 return 0;
 767             }
 768         }
 769         foreach my $channel (@{$self->{"auto$type"}}) {
 770             if ($channel eq $event->{'channel'} or
 771                 $channel eq '*') {
 772                 return 1;
 773             }
 774         }
 775     }
 776     return 0;
 777 }
 778
 779 sub noIdea {
 780     my $self = shift;
 781     my($event, $database, $subject, $direct) = @_;
 782     if (lc($subject) eq lc($event->{'from'})) {
 783         $self->targettedSay($event, "Sorry, I've no idea who you are.", $direct);
 784     } else {
 785         if (not defined($database)) {
 786             $database = 'might be';
 787         }
 788         $self->targettedSay($event, "Sorry, I've no idea what '$subject' $database.", $direct);
 789     }
 790 }