BotModules/MagicEightBall.bm

   1 # -*- Mode: perl; tab-width: 4; indent-tabs-mode: nil; -*-
   2 ################################
   3 # Magic Eight Ball             #
   4 ################################
   5
   6 package BotModules::MagicEightBall;
   7 use vars qw(@ISA);
   8 @ISA = qw(BotModules);
   9 1;
  10
  11 sub Help {
  12     my $self = shift;
  13     my ($event) = @_;
  14     return {
  15         '' => 'The all knowing magic eight ball, in electronic form. Ask a question and the answer shall be provided.',
  16         $self->{'prefix'}.'ball' => "Ask the Magic Eight Ball a question. Syntax: '$self->{'prefix'}ball: will it happen?'",
  17     };
  18 }
  19
  20 # RegisterConfig - Called when initialised, should call registerVariables
  21 sub RegisterConfig {
  22     my $self = shift;
  23     $self->SUPER::RegisterConfig(@_);
  24     $self->registerVariables(
  25       # [ name, save?, settable? ]
  26       ['prefix', 1, 1, '!8'], # the prefix to put before the 'ball' command
  27       ['responses-positive', 1, 1, ['It is possible.', 'Yes!', 'Of course.', 'Naturally.', 'Obviously.',
  28                                     'One would be wise to think so.', 'The outlook is good.', 'It shall be.',
  29                                     'The answer is certainly yes.', 'It is so.']],
  30       ['responses-negative', 1, 1, ['In your dreams.', 'No.', 'No chance.', 'Unlikely.', 'About as likely as pigs flying.',
  31                                     'You\'re kidding, right?', 'The outlook is poor.', 'I doubt it very much.',
  32                                     'The answer is a resounding no.', 'NO!', 'NO.']],
  33       ['responses-unknown', 1, 1, ['Maybe...', 'The outlook is hazy, please ask again later.', 'No clue.',
  34                                    'What are you asking me for?', '_I_ don\'t know.', 'Come again?',
  35                                    'You know the answer better than I.', 'The answer is def-- oooh! shiny thing!']],
  36     );
  37 }
  38
  39 sub Told {
  40     my $self = shift;
  41     return ($self->CheckTheBall(@_) and $self->SUPER::Told(@_));
  42 }
  43
  44 sub Heard {
  45     my $self = shift;
  46     return ($self->CheckTheBall(@_) and $self->SUPER::Told(@_));
  47 }
  48
  49 sub CheckTheBall {
  50     my $self = shift;
  51     my ($event, $message) = @_;
  52     if ($message =~ m/$self->{'prefix'}ball[\s:,]+(\S.+\w.+)$/si) {
  53
  54         # -- #buncs was here --
  55         #        <Kam> !8ball: are you a fish?
  56         #    <oopsbot> Kam: About as likely as pigs flying.
  57         #        <Kam> !8ball: is the world flat?
  58         #    <oopsbot> Kam: The answer is a resounding no.
  59         #        <Kam> !8ball: is the world round?
  60         #    <oopsbot> Kam: _I_ don't know.
  61         #        <Kam> !8ball: is the world spherical?
  62         #    <oopsbot> Kam: The answer is certainly yes.
  63         #        <Kam> how DOES it do that? :)
  64         #      <Hixie> it's gooood :-)
  65
  66         # trim the fat from the question
  67         $message =~ s/\W//gos;
  68         # pick a reply category that will always be the same for this exact question
  69         my $response = $self->{['responses-positive', 'responses-negative', 'responses-unknown']->[(length($message) % 3)]};
  70         # pick a specific reply that will be different to recent ones
  71         $response = $response->[$event->{'time'} % @$response];
  72         $self->say($event, "$event->{'from'}: $response");
  73     } else {
  74         return 1;
  75     }
  76     return 0;
  77 }