ROBOT9000.pl


#!/usr/bin/perl -w
#
#  Enforced originality!  If someone repeats something that has been already
#  said in channel, silence them.  Silence time increasing geometrically.
#
#  Copyright (C) 2007  Dan Boger - zigdon+bot@gmail.com
#
#  This program is free software; you can redistribute it and/or modify
#  it under the terms of the GNU General Public License as published by
#  the Free Software Foundation; either version 2 of the License, or
#  (at your option) any later version.
#
#  This program is distributed in the hope that it will be useful,
#  but WITHOUT ANY WARRANTY; without even the implied warranty of
#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#  GNU General Public License for more details.
#
#  You should have received a copy of the GNU General Public License
#  along with this program; if not, write to the Free Software Foundation,
#  Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
#
# A current copy of this code can be found at:
#
#   http://irc.peeron.com/xkcd/ROBOT9000.html
#   http://irc.peeron.com/xkcd/ROBOT9000.pl
#   http://irc.peeron.com/xkcd/ROBOT9000.yml
#   http://irc.peeron.com/xkcd/ROBOT9000.sql
#
# Changelog:
#
#   http://irc.peeron.com/xkcd/ROBOT9000.changelog.txt
#
# By default, the next mute time never goes down.  To have it decay, set up a
# cronjob such as this:
#
# 0 */6 * * * echo "update users set timeout_power = timeout_power - 1 where timeout_power > 0" | mysql -D databasename
#
#
# $Id: ROBOT9000.pl 498 2009-03-02 02:36:29Z dan $

use strict;
use Net::IRC;
use Time::HiRes qw/usleep/;
use DBI;
use Date::Calc qw/Normalize_DHMS/;
use Data::Dumper;
use YAML qw/LoadFile/;

use constant {
    DEBUG   => 0,
    VERSION => '$Id: ROBOT9000.pl 498 2009-03-02 02:36:29Z dan $'
};

# Load config file - sample file at:
# http://irc.peeron.com/xkcd/ROBOT9000.yml
my $config_file = shift or die "Usage: $0 <config> [<log file to load>]";
my $config = LoadFile($config_file);

# when is the next time someone should be unbanned?
my $next_unban = 1;

# when should we run the cleanup next?
my $maint_time = time + 20;

# when was the last time we heard *anything*
my $last_public = time;

# some annoying globals
my $topic;
my %nicks;
my %nicks_tmp;
my $nick_re;
my %nick_changes;
my %common_words;
my %sql;
my @lookup_queue;

# what modes are used to deop/op?
my %op_table = ( "%" => "h", "@" => "o", "~" => "q", "&" => "a" );
my %rev_op_table = reverse %op_table;

# connect to the IRC server and the database
my ( $irc, $irc_conn, $dbh ) = &setup(@ARGV ? 0 : 1);

if (@ARGV) {  # we're only loading an existing log file, not actually running
  print "Loading log files...\n";
  &load_log;
}

&event_loop;

sub logmsg {
    print scalar localtime, " - @_\n";
    print LOG scalar localtime, " - @_\n",;
}

sub event_loop {

    #warn "event_loop (@_)\n";

    while (1) {
        $irc->do_one_loop();
        usleep 50;

        if ( $next_unban and time > $next_unban ) {
            &process_unbans;
        }

        if ( time > $maint_time ) {
            logmsg "Running maint";
            $irc_conn->mode( $config->{irc_chan}, "+m" );

            while (@lookup_queue) {
                my @batch = splice( @lookup_queue, 0, $config->{names_request_size} || 5, () );
                logmsg "Looking up hostmasks... ", join ", ", @batch;
                $irc_conn->userhost(@batch);
                usleep 250;
            }

            foreach ( keys %nick_changes ) {
                next if $nick_changes{$_}[0] + 300 > time;

                logmsg "Clearing nick_changes for $_";
                delete $nick_changes{$_};
                $irc_conn->mode( $config->{irc_chan}, "-b", "~n:$_" );
            }

            $maint_time = time + 300;

            if ( time - $last_public > $config->{fortune_time} + 300 ) {
                logmsg "Seems like we're not connected. restarting";
                exit;
            }
            elsif ( time - $last_public > $config->{fortune_time} ) {
                $irc_conn->userhost( $config->{irc_nick} );
                logmsg "Too quiet.  Ping?";
                sleep 1;

                if ( -x $config->{fortune_command} ) {
                    $irc_conn->privmsg( $config->{irc_chan}, $_ )
                      foreach ( "It's too quiet:",
                        split /\n/, `$config->{fortune_command}` );
                }
            }
        }
    }
}

