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

  # Build an Eliza chatbot directly on the server
  use strict;
  use warnings;

  package MyBotNet::Bot::ElizaOnServer;

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

  on _start => run {
      # Make it easy for other sessions to talk to us
      get(KERNEL)->alias_set('eliza');
  };

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

  on bot message_to_me => run {
      my $event = getARG0;

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

  on bot quit => run {
      # Clear the session alias for clean shutdown
      get(KERNEL)->alias_remove('eliza');
  };

  1;

  use strict;
  use warnings;

  package MyBotNet::Server::Main;

  use Bot::Net::Server;
  use Bot::Net::Mixin::Server::IRC;

  use MyBotNet::Bot::ElizaOnServer;

  on _start => run {
      remember eliza => MyBotNet::Bot::ElizaOnServer->setup;
  };

  on server quit => run {

      # Clean up for clean shutdown
      forget 'eliza';
  };

  1;

use strict;
use warnings;

package Bot::Net::Mixin::Bot::IRCD;

use Bot::Net::Mixin;

use Scalar::Util qw/ reftype /;

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 {
        alias        => $name,

        spoofing     => {
            nick    => $name,
            ircname => $name,
        },

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

on _start => run {
    my $alias    = recall [ config => 'alias' ];
    my $spoofed  = recall [ config => 'spoofing' ];
    my $channels = recall [ config => 'channels' ];

    get(KERNEL)->alias_set($alias) if $alias;

    recall('log')->info('Setting up nick spoofing as '
        .$spoofed->{nick});
    post ircd => register => 'all'; # TODO limit this to a subset

    # Make sure we are, in fact, ready when we report
    call ircd => add_spoofed_nick => $spoofed;
    recall('log')->info("BOT READY : nick $spoofed->{nick}");

    for my $channel (@{ $channels || [] }) {
        recall('log')->info('Joining '.$channel);
        post ircd => daemon_cmd_join => $spoofed->{nick}, $channel;
    }

    yield 'bot_connected';
};

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

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

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

    # Only respond to messages directly to me
    if ($me eq $my_nick) {
        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 ircd_daemon_public => run {
    my $userhost = get ARG0;
    my $channel  = get ARG1;
    my $message  = get ARG2;

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

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

    # FIXME This isn't a very good mechanism for determining if this spoofed
    # nick is in the channel since it could have changed.

    # Am I in this channel?
    if (grep { $_ eq $channel } @{ $channels || [] }) {
        my $state;
        if ($message =~ s/^\Q$my_nick\E:\s*//) {
            $state = 'message_to_me';
        }

        else {
            $state = 'message_to_group';
        }

        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';
    my $my_nick = recall [ config => spoofing => 'nick' ];

    # 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 ircd => daemon_cmd_privmsg => $my_nick => $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 ircd => daemon_cmd_privmsg => $my_nick => $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 {
    recall('log')->warn("Stopping spoofed server-side IRC bot.");

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

    post ircd => del_spoofed_nick => $my_nick => 'Quitting.';
    post ircd => unregister => 'all';

    get(KERNEL)->alias_remove($alias) if $alias;
};

1;