[JDEV] Anyone bored?

[Thomas D. Charron]

  Anyone bored?  ;-P  This little diddy will be checked in soon, but it's just a VERY simplistic example of building an IRC <=> Jabber bridge in perl.  All THIS really does is connect to an IRC server, the local Jabber server, and say on #JabTest what is 'say'ed to them via Jabber..

  Lemme alone, I was bored and reading up on the Net::IRC module..  ;-P


---
Thomas Charron


--== Sent via Deja.com http://www.deja.com/ ==--
Share what you know. Learn what you don't.
-------------- next part --------------
#!/usr/local/bin/perl

@INC = (`pwd`, at INC);

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

my $irc = new Net::IRC;

print "Creating connection to IRC server...\n";

my $conn = $irc->newconn(Server   => ($ARGV[0]  ||  'irc-w.primenet.com'),
                         Port     => 6667,
                         Nick     => 'Boolahman',
                         Ircname  => 'This bot brought to you by Net::IRC.',
                         Username => 'quetzal')
or die "irctest: Can't connect to IRC server.\n";


print "Installing handler routines for IRC...\n";

$conn->add_global_handler([ 251,252,253,254,302,255 ], \&on_init);
$conn->add_global_handler('disconnect', \&on_disconnect);
$conn->add_global_handler(376, \&on_connect);                     

print "Installing Handler routines for Jabber...\n";

SetCallbacks("message" => \&JabberMessage);

print "Creating connection to Jabber server...\n";

Connect("localhost") || die("Connecting Jabber: $!");

SendSimple qw(login user u pass p nick Test'User);

while(1)
{
     Process(1) || die("Processing: $!");
     $irc->do_one_loop(); 
}

sub JabberMessage {
	my %Message = Simplify(@_);
	irc->privmsg("#JabTest", $Message{"say"});
}

sub on_connect {
        my $self = shift;

        print "Joining #JabTest...\n";
        $self->join("#JabTest");
        $self->topic("#JabTest");
}

# Handles some messages you get when you connect
sub on_init {
    my ($self, $event) = @_;
    my (@args) = ($event->args);
    shift (@args);

    print "*** @args\n";
}                 

# Reconnect to the server when we die.
sub on_disconnect {
        my ($self, $event) = @_;

        print "Disconnected from ", $event->from(), " (",
              ($event->args())[0], "). Attempting to reconnect...\n";
        $self->connect();
}