################################ # Fortune Cookie Module # ################################ package BotModules::FortuneCookies; use vars qw(@ISA); @ISA = qw(BotModules); 1; sub Help { my $self = shift; my ($event) = @_; return { '' => 'A module to get random fortune cookies.', 'fortune' => 'Same as \'cookie\', which see.', '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\'.', '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.', '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.', 'fetch' => 'The command \'fetch cookies from \' will add each line in 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.', }; } # RegisterConfig - Called when initialised, should call registerVariables sub RegisterConfig { my $self = shift; $self->SUPER::RegisterConfig(@_); $self->registerVariables( # [ name, save?, settable? ] ['cookies', 1, 1, ['The sun will rise in the east today, indicating nothing in particular.']], ['cookiesIndex', 1, 1, 0], ['cookiesLeft', 0, 1, 10], ['bakingTime', 1, 1, 20], ['cookiesMax', 1, 1, 10], ); } # Schedule - called when bot connects to a server, to install any schedulers # use $self->schedule($event, $delay, $times, $data) # where $times is 1 for a single event, -1 for recurring events, # and a +ve number for an event that occurs that many times. sub Schedule { my $self = shift; my ($event) = @_; $self->schedule($event, \$self->{'bakingTime'}, -1, 'newCookie'); $self->SUPER::Schedule($event); } sub Told { my $self = shift; my ($event, $message) = @_; 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) { if ($self->{'cookiesLeft'} > 0) { $self->{'cookiesLeft'}--; my $cookie = $self->GetNext('cookies'); $cookie =~ s/%from%/$event->{'from'}/gos; $self->say($event, $cookie); } else { $self->say($event, 'I\'m sorry, I\'ve run out of cookies! You\'ll have to wait for me to bake some more.'); } } elsif ($message =~ /^\s*(?:new|add)\s+(?:fortune\s+cookie|fortune|cookie)[-!:,;.\s]+(.....+?)\s*$/osi) { if (not $self->findEntry('cookies', $1)) { push(@{$self->{'cookies'}}, $1); my $count = scalar(@{$self->{'cookies'}}); $self->say($event, "$event->{'from'}: Thanks! I have added that fortune cookie to my recipe book. I now have $count fortunes!"); $self->saveConfig(); } else { $self->say($event, "$event->{'from'}: I'm pretty sure I already know that one."); } } elsif ($message =~ /^\s*cookie\s+(?:report|status|status\s+report)(?:\s+please)?[?!.1]*\s*$/osi) { my $count = scalar(@{$self->{'cookies'}}); $self->say($event, "My cookie basket has $self->{'cookiesLeft'} cookies left out of possible $self->{'cookiesMax'}. I have $count fortunes in my recipe book."); } elsif ($message =~ /^\s*fetch\s+cookies\s+from\s+(.+?)\s*$/osi) { $self->getURI($event, $1, 'cookies'); } else { return $self->SUPER::Told(@_); } return 0; # we've dealt with it, no need to do anything else. } sub GetNext { my $self = shift; my ($list) = @_; $self->{"${list}Index"} = 0 if $self->{"${list}Index"} > $#{$self->{$list}}; my $reply = $self->{$list}->[$self->{"${list}Index"}++]; # should add some deterministic way of making the output appear more random here XXX $self->saveConfig(); return $reply; } sub findEntry { my $self = shift; my ($list, $cookie) = @_; $cookie =~ s/[\s,;.!?:]/_/gos; $cookie = quotemeta($cookie); $cookie =~ s/_/.*/gos; my $regexp = qr/^$cookie$/is; foreach my $text (@{$self->{$list}}) { return 1 if $text =~ /$regexp/; } return 0; } sub Scheduled { my $self = shift; my ($event, @data) = @_; if ($data[0] eq 'newCookie') { $self->{'cookiesLeft'}++ unless $self->{'cookiesLeft'} >= $self->{'cookiesMax'}; } else { $self->SUPER::Scheduled($event, @data); } } sub GotURI { my $self = shift; my ($event, $uri, $output, $type) = @_; if ($type eq 'cookies') { my @output = split(/[\n\r]+/os, $output); if ((@output) and ($output[0] eq "DATA FILE: $type")) { if (@output <= 100) { my $count = 0; foreach (@output[1..$#output]) { if (/^[^#].+$/os and length($_) < 255 and not $self->findEntry($type, $_)) { push(@{$self->{$type}}, $_); $count++; } } my $total = scalar(@{$self->{$type}}); my $s = $count > 1 ? 's' : ''; if ($type eq 'cookies') { $self->say($event, "$event->{'from'}: Thanks! I have added $count fortune cookie$s to my recipe book. I now have $total fortunes!"); } $self->saveConfig(); } else { $self->say($event, "$event->{'from'}: Sorry, but you can only import 100 lines at a time."); } } else { $self->say($event, "$event->{'from'}: Sorry, but that's not a valid data file."); } } else { return $self->SUPER::GotURI(@_); } }