root/veekun/trunk/script/perlbui.pl

use strict;
use warnings;

# this should not be this hard!
use File::Basename;
use File::Spec;
use Cwd qw/abs_path/;

# change directories to the root so we can find veekun files
BEGIN {
    my (undef, $path) = fileparse( File::Spec->rel2abs($0) );
    chdir $path;
    chdir '..';  # we run from script/
}
use lib abs_path('lib');

use Net::IRC;
use Net::Jabber;

use Vee::Bot;

# BEGIN SETUP

# need to find other veekun files..

# XXX: only one supported at a time right now
my %Connections = (
    'irc.veekun.com' => {
        '#veekun' => {},
        '#tcod'   => {},
    },
#    'irc.pocketmonsters.net' => [ '#bulbagarden' ],
);

REPLACEME('Setup done');

# END SETUP
################################################################################
# real code down here!

# TODO: pull these options from somewhere
# TODO: Log::Log4perl?

# initialize IRC stuff
my $irc      = new Net::IRC;
my $server   = (keys %Connections)[0];
my $irc_conn = $irc->newconn(
    Nick     => 'Perlbui',
    Server   => $server,
    Port     => 6667,
    Username => 'perlbui@veekun.com',
);

$irc_conn->add_handler(376,      \&irc_connect);  # end of MOTD
$irc_conn->add_handler(422,      \&irc_connect);  # no MOTD
$irc_conn->add_handler('public', \&irc_public);

# ------------------------------------------------------------------------------

# initialize Jabber stuff
my $jabber_conn = new Net::Jabber::Client;
# XXX: look into presence!  cool.  also what is IQ?
$jabber_conn->SetCallBacks( message => \&jabber_message );

$jabber_conn->Connect( hostname => 'jabber.org' ) or die "Can't connect to Jabber server: $!";

my @result = $jabber_conn->AuthSend( username => 'perlbui', password => 'pretzel', resource => 'Perlbui 0.1' );

if ($result[0] ne "ok") {
    die "Jabber auth failed: $result[0] - $result[1]";
}

REPLACEME("Connected to Jabber");

$jabber_conn->RosterGet;
$jabber_conn->PresenceSend;

# ------------------------------------------------------------------------------

# for cleanliness!
$SIG{TERM} = \&abort;

# enter event loop
while (1) {
    $irc->do_one_loop;
    my $jabber_status = $jabber_conn->Process(0);
    die if not defined $jabber_status;
}

# END CODE THAT WILL ACTUALLY BE RUN
################################################################################
# HANDLERS

sub abort {
    $jabber_conn->Disconnect;
    undef $irc;
    exit 0;
}

# ------------------------------------------------------------------------------

sub irc_connect {
    my ($self) = @_;

    REPLACEME("Successfully connected to " . $self->server);

    for my $channel (keys %{$Connections{ $self->server }}) {
        REPLACEME("Joining $channel");
        $self->join($channel);
    }
}

# ------------------------------------------------------------------------------

sub irc_public {
    my ($self, $event) = @_;
    my ($line) = $event->args;

    my $nick = $self->nick;
    my ($to_me) = ($line =~ /^ $nick[:,] \s+ (.+?) [?!.]? $/ix);
    return if not defined $to_me;

    my $response = Vee::Bot::dispatcher($to_me);

    # undef means dispatcher found nothing
    $response ||= 'What?';

    $self->privmsg($event->to, $event->nick . ': ' . $response);
}

# ------------------------------------------------------------------------------

sub jabber_message {
    my ($sid, $message) = @_;
    
    my $type = $message->GetType;
    my $from = $message->GetFrom("jid")->GetUserID;
    
#    my $resource = $fromJID->GetResource();
#    my $subject = $message->GetSubject();
    my $body = $message->GetBody;
    return if not $body;
    
    my $response = Vee::Bot::dispatcher($body);
    $response ||= 'What?';

    my $reply = $message->Reply;
    $reply->SetMessage( body => $response );
    $jabber_conn->Send($reply);
}

################################################################################
# ETC

# this needs to be a real logger or something
sub REPLACEME {
    warn shift;
}