sub process_unbans {
    $sql{get_unbans}->execute(time);
    while ( my ( $nick, $userhost, $id, $bantype ) =
        $sql{get_unbans}->fetchrow_array )
    {
        logmsg "Restoring $userhost";
        if ( $bantype eq 'v' ) {
            $irc_conn->mode( $config->{irc_chan}, "+v", $nick );
            $nicks{$nick} = "+" unless $nicks{$nick};
        }
        else {
            $irc_conn->mode( $config->{irc_chan}, "+v$op_table{$bantype}",
                $nick, $nick );
            $nicks{$nick} = $bantype;
        }
        $sql{clear_ban}->execute($id);

      #$irc_conn->privmsg( $nick, "you may now speak in $config->{irc_chan}." );
    }

    $sql{next_unban}->execute;
    ($next_unban) = $sql{next_unban}->fetchrow_array;
    $sql{next_unban}->finish;
}

sub setup {
    my $connect = shift;

    #warn "setup (@_)\n";
    # open our log file
    open LOG, ">>", $config->{logfile}
      or die "Can't write to $config->{logfile}: $!";
    logmsg "Starting up, version", VERSION;
    sleep 5;

    # connect to the database
    logmsg "Connecting dbi://$config->{db_user}\@$config->{db_name}";
    my $dbh = DBI->connect( "DBI:mysql:database=$config->{db_name}",
        $config->{db_user}, $config->{db_pass} )
      or die "Can't connect to the database!";
    $dbh->{RaiseError} = 1;

    logmsg "Preparing SQL statements";
    $sql{lookup_line} = $dbh->prepare(
        "select id from `lines`
                    where msg = ?
                    limit 1"
    );
    $sql{add_line} = $dbh->prepare(
        "insert into `lines` (msg)
                  values (?)"
    );
    $sql{lookup_user} = $dbh->prepare(
        "select timeout_power, banned_until from users
                    where mask = ?
                    limit 1"
    );
    $sql{lookup_mask} = $dbh->prepare(
        "select mask 
                      from users
                    where nick = ?
                    order by last_talk desc
                    limit 1"
    );
    $sql{update_user} = $dbh->prepare(
        "update users
                        set timeout_power = timeout_power + 2,
                                banned_until = ?,
                                nick = ?, 
                                total_bans = total_bans + 1,
                                ban_type = ?
                    where mask = ?
                    limit 1"
    );
    $sql{update_nick} = $dbh->prepare(
        "update users
                        set nick = ?
                    where mask = ?
                    limit 1"
    );
    $sql{add_user} = $dbh->prepare(
        "insert into users (banned_until, nick, mask, timeout_power, 
                                                        lines_talked, total_bans, ban_type)
                  values (?, ?, ?, ?, 0, 0, ?)"
    );
    $sql{user_talk} = $dbh->prepare(
        "update users
                        set lines_talked = lines_talked + 1,
                                word_count   = word_count + ? + 1,
                                last_talk    = null
                    where mask = ?
                    limit 1"
    );
    $sql{next_unban} = $dbh->prepare(
        "select min(banned_until)
                      from users
                    where banned_until > 0"
    );
    $sql{get_unbans} = $dbh->prepare(
        "select nick, mask, id, ban_type
                      from users
                    where banned_until > 0
                        and banned_until <= ?"
    );
    $sql{clear_ban} = $dbh->prepare(
        "update users
                        set banned_until = 0
                    where id = ?"
    );
    $sql{high_score} = $dbh->prepare(
"select nick, lines_talked/word_count * lines_talked/(total_bans + 1) as score
                  from users
                  order by lines_talked/word_count * lines_talked/(total_bans + 1) desc, lines_talked desc
                  limit 1"
    );

    return ( $irc, $irc_conn, $dbh ) unless $connect;

    # log into IRC
    logmsg "Connecting irc://$config->{irc_nick}";
    $irc = new Net::IRC;
    my $irc_conn = $irc->newconn(
        Nick     => $config->{irc_nick},
        Server   => $config->{irc_server},
        Ircname  => $config->{irc_name},
        Username => $config->{irc_username} || "ROBOT9000",
    );

    if (DEBUG) {
        open DEBUG_FH, ">>$config->{logfile}.debug"
          or die "Can't write to $config->{logfile}.debug: $!";
        $irc_conn->add_default_handler( \&dump_event );
    }

    # talk events
    $irc_conn->add_handler( public  => \&irc_on_public );
    $irc_conn->add_handler( caction => \&irc_on_public );
    $irc_conn->add_handler( notice  => \&irc_on_notice );
    $irc_conn->add_handler( msg     => \&irc_on_msg );

    # user events
    $irc_conn->add_handler( nick => \&irc_on_nick );
    $irc_conn->add_handler( join => \&irc_on_joinpart );
    $irc_conn->add_handler( part => \&irc_on_joinpart );
    $irc_conn->add_handler( quit => \&irc_on_joinpart );

    # server events
    $irc_conn->add_handler( endofmotd  => \&irc_on_connect );
    $irc_conn->add_handler( nomotd     => \&irc_on_connect );
    $irc_conn->add_handler( topic      => \&irc_on_topic );
    $irc_conn->add_handler( namreply   => \&irc_on_names );
    $irc_conn->add_handler( endofnames => \&irc_on_endnames );
    $irc_conn->add_handler( mode       => \&irc_on_mode );
    $irc_conn->add_handler( userhost   => \&irc_on_userhost );
    $irc_conn->add_handler(
        chanoprivsneeded => sub {
            logmsg "Reauthing to nickserv";
            $irc_conn->privmsg( "nickserv", "identify $config->{irc_pass}" );
        }
    );

    logmsg "Setup complete";

    logmsg "Loading common words...";
    open( WORDS, $config->{common_file} )
      or die "Can't read $config->{common_file}: $!";
    while (<WORDS>) {
        chomp;
        $common_words{ lc $_ } = 1;
    }
    close WORDS;
    logmsg "Loaded ", scalar keys %common_words, " words";

    return ( $irc, $irc_conn, $dbh );
}

