Bot::Net::Mixin::Bot::IRC - mixin class for building IRC bots

  # Build an Eliza chatbot for IRC
  use strict;
  use warnings;
  package MyBotNet::Bot::Eliza;

  use Bot::Net::Bot;
  use Bot::Net::Mixin::Bot::IRC;
  use Chatbot::Eliza; # available separately on CPAN

  on bot startup => run {
      remember eliza => Chatbot::Eliza->new;
  };

  on bot message_to_me => run {
      my $event = get ARG0;

      my $reply = recall('eliza')->transform( $event->message );
      yield reply_to_sender => $message, $reply;
  };

  1;

  use Bot::Net::Bot;             # define a Bot::Net bot
  use Bot::Net::Mixin::Bot::IRC; # become an IRC bot

use strict;
use warnings;

package Bot::Net::Mixin::Bot::IRC;

use Bot::Net::Mixin;

use POE qw/ Component::IRC::State /;
use Scalar::Util qw/ reftype /;

sub setup {
    my $self  = shift;
    my $brain = shift;

    $brain->remember(
        [ 'irc' ] => POE::Component::IRC::State->spawn( alias => 'irc' )
    );
}

sub default_configuration {
    my $class   = shift;
    my $package = shift;

    my $name = Bot::Net->short_name_for_bot($package);
    $name =~ s/\W+/_/g;

    my $default_channel = Bot::Net->config->net('ApplicationName');
    $default_channel =~ s/\W+/_/g;

    return {
        auto_connect => 1,

        irc_connect => {
            nick     => $name,
            username => lc $name,
            ircname  => Bot::Net->short_name_for_bot($package),

            server   => 'localhost',
            port     => 6667,

            flood    => 1,
        },
        
        channels => [ '#'.$default_channel ],
    };
}

on _start => run {
    post irc => register => 'all';

    my $auto_connect = recall [ config => 'auto_connect' ];
    if (not defined $auto_connect or $auto_connect) {
        yield 'bot_connect';
    }
};

on bot_connect => run {
    my $config = recall [ config => 'irc_connect' ] ;
    call irc => connect  => $config;
};

on irc_001 => run {
    my $self = get OBJECT;
    my $log  = recall 'log';

    my $channels = recall [ config => 'channels' ];
    for my $channel (@$channels) {
        $log->info("Joining $channel...");
        post irc => join => $channel;
    }

    yield 'bot_connected';

    # Report readiness (helpful for testing)
    my $config = recall [ config => 'irc_connect' ] ;
    recall('log')->info(
        "BOT READY : nick $config->{nick} server $config->{server} "
       ."port $config->{port}");
};

on [ qw( irc_disconnected irc_error irc_socketerr ) ] => run {
    # TODO XXX FIXME Add support for notifying the bot that the connection has
    # been lost and then notifying the bot again when the connection is
    # re-established.

    delay attempt_reconnect => 60;
};

on attempt_reconnect => run {
    post irc => 'connect';
};

on irc_msg => run {
    my $userhost = get ARG0;
    my $me       = get ARG1;
    my $message  = get ARG2;

    my ($nick, $host) = split /!/, $userhost;

    my $event = Bot::Net::Message->new({
        sender_nick     => $nick,
        sender_host     => $host,
        recipient_nicks => $me,
        message         => $message,
        private         => 1,
    });

    yield bot_message_to_me => $event;
};

on irc_public => run {
    my $userhost = get ARG0;
    my $channel  = get ARG1;
    my $message  = get ARG2;

    my $my_nick = recall [ config => irc_connect => 'nick' ];

    my $state;
    if ($message =~ s/^\Q$my_nick\E:\s*//) {
        $state = 'message_to_me';
    }

    else {
        $state = 'message_to_group';
    }

    my ($nick, $host) = split /!/, $userhost;

    my $event = Bot::Net::Message->new({
        sender_nick      => $nick,
        sender_host      => $host,
        recipient_groups => $channel,
        message          => $message,
        public           => 1,
    });

    yield 'bot_' . $state => $event;
};

