pjs/webtools/mozbot/BotModules/General.bm

# -*- Mode: perl; tab-width: 4; indent-tabs-mode: nil; -*-
################################
# General Module               #
################################

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

my $VERSION = '2.5';

# RegisterConfig - Called when initialised, should call registerVariables
sub RegisterConfig {
    my $self = shift;
    $self->SUPER::RegisterConfig(@_);
    $self->registerVariables(
      # [ name, save?, settable?, value ]
        ['preferredHelpLineLength', 1, 1, 90],
        ['helpStyle', 1, 1, 'compact'], # change this to 'tidy' to use alternate style
    );
}

sub Help {
    my $self = shift;
    my ($event) = @_;
    return {
        '' => 'The module that provides the bot-wide services.',
        'help' => 'Gives information about modules and commands. Syntax: help [<topic>]',
        'shutup' => 'Tells the bot to stop talking to you. Syntax: shut up',
    };
}

# Told - Called for messages prefixed by the bot's nick
sub Told {
    my $self = shift;
    my ($event, $message) = @_;
    if ($message =~ /^\s*help(?:\s+($variablepattern))?[ ?!.]*\s*$/osi) {
        if ($1) {
            # display help for that command
            # first, build the help file...
            my %topicList;
            foreach my $module (@modules) {
                my $commands = $module->Help($event);
                if ($commands->{''}) {
                    my @commands = grep { /./os } keys %$commands;
                    $topicList{lc($module->{'_name'})} = [] unless defined($topicList{lc($module->{'_name'})});
                    push(@{$topicList{lc($module->{'_name'})}}, $commands->{''});
                    if (@commands) {
                        local $" = ', ';
                        push(@{$topicList{lc($module->{'_name'})}}, "The $module->{'_name'} module has the following help topics: @commands");
                    }
                }
                foreach (keys %$commands) {
                    $topicList{lc($_)} = [] unless defined($topicList{lc($_)});
                    push(@{$topicList{lc($_)}}, $commands->{lc($_)});
                }
            }
            if (defined($topicList{lc($1)})) {
                foreach (@{$topicList{lc($1)}}) {
                    $self->say($event, "$1: $_");
                }
            } else {
                $self->say($event, "No help for topic '$1'.");
            }
        } else {
            my $helpline = $self->getHelpLine();
            $self->directSay($event, "Help topics for mozbot $VERSION ($helpline):");
            $self->say($event, "$event->{'from'}: help info /msg'ed") if ($event->{'channel'});
            if ($self->{'helpStyle'} eq 'compact') {
                $self->printHelpCompact($event);
            } else {
                $self->printHelpTidy($event);
            }
            $self->directSay($event, 'For help on a particular topic, type \'help <topic>\'. Note that some commands may be disabled in certain channels.');
        }
    } elsif ($message =~ /^\s*shut\s*up\s*$/osi) {
        my $queue = $self->getMessageQueue();
        my @messages = @$queue;
        @$queue = ();
        my $count = 0;
        if ($event->{'channel'}) {
            foreach my $message (@messages) {
                if ($message->[0] eq $event->{'channel'} and
                    ref $message->[1] eq 'SCALAR' and
                    $message->[1] =~ m/^\Q$event->{'from'}\E:/osi) {
                    ++$count;
                } else {
                    push(@$queue, $message);
                }
            }
        } else {
            foreach my $message (@messages) {
                if (lc $message->[0] eq lc $event->{'from'}) {
                    ++$count;
                } else {
                    push(@$queue, $message);
                }
            }
        }
        if ($count) {
            $self->say($event, "$event->{'from'}: Dropped $count messages.");
        } else {
            $self->say($event, "$event->{'from'}: I wasn't talking to you.");
        }
    } else {
        return $self->SUPER::Told(@_);
    }
    return 0; # dealt with it, do nothing else
}

sub CTCPVersion {
    my $self = shift;
    my ($event, $who, $what) = @_;
    my @modulenames = $self->getModules();
    local $" = ', ';
    $self->ctcpReply($event, 'VERSION', "mozbot $VERSION (@modulenames)");
}

sub printHelpCompact {
    my $self = shift;
    my ($event) = @_;
    local $" = ', '; # to reset font-lock: "
    my @helplist;
    foreach my $module ($self->getModules()) {
        $module = $self->getModule($module);
        my %commands = %{$module->Help($event)};
        my $moduleHelp = delete($commands{''});
        my @commands = sort keys %commands;
        if (@commands) {
            push(@helplist, "$module->{'_name'}: @commands");
        } elsif ($moduleHelp) {
            push(@helplist, "$module->{'_name'}");
        }
    }
    foreach ($self->prettyPrint($self->{'preferredHelpLineLength'}, undef, '  ', ';  ', @helplist)) {
        $self->directSay($event, $_);
    }
}

sub printHelpTidy {
    my $self = shift;
    my ($event) = @_;
    my @modules = sort $self->getModules();
    my $longestTitle = 0;
    foreach my $module (@modules) {
        $longestTitle = length($module) if length($module) > $longestTitle;
        $module = [$module, sort keys %{$self->getModule($module)->Help($event)}];
    }
    foreach my $module (@modules) {
        my $title = shift(@$module);
        my $topicCount = @$module;
        if (@$module and $module->[0] eq '') {
            shift(@$module);
        }
        my @topics = @$module;
        $module = ' ' x ($longestTitle - length($title)) . $title;
        if (@topics) {
            $self->directSay($event, $module . ': ' . join(",\n" . ' ' x ($longestTitle + 2), $self->wordWrap($self->{'preferredHelpLineLength'} - $longestTitle - 2, undef, undef, ', ', @topics)));
        } elsif ($topicCount) {
            $self->directSay($event, "$module: (no commands)");
        }
    }
}