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 }