]> git.somenet.org - irc/bugbot.git/blob - BotModules/MagicEightBall.bm
GITOLITE.txt
[irc/bugbot.git] / 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 }