pjs/webtools/mozbot/BotModules/MiniLogger.bm

################################
# MiniLogger Module            #
################################

package BotModules::MiniLogger;
use vars qw(@ISA);
@ISA = qw(BotModules);
1;

sub Help {
    my $self = shift;
    my ($event) = @_;
    my %help = (
        '' => '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.',
    );
    foreach (keys %{$self->{'patterns'}}) {
        $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.";
    }
    if ($self->isAdmin($event)) {
        $help{''} .= ' To add a new pattern, use the following syntax: vars MiniLogger patterns \'+|name|pattern\'';
        $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\'.';
    }
    return \%help;
}

# RegisterConfig - Called when initialised, should call registerVariables
sub RegisterConfig {
    my $self = shift;
    $self->SUPER::RegisterConfig(@_);
    $self->registerVariables(
      # [ name, save?, settable? ]
        ['log', 0, 0, {}], # log -> channel -> patternName -> [<who> text]
        ['bufferSize', 1, 1, 20], # number of comments to remember, per channel/pattern combination
        ['patterns', 1, 1, {'links'=>'<?(:?[Uu][Rr][LlIi]:)?\s*(?:https?|ftp)://[^\s>"]+>?'}], # list of patternNames and patterns (regexp)
        ['blockedPatterns', 1, 1, []], # list of patterns (regexp) to ignore
    );
}

sub Told {
    my $self = shift;
    my ($event, $message) = @_;
    if (($message =~ /^\s*([a-zA-Z0-9]+)(?:\s+(.+?))?(?:\s+in\s+(.+?))?\s*$/osi) and ($self->{'patterns'}->{$1})) {
        $self->Report($event, $3, $1, $2); # event, channel, log, pattern
    } elsif ($self->isAdmin($event)) {
        if ($message =~ /^\s*flush\s+minilogs\s*$/osi) {
            $self->FlushMinilogs($event);
        } else {
            return $self->SUPER::Told(@_);
        }
    } else {
        return $self->SUPER::Told(@_);
    }
    return 0; # we've dealt with it, no need to do anything else.
}

sub Log {
    my $self = shift;
    my ($event) = @_;
    if (($event->{'firsttype'} eq 'Told') or ($event->{'firsttype'} eq 'Heard')) {
        $self->DoLog($event, "<$event->{'from'}> $event->{'data'}");
    } elsif (($event->{'firsttype'} eq 'Felt') or ($event->{'firsttype'} eq 'Saw')) {
        $self->DoLog($event, "* $event->{'from'} $event->{'data'}");
    }
}

sub DoLog {
    my $self = shift;
    my ($event, $message) = @_;
    if ($event->{'channel'} ne '') {
        # don't log private messages
        foreach my $pattern (keys %{$self->{'patterns'}}) {
            my $regexp = $self->sanitizeRegexp($self->{'patterns'}->{$pattern});
            if ($message =~ /$regexp/s) {
                # wohay, we have a candidate!
                # now check for possible blockers...
                unless ($self->isBlocked($message)) {
                    $self->debug("LOGGING: $message");
                    push(@{$self->{'log'}->{$event->{'channel'}}->{$pattern}}, $message);
                    if (@{$self->{'log'}->{$event->{'channel'}}->{$pattern}} > $self->{'bufferSize'}) {
                        shift(@{$self->{'log'}->{$event->{'channel'}}->{$pattern}});
                    }
                }
            }
        }
    }
}

sub isBlocked {
    my $self = shift;
    my ($message) = @_;
    foreach my $blockedPattern (@{$self->{'blockedPatterns'}}) {
        my $regexp = $self->sanitizeRegexp($blockedPattern);
        if ($message =~ /$regexp/s) {
            return 1;
        }
    }
    return 0;
}

sub Report {
    my $self = shift;
    my ($event, $channel, $log, $pattern) = @_;
    my @channels = $channel ? lc($channel) : @{$self->{'channels'}};
    my $count;
    $pattern = $self->sanitizeRegexp($pattern);
    foreach $channel (@channels) {
        foreach my $match (@{$self->{'log'}->{$channel}->{$log}}) {
            if ((!$pattern) or ($match =~ /$pattern/s)) {
                $self->directSay($event, $match);    
                $count++;
            }
        }
    }
    unless ($count) {
        $self->directSay($event, 'No matches, sorry.');
    }
    $self->channelSay($event, "$event->{'from'}: minilog matches /msg'ed");
}

sub FlushMinilogs {
    my $self = shift;
    my ($event) = @_;
    # remove dead channels
    my %channels = map { lc($_) => 1 } @{$self->{'channels'}};
    foreach my $channel (keys %{$self->{'log'}}) {
        if ($channels{$channel}) {
            # remove dead logs
            foreach my $pattern (keys %{$self->{'log'}->{$channel}}) {
                if ($self->{'patterns'}) {
                    # remove any newly blocked patterns
                    my @newpatterns;
                    foreach my $match (@{$self->{'log'}->{$channel}->{$pattern}}) {
                        unless ($self->isBlocked($match)) {
                            push (@newpatterns, $match);
                        }
                    }
                    # remove excess logs
                    if (@newpatterns) {
                        @{$self->{'log'}->{$channel}->{$pattern}} = (@newpatterns[ 
                            @newpatterns - $self->{'bufferSize'} < 0 ? 0 : @newpatterns - $self->{'bufferSize'},
                            $#newpatterns]
                                                                    ); 
                    } else {
                        @{$self->{'log'}->{$channel}->{$pattern}} = ();
                    }
                } else {
                    delete($self->{'log'}->{$channel}->{$pattern});
                }
            }
        } else {
            delete($self->{'log'}->{$channel});
        }
    }
    $self->say($event, 'Minilogs flushed.');
}