# event handlers
sub irc_on_connect {

    #warn "irc_on_connect (@_)\n";
    my ( $self, $event ) = @_;

    logmsg "Connected to IRC, joining $config->{irc_chan}";
    $self->join( $config->{irc_chan} );

    logmsg "Authenticating";
    $self->privmsg( "nickserv", "identify $config->{irc_pass}" );

    sleep 2;
    $irc_conn->names;
}

sub irc_on_notice {
    my ( $self, $event ) = @_;
    my ( $nick, $msg ) = ( $event->nick, $event->args );

    logmsg "Notice from $nick to " . @{ $event->to }[0] . ": $msg";
    return if ${ $event->to }[0] ne $config->{irc_chan};

    &fail( $self, $nick, $event->userhost,
        "Failed for sending notices to channel" );
}

sub irc_on_msg {

    #warn "irc_on_msg (@_)\n";
    my ( $self, $event ) = @_;
    my ( $nick, $msg ) = ( $event->nick, $event->args );
    my @args;
    ( $msg, @args ) = split ' ', $msg;

    return if $nick eq $config->{irc_nick};

    logmsg "PRIVMSG $nick($nicks{$nick}): $msg @args";
    if ( lc $msg eq 'version' ) {
        $self->privmsg( $nick, VERSION );
    }
    elsif ( lc $msg eq 'timeout' ) {
        my ( $timeout, $banned_until );
        if ( $args[0] ) {
            if ( $sql{lookup_mask}->execute( $args[0] ) > 0 ) {
                my ($mask) = $sql{lookup_mask}->fetchrow_array;
                $sql{lookup_mask}->finish;
                ( $timeout, $banned_until ) = &get_timeout($mask);
            }
        }
        else {
            ( $timeout, $banned_until ) = &get_timeout( $event->userhost );
        }

        if ($timeout) {
            $timeout = &timeout_to_text( 2**( $timeout + 2 ) );

            $self->privmsg( $nick, "Next timeout will be $timeout" );

            if ($banned_until) {
                $self->privmsg( $nick,
                    "Currently muted, can speak again in "
                      . &timeout_to_text( $banned_until - time ) );
            }
        }
        else {
            $self->privmsg( $nick, "No timeout found" );
        }
    }
    elsif (
        (
            exists $config->{auth}{ lc $nick }
            and $event->userhost =~ /$config->{auth}{ lc $nick }/
        )
        or $nicks{$nick} =~ /[~@&%]/
      )
    {
        logmsg "AUTH $nick: $msg ($nicks{$nick})";
        if ( $msg eq 'quit' ) {
            $self->privmsg( $nick, "Quitting" );
            exit;
        }
        elsif ( $msg eq 'msg' and exists $config->{auth}{ lc $nick } ) {
            $self->privmsg( $nick, "Ok - sending $args[0]: @args[1..$#args]" );
            $self->privmsg( $args[0], join " ", @args[ 1 .. $#args ] );
            logmsg "Sending MSG to $args[0]: @args[1..$#args]";
        }
        elsif ( $msg eq 'unban' ) {
            logmsg "Unbanning $args[0] by command";
            $self->mode( $config->{irc_chan}, "-b", $args[0] );
        }
        elsif ( $msg eq 'mode' ) {
            logmsg "Setting mode @args by command";
            $self->mode( $config->{irc_chan}, @args );
        }
        elsif ( $msg eq 'kick' ) {
            logmsg "Kicking $args[0] by command";
            $self->kick(
                $config->{irc_chan}, $args[0],
                $args[1]
                ? join " ",
                $args[ 1 .. $#args ]
                : "Kick"
            );
        }
        elsif ( $msg eq 'fail' and $args[0] =~ /([^!]+)!(\S+)/ ) {
            logmsg "Failing $1!$2 by command";
            &fail(
                $self, $1, $2,
                "Failed by a live moderator",
                "$nick failed $args[0]: @args[1..$#args]"
            );
        }
        elsif ( $msg eq 'nick_re' ) {
            logmsg "Current nick re: $nick_re";
            $self->privmsg( $nick, "Ok, logged" );
        }
        elsif ( $msg eq 'names' ) {
            logmsg "Current names: ", join ", ",
              map { "$_($nicks{$_})" } sort keys %nicks;
            $self->privmsg( $nick, "Current names: ",
                join ", ", map { "$_($nicks{$_})" } sort keys %nicks );
        }
        elsif ( $msg eq 'fail' ) {
            if ( $sql{lookup_mask}->execute( $args[0] ) > 0 ) {
                my ($mask) = $sql{lookup_mask}->fetchrow_array;
                $sql{lookup_mask}->finish;
                logmsg "Failing $args[0]!$mask by command";
                &fail(
                    $self, $args[0], $mask,
                    "Failed by a live moderator",
                    "$nick failed $args[0]: @args[1..$#args]"
                );
            }
            else {
                logmsg "Couldn't find mask for $args[0]";
            }
        }
        elsif ( $msg eq 'check' ) {
            logmsg "Checking for pending mutes to restore";
            $self->privmsg( $nick, "Ok, processing mutes to restore" );
            &process_unbans;
        }
        else {
            foreach (
"Commands: timeout - query if you're banned, and what your next ban will be",
                "          timeout <nick> - same, for someone else",
                "          unban   - unban given nickmask",
                "          check   - check if there are any pending unmutes",
                "          kick <nick> <msg> - kick someone",
"          names - list the currently known privs of users in channel",
"          fail <nick> <msg> - have the moderator manually silence <nick>",
                "          version        - report current version",
              )
            {
                $self->privmsg( $nick, $_ );
            }
        }
    }
    else {
        foreach (
"Commands: timeout <nick> - query if you're banned, and what your next ban will be",
            "          version        - report current version",
          )
        {
            $self->privmsg( $nick, $_ );
        }
        logmsg "Ignoring PRIVMSG from $nick ", $event->userhost;
    }

}

# public msg - someone talking in chat
sub irc_on_public {

    #warn "irc_on_public (@_)\n";
    my ( $self, $event ) = @_;
    my ( $nick, $userhost ) = ( $event->nick, $event->userhost );
    my ($msg) = ( $event->args );

    $last_public = time;
    if ( $nick eq $config->{irc_nick} ) {
        logmsg "*** Still connected, it seems";
        return;
    }

    logmsg "$nick: $msg";
    my $length = length $msg;

    # process the message so that we strip them down
    $msg = &strip($msg);

    if (   $length == 0
        or $length > 10 and length($msg) / $length < $config->{signal_ratio} )
    {
        &fail(
            $self, $nick, $userhost,
            "Not enough content",
            "Not enough content: " . length($msg) . " vs $length"
        );
        return;
    }

    # check if the line was already in the DB
    my $res = $sql{lookup_line}->execute($msg);

    if ( $res > 0 ) {

        # kick!
        &fail( $self, $nick, $userhost );
    }
    else {

        # add it as a new line
        $sql{add_line}->execute($msg);

        my $words = ( $msg =~ tr/ / / );
        if ( $sql{user_talk}->execute( $words, $userhost ) == 0 ) {
            $sql{add_user}->execute( 0, $nick, $userhost, 0, "v" );
            $sql{user_talk}->execute( $words, $userhost );
        }
    }

    $sql{lookup_line}->finish;
}

sub strip {
    my $msg = shift;

    # remove case
    $msg = lc $msg;

    # remove addressing nicks:
    $msg =~ s/^\S+: ?//;

    # remove any nicks referred to
    $msg =~ s/(?:^|\b)(?:$nick_re)(?:\b|$)/ /g if $nick_re;

    # remove control chars
    $msg =~ s/[[:cntrl:]]//g;

    # remove smilies
    $msg =~
s/(?:^|\s)(?:[[:punct:]]+\w|[[:punct:]]+\w|[[:punct:]]+\w[[:punct:]]+)(?:\s|$)/ /g;

    # remove punct
    $msg =~ s/([a-zA-Z])'([a-zA-Z])/$1$2/g;
    $msg =~ s/[^a-zA-Z\d -]+/ /g;

    # remove lone '-'
    $msg =~ s/(?<!\w)-+|-+(?!\w)/ /g;

    # repeating chars
    $msg =~ s/(.)\1{2,}/$1$1/g;
    $msg =~ s/(..)\1{2,}/$1$1/g;

    # removing leading/trailing/multiple spaces
    $msg =~ s/^\s+|\s+$//g;
    $msg =~ s/\s\s+/ /g;

    return $msg;
}

sub get_timeout {
    my $mask = shift;

    $sql{lookup_user}->execute($mask);
    my ( $timeout, $banned_until ) = $sql{lookup_user}->fetchrow_array;
    $sql{lookup_user}->finish;

    return ( $timeout, $banned_until );
}

sub timeout_to_text {
    my $timeout = shift;

    my ( $dd, $dh, $dm, $ds ) = Normalize_DHMS( 0, 0, 0, $timeout );
    my $delta_text;
    $delta_text .= "$dd day" .    ( $dd == 1 ? " " : "s " ) if $dd;
    $delta_text .= "$dh hour" .   ( $dh == 1 ? " " : "s " ) if $dh;
    $delta_text .= "$dm minute" . ( $dm == 1 ? " " : "s " ) if $dm;
    $delta_text .= "$ds second" . ( $ds == 1 ? " " : "s " ) if $ds;
    $delta_text =~ s/ $//;

    return $delta_text;
}

# fail - silence for 2**2n
sub fail {

    my ( $self, $nick, $userhost, $msg, $opmsg ) = @_;

    logmsg "Failing $nick ($userhost)";
    logmsg "msg: $msg"     if $msg;
    logmsg "opmsg: $opmsg" if $opmsg;

    # look up the last timeout value for this userhost, default is 1
    my ( $timeout, $banned_until ) = &get_timeout($userhost);

    $timeout += 2;

    # someone abusing the system in some way
    if ( 2**$timeout > $config->{timeout_limit} ) {
        logmsg "Kickbanning $nick ($userhost)";
        $self->notice( $config->{irc_chan}, "$nick, thanks for playing!" );
        $self->mode( $config->{irc_chan}, "+b", $userhost );
        $self->kick( $config->{irc_chan}, $nick, "Go away" );
        return;
    }

    my $delta_text = &timeout_to_text( 2**$timeout );

    if ($msg) {
        $self->notice( $config->{irc_chan},
            "$nick, you have been muted for $delta_text: $msg" );
        $self->notice( "\@$config->{irc_chan}", $opmsg ) if $opmsg;
    }
    elsif ( not $banned_until or $banned_until <= 1 ) {
        $self->notice( $config->{irc_chan},
            "$nick, you have been muted for $delta_text." );
        $self->notice( "\@$config->{irc_chan}", $opmsg ) if $opmsg;
    }

    my $bantype = "v";
    if ( not $nicks{$nick} or $nicks{$nick} eq '+' or $nicks{$nick} eq '1' ) {
        $self->mode( $config->{irc_chan}, "-v", $nick );
    }
    else {
        if ( exists $op_table{ $nicks{$nick} } ) {
            logmsg
"$nick is an operator ($nicks{$nick}) - deopping first (-$op_table{$nicks{$nick}})";
            $self->mode( $config->{irc_chan}, "-v$op_table{$nicks{$nick}}",
                $nick, $nick );
        }
        else {
            logmsg "$nick is an operator ($nicks{$nick}) - can't deop";
            $self->mode( $config->{irc_chan}, "-v", $nick );
        }
        $bantype = $nicks{$nick};
    }

    my $target = time + 2**$timeout;

    if (
        $sql{update_user}->execute( $target, $nick, $bantype, $userhost ) == 0 )
    {
        $sql{add_user}->execute( $target, $nick, $userhost, 2, $bantype );
    }
    logmsg "Silenced for " . ( 2**$timeout ) . " seconds";

    if ( not $next_unban or $target < $next_unban ) {
        $next_unban = $target;
    }

    # if someone gets failed while already muted, just punt them
    if ( $banned_until and $banned_until > 1 and
         (not defined $msg or $msg ne 'Failed by a live moderator') ) {
        $self->kick( $config->{irc_chan}, $nick, "Come back later" );
        logmsg "Kicking $nick for getting muted while muted";
    }
}

sub kick {

    #warn "kick (@_)\n";
    my ( $self, $nick, $userhost, $msg ) = @_;

    &fail( $self, $nick, $userhost, $msg );

    $msg ||= "Go away";

    logmsg "Kicking $nick ($userhost): $msg";

    $self->kick( $config->{irc_chan}, $nick, $msg );
}

sub load_log {
    while (<>) {

        # http://isomerica.net/~xkcd/#xkcd.log
        # 20:50 <@zigdon> oh, right, he can't actually kick you
        # 20:56  * zigdon tests
        #

        next unless s/.*?[>*] //;
        chomp;

        my $msg = &strip($_);

        my $res = $sql{lookup_line}->execute($msg);
        next if $res > 0;
        print "$msg\n";
        $sql{add_line}->execute($msg);
    }
    exit;
}

sub update_nick_re {
    $nick_re = $config->{irc_nick};
    $nick_re .= "|\Q$_\E"
      foreach grep { not exists $common_words{$_} } keys %nicks;
    $nick_re = qr/$nick_re/i;

    #logmsg "Nick_re = $nick_re";
}

sub irc_on_nick {
    my ( $self, $event ) = @_;
    my ( $oldnick, $newnick, $userhost ) =
      ( lc $event->nick, $event->args, $event->userhost );
    $newnick = lc $newnick;

    $last_public = time;

    $nicks{$newnick} = $nicks{$oldnick};
    delete $nicks{$oldnick};

    # if they're banned, we need to update the table with their new nick
    if ( $sql{update_nick}->execute( $newnick, $userhost ) > 0 ) {
        logmsg "Nick updated in database";
    }

# if someone changes nicks too often (more than 3 times in a maint period), that's a fail
    if ( exists $nick_changes{$userhost} ) {
        $nick_changes{$userhost}[0] = time;

        if ( $nick_changes{$userhost}[1]++ > 1 ) {
            my ( $timeout, $banned_until );
            if ( ( $timeout, $banned_until ) = &get_timeout($userhost)
                and $banned_until )
            {
                $self->mode( $config->{irc_chan}, "+b", "~n:$userhost" );
                &fail( $self, $newnick, $userhost,
                    "Failed for changing nicks too often" );
            }
        }
        elsif ( $nick_changes{$userhost}[1] > 5 ) {
            &kick( $self, $newnick );
        }
    }
    else {
        $nick_changes{$userhost} = [ time, 1 ];
    }

    logmsg
      "$oldnick is now known as $newnick ($nick_changes{$userhost}[1] since ",
      scalar localtime $nick_changes{$userhost}[0], ")";
    &update_nick_re;
}

sub irc_on_joinpart {
    my ( $self, $event ) = @_;
    my ($nick) = lc $event->nick;

    $last_public = time;

    my $action;
    if ( $event->{type} eq 'join' ) {
        $nicks{$nick} = 1;
        $action = "joined";

        # make sure the DB has the correct nick for this user
        $sql{update_nick}->execute( $nick, $event->userhost );

        # if this is a new user, give them voice after a minute (disabled)
        # if it's an existing user, and they're not currently banned, give them
        # voice immediately
        if ( $sql{lookup_user}->execute( $event->userhost ) > 0
            or not $config->{welcome_msg} )
        {
            my ( $power, $ban ) = $sql{lookup_user}->fetchrow_array;
            $sql{lookup_user}->finish;
            unless ($ban) {
                $irc_conn->mode( $config->{irc_chan}, "+v", $nick );
                $nicks{$nick} = "+" unless $nicks{$nick};
            }
        }
        else {
            $sql{add_user}->execute( time + $config->{welcome_time},
                $nick, $event->userhost, 0, "v" );
            if ( not $next_unban
                or time + $config->{welcome_time} < $next_unban )
            {
                $next_unban = time + $config->{welcome_time};
            }
            $irc_conn->privmsg( $nick, $config->{welcome_msg} );
        }
    }
    else {
        delete $nicks{$nick};
        $action = "left";
    }
    logmsg "$nick has $action the channel";
    &update_nick_re;
}

sub irc_on_names {
    my ( $self, $event ) = @_;
    my ( $nick, $mynick ) = ( $event->nick, $self->nick );
    my ($names) = ( $event->args )[3];

    print "Event: $_[1]->{type}\n";
    print DEBUG_FH Dumper [ @_[ 1 .. $#_ ] ] if DEBUG;

    %nicks_tmp =
      ( %nicks_tmp, map { s/^(\W)//; ( $_ => $1 ? $1 : 1 ) } split ' ',
        $names );
    logmsg "Got more names - current total: ", scalar keys %nicks_tmp;
}

sub irc_on_endnames {
    my ( $self, $event ) = @_;

    print "Event: $_[1]->{type}\n";
    print DEBUG_FH Dumper [ @_[ 1 .. $#_ ] ] if DEBUG;

    if ( keys %nicks_tmp ) {
        %nicks     = (%nicks_tmp);
        %nicks_tmp = ();
        &update_nick_re;

        # look up everyone without a voice, see if they should be +v'ed
        foreach my $nick ( keys %nicks ) {
            next if $nicks{$nick} ne '1' or $nick eq $config->{irc_nick};
            push @lookup_queue, $nick;
        }
    }

    logmsg "Names done - in channel: ", join ", ",
      map { "$_($nicks{$_})" } sort keys %nicks;
}

# we asked the userhost of a nick - this means we want to know if they should
# be +v'ed.
sub irc_on_userhost {
    my ( $self, $event ) = @_;
    my @users = split ' ', ( $event->args )[1];

    $last_public = time;
    logmsg "userhost reply for: ", join ", ", @users;

    foreach my $user (@users) {
        my ( $nick, $mask ) = split /=\+/, $user;
        logmsg "looking up $nick for possible +v";

        $sql{lookup_user}->execute($mask);
        my ( $timeout, $banned_until ) = $sql{lookup_user}->fetchrow_array;
        $sql{lookup_user}->finish;

        next if $banned_until and $banned_until > time;
        $self->mode( $config->{irc_chan}, "+v", $nick );
        $nicks{$nick} = "+" unless $nicks{$nick};
        logmsg "restoring ${nick}'s +v";
    }
}

sub irc_on_topic {
    my ( $self, $event ) = @_;

    $topic = ( $event->args )[2];
    logmsg "Topic updated to '$topic'";
}

sub irc_on_mode {
    my ( $self, $event ) = @_;

    $last_public = time;
    logmsg "Mode from", $event->nick, ":", $event->args;

    return if $event->nick eq $config->{irc_nick};

    my ( $mode, @nicks ) = ( $event->args );
    while ( ( $event->nick eq 'ChanServ' or 
            ( $nicks{ $event->nick } and $nicks{ $event->nick } =~ /[@&~]/ ) )
        and $mode =~ s/([-+])([hoqa])/$1/
        and my $nick = shift @nicks )
    {
        if ( $1 eq '+' ) {
            if ( exists $rev_op_table{$2} ) {
                logmsg "Marking $nick as an op ($2 - $rev_op_table{$2})";
                $nicks{$nick} = $rev_op_table{$2};
            }
            else {
                logmsg "Marking $nick as an op ($2 - unknown ~)";
                $nicks{$nick} = "~";
            }
        }
        else {
            logmsg "Unmarking $nick as an op ($2 - $rev_op_table{$2})";
            $nicks{$nick} = "+";
        }
    }
}

sub dump_event {
    logmsg "Event: $_[1]->{type} from ", $_[1]->nick, " (",
      join( ", ", $_[1]->args ), ")\n";
    print DEBUG_FH Dumper [ @_[ 1 .. $#_ ] ] if DEBUG;
}