on send_to => run {
    my $to           = get ARG0;
    my $full_message = get ARG1;

    my $log     = recall 'log';

    # Split the message up by newlines
    my @messages = split /\n/, $full_message;

    # Normalize the destination by channels and nicks
    my (%group_destinations, %private_destinations);

    # Given a single channel or nick
    if (!defined reftype $to) {

        # Given a single channel
        if ($to =~ /\#/) {
            $group_destinations{$to} = [ ];
        }

        # Given a single nick
        else {
            $private_destinations{$to}++;
        }
    }

    # Given an array of channels and/or nicks
    elsif (reftype($to) eq 'ARRAY') {

        # For each channel/nick in the array...
        for my $thing (@$to) {

            # Add channels to the group list
            if ($thing =~ /\#/) {
                $group_destinations{$thing} = [ ];
            }

            # Add nicks to the private list
            else {
                $private_destinations{$thing}++;
            }
        }
    }

    # Given a hash of channels => nicks
    elsif (reftype($to) eq 'HASH') {

        # For each channel in the hash...
        for my $channel (keys %$to) {
            my $nicks = $to->{$channel};

            # If a single nick, wrap it in an array
            if (!defined reftype($nicks)) {
                $group_destinations{$channel} = [ $nicks ];
            }

            # If an array, assume an array of nicks
            elsif (reftype($nicks) eq 'ARRAY') {
                $group_destinations{$channel} = $nicks;
            }
            
            # Wha?
            else {
                $log->error("send_to: Don't know what to do with $channel => $nicks, ignoring.");
            }

        }
    }

    # Wha?
    else {
        $log->error("send_to: Don't know what to do with $to, ignore.");
        return;
    }

    # Internal function for chunking the message
    my $message_chunks = sub {
        my $message = shift;
        my @chunks;
        while (length $message > 400) {
            my $chunk = substr $message, 0, 400;
            $message  = substr $message, 400;
            push @chunks, $chunk.'\\';
        }
        push @chunks, $message;
        return @chunks;
    };

    # Handle group messages
    for my $channel (keys %group_destinations) {
        my $nicks = $group_destinations{$channel};

        # For each message line
        for my $message (@messages) {

            # Prepend any nicks we have
            if (@$nicks) {
                $message = join(',', @$nicks).': '.$message;
            }

            # Post the message by chunks
            post irc => privmsg => $channel => $_ 
                for $message_chunks->($message);
        }
    }

    # Send out the private messages
    for my $nick (keys %private_destinations) {

        # For each message line, post it to the nick in chunks
        for my $message (@messages) {
            post irc => privmsg => $nick => $_
                for $message_chunks->($message);
        }
    }

};

on reply_to_sender => run {
    my $event   = get ARG0;
    my $message = get ARG1;

    if ($event->public) {
        my %send_to = map { $_ => $event->sender_nick } 
                         @{ $event->recipient_groups };
        yield send_to => \%send_to => $message;
    }

    else {
        yield send_to => $event->sender_nick => $message;
    }
};

on reply_to_sender_privately => run {
    my $event   = get ARG0;
    my $message = get ARG1;

    yield send_to => $event->sender_nick => $message;
};

on reply_to_sender_group => run {
    my $event   = get ARG0;
    my $channel = get ARG1;
    my $message = get ARG2;

    yield send_to => { $channel => $event->sender_nick } => $message;
};

on reply_to_general => run {
    my $event   = get ARG0;
    my $message = get ARG1;

    if ($event->public) {
        yield send_to => $event->recipient_groups => $message;
    }

    else {
        yield send_to => $event->sender_nick => $message;
    }
};

on bot_quit => run {
    my $message = get ARG0;

    recall('log')->warn("Quitting the IRC connection.");
    post irc => quit => ($message || 'Quitting.');

    post irc => unregister => 'all';
    forget 'irc';
};

1;