sourcecode
LTjake
<code>
#!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;
}
</code>
Now, I know that [jcwren] has an [id://132484|excellent bot] that does this and much more. After making [id://190092|this reply], i decided to mess with [cpan://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. :)<br><br>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. :)<br><br>It accepts the command "get_xp username" (leaving out the username will use your nick instead) via the channel and /msg.
PerlMonks Related Scripts
/msg LTjake