#!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;
}
-
Are you posting in the right place? Check out Where do I post X? to know for sure.
-
Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
<code> <a> <b> <big>
<blockquote> <br /> <dd>
<dl> <dt> <em> <font>
<h1> <h2> <h3> <h4>
<h5> <h6> <hr /> <i>
<li> <nbsp> <ol> <p>
<small> <strike> <strong>
<sub> <sup> <table>
<td> <th> <tr> <tt>
<u> <ul>
-
Snippets of code should be wrapped in
<code> tags not
<pre> tags. In fact, <pre>
tags should generally be avoided. If they must
be used, extreme care should be
taken to ensure that their contents do not
have long lines (<70 chars), in order to prevent
horizontal scrolling (and possible janitor
intervention).
-
Want more info? How to link
or How to display code and escape characters
are good places to start.
|