XPBot -- check your XP on IRC

[LTjake]

Category:

PerlMonks Related Scripts

Description:

Now, I know that jcwren has an excellent bot that does this and much more. After making this reply, i decided to mess with Net::IRC. Why not make a quick XP checker? So, here is the result of my few hours of messing around. It's fun for about 5 minutes, then it starts to be annnoying. :)

You can kick it, but it will just rejoin - unless you use the trigger text. Of course, someone can just invite it back. So, if need be, just ban it. :)

It accepts the command "get_xp username" (leaving out the username will use your nick instead) via the channel and /msg.

#!c:\perl\bin\perl.exe

use Net::IRC;
use LWP;
use HTTP::Request::Common;
use XML::Simple;
use strict;

# CONFIG
my $server   = 'irc.slashnet.org';
my $port     = 6667;
my $nick     = 'XPBot';
my @channels = ('#perlmonks');
my $trigger  = 'ditty mao!';
# ------

my $irc = new Net::IRC;
my $conn = $irc->newconn(
    Nick    => $nick,
    Server  => $server,
    Port    => $port,
    Ircname => 'Perlmonks.org XP Bot'
);

$conn->add_handler('376'   , \&on_connect);
$conn->add_handler('public', \&on_message);
$conn->add_handler('kick'  , \&on_kick);
$conn->add_handler('invite', \&on_invite);
$conn->add_handler('msg'   , \&on_message);
$conn->add_handler('433'   , \&on_nick_taken);

$irc->start;

sub on_connect {
    my $self = shift;
    foreach my $chan (@channels) {
        $self->join($chan);
    }
}

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

    if ($arg =~ /^get_xp (.+)$/ || $arg =~ /^get_xp$/) {
        my $target = $event->format eq 'msg' ? $event->nick : $event->
+to;
        my $nick = $1 || $event->nick;
        my $xml = get_node_xml(
            node_id  => 16046,
            for_user => $nick
        );
        if (uc($nick) eq uc($xml->{INFO}->{foruser})) {
            $self->privmsg($target, "$nick currently has " . $xml->{XP
+}->{xp} . " XP.");
        }
        else {
            $self->privmsg($target, "$nick does not exist.");
        }
    }
}

sub on_kick {
    my ($self, $event) = @_;
    my (@args) = ($event->args);
    $self->join($args[0]) unless ($args[1] =~ /^$trigger$/i);
}

sub on_invite {
    my ($self, $event) = @_;
    my ($arg) = ($event->args);
    $self->join($arg) if grep{$_ eq $arg} @channels;
}

sub on_nick_taken {
    my ($self) = shift;
    $self->nick($nick.int(rand(999)));
}

sub on_disconnect {
    my $self = shift;
    $self->connect();
}

sub get_node_xml {
    my $ua = LWP::UserAgent->new;
    $ua->agent('node_xml_grabber/1.0 (' . $ua->agent .')');
    my $request  = POST('http://www.perlmonks.org/index.pl', Content =
+> [@_]) or die "http request error!";
    my $response = $ua->request($request);
    my $content  = $response->content();
    my $xml      = XMLin($content) or die "xml error!";
    return $xml;
}