]> git.somenet.org - irc/bugbot.git/blob - BotModules/FortuneCookies.bm
GITOLITE.txt
[irc/bugbot.git] / BotModules / FortuneCookies.bm
1 ################################
2 # Fortune Cookie Module        #
3 ################################
4
5 package BotModules::FortuneCookies;
6 use vars qw(@ISA);
7 @ISA = qw(BotModules);
8 1;
9
10 sub Help {
11     my $self = shift;
12     my ($event) = @_;
13     return {
14         '' => 'A module to get random fortune cookies.',
15         'fortune' => 'Same as \'cookie\', which see.',
16         'cookie' => 'To get a fortune cookie, just tell me \'cookie\'. To set a new fortune cookie, see \'new\' (or \'add\'). To find out how many cookies are left, use \'cookie status\'.',
17         'new' => 'To set a new fortune cookie, say \'new cookie\' followed by the text, e.g. \'new cookie: you will have a nice day\' or whatever. The string %from% will be replaced by the name of whoever requests the cookie.',
18         'add' => 'To add a new fortune cookie, say \'add cookie\' followed by the text, e.g. \'add cookie: you will have a nice day\' or whatever. The string %from% will be replaced by the name of whoever requests the cookie.',
19         'fetch' => 'The command \'fetch cookies from <uri>\' will add each line in <uri> to the cookie list. Cookie lists must start with one line that reads \'DATA FILE: cookies\' and must be at most 100 lines long. Blank lines and lines starting with a hash (\'#\') are ignored.',
20     };
21 }
22
23 # RegisterConfig - Called when initialised, should call registerVariables
24 sub RegisterConfig {
25     my $self = shift;
26     $self->SUPER::RegisterConfig(@_);
27     $self->registerVariables(
28       # [ name, save?, settable? ]
29         ['cookies', 1, 1, ['The sun will rise in the east today, indicating nothing in particular.']],
30         ['cookiesIndex', 1, 1, 0],
31         ['cookiesLeft', 0, 1, 10],
32         ['bakingTime', 1, 1, 20],
33         ['cookiesMax', 1, 1, 10],
34     );
35 }
36
37 # Schedule - called when bot connects to a server, to install any schedulers
38 # use $self->schedule($event, $delay, $times, $data)
39 # where $times is 1 for a single event, -1 for recurring events,
40 # and a +ve number for an event that occurs that many times.
41 sub Schedule {
42     my $self = shift;
43     my ($event) = @_;
44     $self->schedule($event, \$self->{'bakingTime'}, -1, 'newCookie');
45     $self->SUPER::Schedule($event);
46 }
47
48 sub Told {
49     my $self = shift;
50     my ($event, $message) = @_;
51     if ($message =~ /^\s*(?:please[,.!1?]*\s+)?(?:(?:can|could)\s+i\s+have\s+a\s+|give\s+me\s+a\s+)?(?:fortune\s+cookie|fortune|cookie)(?:[,!1.\s]+now)?(?:[,!1.\s]+please)?\s*[?!1.]*\s*$/osi) {
52         if ($self->{'cookiesLeft'} > 0) {
53             $self->{'cookiesLeft'}--;
54             my $cookie = $self->GetNext('cookies');
55             $cookie =~ s/%from%/$event->{'from'}/gos;
56             $self->say($event, $cookie);
57         } else {
58             $self->say($event, 'I\'m sorry, I\'ve run out of cookies! You\'ll have to wait for me to bake some more.');
59         }
60     } elsif ($message =~ /^\s*(?:new|add)\s+(?:fortune\s+cookie|fortune|cookie)[-!:,;.\s]+(.....+?)\s*$/osi) {
61         if (not $self->findEntry('cookies', $1)) {
62             push(@{$self->{'cookies'}}, $1);
63             my $count = scalar(@{$self->{'cookies'}});
64             $self->say($event, "$event->{'from'}: Thanks! I have added that fortune cookie to my recipe book. I now have $count fortunes!");
65             $self->saveConfig();
66         } else {
67             $self->say($event, "$event->{'from'}: I'm pretty sure I already know that one.");
68         }
69     } elsif ($message =~ /^\s*cookie\s+(?:report|status|status\s+report)(?:\s+please)?[?!.1]*\s*$/osi) {
70         my $count = scalar(@{$self->{'cookies'}});
71         $self->say($event, "My cookie basket has $self->{'cookiesLeft'} cookies left out of possible $self->{'cookiesMax'}. I have $count fortunes in my recipe book.");
72     } elsif ($message =~ /^\s*fetch\s+cookies\s+from\s+(.+?)\s*$/osi) {
73         $self->getURI($event, $1, 'cookies');
74     } else {
75         return $self->SUPER::Told(@_);
76     }
77     return 0; # we've dealt with it, no need to do anything else.
78 }
79
80 sub GetNext {
81     my $self = shift;
82     my ($list) = @_;
83     $self->{"${list}Index"} = 0 if $self->{"${list}Index"} > $#{$self->{$list}};
84     my $reply = $self->{$list}->[$self->{"${list}Index"}++];
85     # should add some deterministic way of making the output appear more random here XXX
86     $self->saveConfig();
87     return $reply;
88 }
89
90 sub findEntry {
91     my $self = shift;
92     my ($list, $cookie) = @_;
93     $cookie =~ s/[\s,;.!?:]/_/gos;
94     $cookie = quotemeta($cookie);
95     $cookie =~ s/_/.*/gos;
96     my $regexp = qr/^$cookie$/is;
97     foreach my $text (@{$self->{$list}}) {
98         return 1 if $text =~ /$regexp/;
99     }
100     return 0;
101 }
102
103 sub Scheduled {
104     my $self = shift;
105     my ($event, @data) = @_;
106     if ($data[0] eq 'newCookie') {
107         $self->{'cookiesLeft'}++ unless $self->{'cookiesLeft'} >= $self->{'cookiesMax'};
108     } else {
109         $self->SUPER::Scheduled($event, @data);
110     }
111 }
112
113
114 sub GotURI {
115     my $self = shift;
116     my ($event, $uri, $output, $type) = @_;
117     if ($type eq 'cookies') {
118         my @output = split(/[\n\r]+/os, $output);
119         if ((@output) and ($output[0] eq "DATA FILE: $type")) {
120             if (@output <= 100) {
121                 my $count = 0;
122                 foreach (@output[1..$#output]) {
123                     if (/^[^#].+$/os and length($_) < 255 and not $self->findEntry($type, $_)) {
124                         push(@{$self->{$type}}, $_);
125                         $count++;
126                     }
127                 }
128                 my $total = scalar(@{$self->{$type}});
129                 my $s = $count > 1 ? 's' : '';
130                 if ($type eq 'cookies') {
131                     $self->say($event, "$event->{'from'}: Thanks! I have added $count fortune cookie$s to my recipe book. I now have $total fortunes!");
132                 }
133                 $self->saveConfig();
134             } else {
135                 $self->say($event, "$event->{'from'}: Sorry, but you can only import 100 lines at a time.");
136             }
137         } else {
138             $self->say($event, "$event->{'from'}: Sorry, but that's not a valid data file.");
139         }
140     } else {
141         return $self->SUPER::GotURI(@_);
142     }
143 }