BotModules/Sheriff.bm

   1 ################################
   2 # Sheriff Module               #
   3 ################################
   4
   5 package BotModules::Sheriff;
   6 use vars qw(@ISA);
   7 @ISA = qw(BotModules);
   8 1;
   9
  10 # RegisterConfig - Called when initialised, should call registerVariables
  11 sub RegisterConfig {
  12     my $self = shift;
  13     $self->SUPER::RegisterConfig(@_);
  14     $self->registerVariables(
  15       # [ name, save?, settable? ]
  16         ['tree', 1, 1, 'SeaMonkey'],
  17         ['baseURI', 1, 1, 'http://tinderbox.mozilla.org/'],
  18         ['_sheriff', 1, 0, undef], # the undef actually means "don't touch", of course
  19         ['updateDelay', 1, 1, 360],
  20         # XXX implement per-channel muting of the update notification
  21     );
  22 }
  23
  24 # Schedule - called when bot connects to a server, to install any schedulers
  25 # use $self->schedule($event, $delay, $times, $data)
  26 # where $times is 1 for a single event, -1 for recurring events,
  27 # and a +ve number for an event that occurs that many times.
  28 sub Schedule {
  29     my $self = shift;
  30     my ($event) = @_;
  31     $self->schedule($event, \$self->{'updateDelay'}, -1, 'sheriff');
  32     $self->SUPER::Schedule($event);
  33 }
  34
  35 sub Help {
  36     my $self = shift;
  37     my ($event) = @_;
  38     return {
  39         '' => 'The Sheriff module keeps track of the current sheriff.',
  40         'sheriff' => 'Display the current sheriff. Syntax: sheriff [tree]',
  41     };
  42 }
  43
  44 sub Told {
  45     my $self = shift;
  46     my ($event, $message) = @_;
  47     if ($message =~ /^\s*(?:who's\s+|whose\s+|whos\s+|who\s+is\s+the\s+|who\s+is\s+|who\s+)?sheriff(?:\s+(?:of\s+)?(.*?))?(?:[\s,]+today)?[.?!1]*\s*$/osi) {
  48         $self->GetSheriff($event, $1 || $self->{'tree'}, 'requested');
  49     } else {
  50         return $self->SUPER::Told(@_);
  51     }
  52     return 0; # dealt with it...
  53 }
  54
  55 sub GetSheriff {
  56     my $self = shift;
  57     my ($event, $tree, $requested) = @_;
  58     my $url = "$self->{'baseURI'}$tree/sheriff.pl";
  59     $self->getURI($event, $url, $tree, $requested);
  60 }
  61
  62 sub GotURI {
  63     my $self = shift;
  64     my ($event, $uri, $output, $tree, $requested) = @_;
  65     # someone please pretty up the logic here... XXX
  66     if ($output) {
  67         # magicness
  68         { no warnings; # this can go _very_ wrong easily
  69         # sheriff.pl is created using the following lines:
  70         # $m =~ s/\'/\\\'/g;
  71         # print SHERIFF "\$current_sheriff = '$m';\n1;";
  72         $output =~ s/^\$current_sheriff = '//gosi; # strip front
  73         $output =~ s/';\n1;$//gosi; # strip back
  74         $output =~ s/\\\'/\'/gosi; # dequote quotes
  75         # heuristics
  76         $output =~ s/<!--.*?-->//gos;
  77         $output =~ s/\n|\r|<a\s+href="|<\/a>//gosi;
  78         $output =~ s/">/, /gosi;
  79         $output =~ s/<br>|<\/?p><\/?div>/ /gosi;
  80         $output =~ s/<\/?(?:b|strong)>/*/gosi;
  81         $output =~ s/<\/?(?:u|em)>/_/gosi;
  82         $output =~ s/<\/?(?:q)>/"/gosi;
  83         $output =~ s/<\/?(?:i|dfn|cite)>/\//gosi;
  84         }
  85         if (defined($output)) {
  86             if ($tree eq $self->{'tree'}) {
  87                 if ((defined($self->{'_sheriff'})) and ($self->{'_sheriff'} ne '')) { # not first time
  88                     if ($output ne $self->{'_sheriff'}) { # changed.
  89                         $self->announce($event, "Sheriff change: $output");
  90                         if (($requested) and (not ($event->{'channel'}))) {
  91                             $self->directSay($event, "$output");
  92                         }
  93                     } elsif ($requested) {
  94                         $self->say($event, "$event->{'from'}: $output");
  95                     }
  96                 } else { # first time
  97                     $self->say($event, "$event->{'from'}: $output") if ($requested);
  98                 }
  99                 $self->{'_sheriff'} = $output; # update internal cache
 100             } else { # not default tree
 101                 if ($requested) {
 102                     $self->say($event, "$event->{'from'}: $output");
 103                 } # else EH!?
 104             }
 105         } else {
 106             # something went very wrong
 107             $self->say($event, "$event->{'from'}: I have no idea -- the '$tree' tree probably doesn't have a sheriff.") if ($requested);
 108             if ($tree eq $self->{'tree'}) {
 109                 if (defined($self->{'_sheriff'})) {
 110                     # only do it once
 111                     $self->tellAdmin($event, "Oh dear lord what happened to the '$tree' sheriff line on the tinderbox page!!");
 112                     $self->{'_sheriff'} = undef;
 113                 }
 114             }
 115         }
 116     } else {
 117         if ($tree eq $self->{'tree'}) {
 118             $self->say($event, "$event->{'from'}: Call an admin, I couldn't find the Sheriff page. Sorry!") if ($requested);
 119             if (defined($self->{'_sheriff'})) {
 120                 # only do it once
 121                 $self->tellAdmin($event, "Looks like either I am badly configured or tinderbox is down - '$tree' came up blank when I went looking for the Sheriff.");
 122                 $self->{'_sheriff'} = undef;
 123             }
 124         } else {
 125             if ($requested) {
 126                 $self->say($event, "$event->{'from'}: Are you sure there is a tree called '$tree'? I couldn't find one...");
 127             } # else EH!?
 128         }
 129     }
 130 }
 131
 132 sub Scheduled {
 133     my $self = shift;
 134     my ($event, @data) = @_;
 135     if ($data[0] eq 'sheriff') {
 136         $self->GetSheriff($event, $self->{'tree'}, 0);
 137     } else {
 138         $self->SUPER::Scheduled($event, @data);
 139     }
 140 }