BotModules/MiniLogger.bm

   1 ################################
   2 # MiniLogger Module            #
   3 ################################
   4
   5 package BotModules::MiniLogger;
   6 use vars qw(@ISA);
   7 @ISA = qw(BotModules);
   8 1;
   9
  10 sub Help {
  11     my $self = shift;
  12     my ($event) = @_;
  13     my %help = (
  14         '' => 'This module keeps a log of the last few comments that match some patterns. For example, it can be used to remember URIs that have recently been mentioned.',
  15     );
  16     foreach (keys %{$self->{'patterns'}}) {
  17         $help{$_} = 'Returns any recent comment that matched the pattern /'.$self->sanitizeRegexp($self->{'patterns'}->{$_})."/. To narrow the search down even more, you can include a search string after the $_, as in '$_ goats'. To restrict the search to a particular channel, append \'in <channel>\' at the end.";
  18     }
  19     if ($self->isAdmin($event)) {
  20         $help{''} .= ' To add a new pattern, use the following syntax: vars MiniLogger patterns \'+|name|pattern\'';
  21         $help{'flush'} = 'Deletes any logs for patterns or channels that are no longer relevant, makes sure all the logs are no longer than the \'bufferSize\' length. Syntax: \'flush minilogs\'.';
  22     }
  23     return \%help;
  24 }
  25
  26 # RegisterConfig - Called when initialised, should call registerVariables
  27 sub RegisterConfig {
  28     my $self = shift;
  29     $self->SUPER::RegisterConfig(@_);
  30     $self->registerVariables(
  31       # [ name, save?, settable? ]
  32         ['log', 0, 0, {}], # log -> channel -> patternName -> [<who> text]
  33         ['bufferSize', 1, 1, 20], # number of comments to remember, per channel/pattern combination
  34         ['patterns', 1, 1, {'links'=>'<?(:?[Uu][Rr][LlIi]:)?\s*(?:https?|ftp)://[^\s>"]+>?'}], # list of patternNames and patterns (regexp)
  35         ['blockedPatterns', 1, 1, []], # list of patterns (regexp) to ignore
  36     );
  37 }
  38
  39 sub Told {
  40     my $self = shift;
  41     my ($event, $message) = @_;
  42     if (($message =~ /^\s*([a-zA-Z0-9]+)(?:\s+(.+?))?(?:\s+in\s+(.+?))?\s*$/osi) and ($self->{'patterns'}->{$1})) {
  43         $self->Report($event, $3, $1, $2); # event, channel, log, pattern
  44     } elsif ($self->isAdmin($event)) {
  45         if ($message =~ /^\s*flush\s+minilogs\s*$/osi) {
  46             $self->FlushMinilogs($event);
  47         } else {
  48             return $self->SUPER::Told(@_);
  49         }
  50     } else {
  51         return $self->SUPER::Told(@_);
  52     }
  53     return 0; # we've dealt with it, no need to do anything else.
  54 }
  55
  56 sub Log {
  57     my $self = shift;
  58     my ($event) = @_;
  59     if (($event->{'firsttype'} eq 'Told') or ($event->{'firsttype'} eq 'Heard')) {
  60         $self->DoLog($event, "<$event->{'from'}> $event->{'data'}");
  61     } elsif (($event->{'firsttype'} eq 'Felt') or ($event->{'firsttype'} eq 'Saw')) {
  62         $self->DoLog($event, "* $event->{'from'} $event->{'data'}");
  63     }
  64 }
  65
  66 sub DoLog {
  67     my $self = shift;
  68     my ($event, $message) = @_;
  69     if ($event->{'channel'} ne '') {
  70         # don't log private messages
  71         foreach my $pattern (keys %{$self->{'patterns'}}) {
  72             my $regexp = $self->sanitizeRegexp($self->{'patterns'}->{$pattern});
  73             if ($message =~ /$regexp/s) {
  74                 # wohay, we have a candidate!
  75                 # now check for possible blockers...
  76                 unless ($self->isBlocked($message)) {
  77                     $self->debug("LOGGING: $message");
  78                     push(@{$self->{'log'}->{$event->{'channel'}}->{$pattern}}, $message);
  79                     if (@{$self->{'log'}->{$event->{'channel'}}->{$pattern}} > $self->{'bufferSize'}) {
  80                         shift(@{$self->{'log'}->{$event->{'channel'}}->{$pattern}});
  81                     }
  82                 }
  83             }
  84         }
  85     }
  86 }
  87
  88 sub isBlocked {
  89     my $self = shift;
  90     my ($message) = @_;
  91     foreach my $blockedPattern (@{$self->{'blockedPatterns'}}) {
  92         my $regexp = $self->sanitizeRegexp($blockedPattern);
  93         if ($message =~ /$regexp/s) {
  94             return 1;
  95         }
  96     }
  97     return 0;
  98 }
  99
 100 sub Report {
 101     my $self = shift;
 102     my ($event, $channel, $log, $pattern) = @_;
 103     my @channels = $channel ? lc($channel) : @{$self->{'channels'}};
 104     my $count;
 105     $pattern = $self->sanitizeRegexp($pattern);
 106     foreach $channel (@channels) {
 107         foreach my $match (@{$self->{'log'}->{$channel}->{$log}}) {
 108             if ((!$pattern) or ($match =~ /$pattern/s)) {
 109                 $self->directSay($event, $match);
 110                 $count++;
 111             }
 112         }
 113     }
 114     unless ($count) {
 115         $self->directSay($event, 'No matches, sorry.');
 116     }
 117     $self->channelSay($event, "$event->{'from'}: minilog matches /msg'ed");
 118 }
 119
 120 sub FlushMinilogs {
 121     my $self = shift;
 122     my ($event) = @_;
 123     # remove dead channels
 124     my %channels = map { lc($_) => 1 } @{$self->{'channels'}};
 125     foreach my $channel (keys %{$self->{'log'}}) {
 126         if ($channels{$channel}) {
 127             # remove dead logs
 128             foreach my $pattern (keys %{$self->{'log'}->{$channel}}) {
 129                 if ($self->{'patterns'}) {
 130                     # remove any newly blocked patterns
 131                     my @newpatterns;
 132                     foreach my $match (@{$self->{'log'}->{$channel}->{$pattern}}) {
 133                         unless ($self->isBlocked($match)) {
 134                             push (@newpatterns, $match);
 135                         }
 136                     }
 137                     # remove excess logs
 138                     if (@newpatterns) {
 139                         @{$self->{'log'}->{$channel}->{$pattern}} = (@newpatterns[
 140                             @newpatterns - $self->{'bufferSize'} < 0 ? 0 : @newpatterns - $self->{'bufferSize'},
 141                             $#newpatterns]
 142                                                                     );
 143                     } else {
 144                         @{$self->{'log'}->{$channel}->{$pattern}} = ();
 145                     }
 146                 } else {
 147                     delete($self->{'log'}->{$channel}->{$pattern});
 148                 }
 149             }
 150         } else {
 151             delete($self->{'log'}->{$channel});
 152         }
 153     }
 154     $self->say($event, 'Minilogs flushed.');
 155 }