#!/usr/bin/perl -w
#
# irctest
# Sample Net::IRC script that starts a vapid little annoybot.
# Please don't test your bots in #perl... we are easily annoyed.
#
use strict;
use Net::IRC;
#
# Create the IRC and Connection objects
#
#color code
my $color = "\x03";
my $bold = "\x02";
my $underline = "\x1F";
my $reverse = "\x16";
my $tojoin = "#word";
my $playing = 0;
my $round = 0;
my $irc = new Net::IRC;
print "Creating connection to IRC server...\n";
my $conn = $irc->newconn(Server => ($ARGV[0] || 'irc.waypasteleven.com'),
Port => 6667,
Nick => 'Acrophobiabot',
Ircname => 'Join #word foran exciting game of Acrophobia!',
Username => 'acrophobiabot')
or die "irctest: Can't connect to IRC server.\n";
my @acros = ();
my @nicks = ();
my @votes = ();
my @voted = ();
my $bonus = "";
my @users = ();
# What to do when we receive channel text.
sub doround {
$playing = 1;
@acros = ();
@nicks = ();
@votes = ();
@voted = ();
my ($self) = @_;
my $acro = "";
my $length = (int rand 3) + 4;
my @letters = ('A'..'Z');
foreach (1..$length) {
srand;
my $rand = int(rand scalar(@letters));
$acro .= $letters[$rand];
splice(@letters, $rand, 1);
}
if ($bonus eq "") {
$round++;
$self->privmsg($tojoin, $bold . "Round $round! Acronym: $acro" . $bold);
} else {
$self->privmsg($tojoin, $bold . $color . "4Bonus round!" . $color . " Acronym: $acro. Topic: $bonus" . $bold);
$bonus = "";
}
$self->privmsg($tojoin, $bold . "PM me " . $underline . "!acro" . $underline . " followed by your acronym." . $bold);
$self->privmsg($tojoin, $bold . "Type " . $underline . "!vote" . $underline . " when everyone has given me an acronym." . $bold);
}
sub on_public {
my ($self, $event) = @_;
my @to = $event->to;
my ($nick, $mynick) = ($event->nick, $self->nick);
my ($arg) = ($event->args);
# Note that $event->to() returns a list (or arrayref, in scalar
# context) of the message's recipients, since there can easily be
# more than one.
print "<$nick> $arg\n";
# Cut off whitespace
$arg =~ s/^\s+//;
$arg =~ s/\s+$//;
if ($arg =~ /^\!(start|acro|acrophobia)$/i) {
if ($playing == 0) {
$self->privmsg($tojoin, $bold . "Starting Acrophobia." . $bold);
doround($self);
}
} elsif ($arg =~ /^\!round$/i) {
if ($playing == 2) {
doround($self);
}
} elsif ($arg =~ /^\!vote$/i) {
if ($playing == 1) {
for (my $i = 0; $i < scalar @acros; $i++) {
my $x = $i + 1;
$self->privmsg($tojoin, $bold . "Option $x: $acros[$i]" . $bold);
}
$self->privmsg($tojoin, $bold . "PM me " . $underline . "!vote" . $underline . " followed by the number of the acronym you like best." . $bold);
$self->privmsg($tojoin, $bold . "Type " . $underline . "!finish" . $underline . " when everyone has voted." . $bold);
}
} elsif ($arg =~ /^\!finish$/i) {
if ($playing == 1) {
for (my $i = 0; $i < scalar @votes; $i++) {
$self->privmsg("Ultima", "$nicks[$i]: $votes[$i] votes.");
}
$playing = 2;
}
} elsif ($arg =~ /^\!end$/i) {
if ($playing != 0) {
$playing = 0;
$self->privmsg($tojoin, $bold . "Acrophobia game ended." . $bold);
}
}
}
# What to do when we receive a private PRIVMSG.
sub on_msg {
my ($self, $event) = @_;
my ($nick) = $event->nick;
my ($arg) = ($event->args);
print "*$nick* ", ($event->args), "\n";
if ($playing == 1) {
if ($arg =~ /^\!acro (.+)/i) {
my $i = 0;
foreach my $user (@nicks) {
if ($user eq $nick) {
$i++;
}
}
if ($i == 0) {
push(@acros, $1);
push(@nicks, $nick);
push(@votes, 0);
$self->privmsg($nick, "Your acronym has been added.");
#if (scalar keys %acros == scalar @players) {
# foreach my $key (keys %acros) {
# my $value = $acros{$key};
# $self->privmsg($tojoin, $bold . "$key: $value" . $bold);
# }
#}
}
} elsif ($arg =~ /^\!vote ([0-9]+)/i) {
my $i = 0;
foreach my $user (@voted) {
if ($user eq $nick) {
$i++;
}
}
if ($i == 0) {
if ($1 <= scalar @acros && $1 > 0) {
$votes[$1 - 1]++;
$self->privmsg($nick, "Vote counted.");
push(@voted, $nick);
} else {
$self->privmsg($nick, "Vote not counted: there is no acronym #$1. Please pick a different number.");
}
} else {
$self->privmsg($nick, "You have already voted.");
}
}
}
if ($playing != 0) {
if ($arg =~ /^\!bonus (.+)/i) {
my $topic = $1;
if ($nick =~ /^(Ultima|UMTIMA)$/i) {
$bonus = $topic;
}
}
}
}
# What to do when someone joins a channel the bot is on.
sub on_join {
my ($self, $event) = @_;
my ($channel) = ($event->to)[0];
if ($event->nick eq 'rulebot') {
printf "*** Now talking on %s\n", $channel;
} else {
printf "*** %s (%s) has joined %s\n",
$event->nick, $event->userhost, $channel;
}
}
# Display formatted CTCP ACTIONs.
sub on_action {
my ($self, $event) = @_;
my @to = $event->to;
my $mynick = $self->nick;
# my ($arg) = ($event->args);
# my ($self, $event) = @_;
my ($nick, @args) = ($event->nick, $event->args);
print "* $nick @args\n";
}
#
# Here are the handler subroutines. Fascinating, huh?
#
# What to do when the bot successfully connects.
sub on_connect {
my $self = shift;
print "Joining $tojoin...\n";
$self->join("$tojoin");
$self->topic("$tojoin");
$self->join("#bots");
$self->topic("#bots");
$self->mode($self->nick, "+B");
$self->privmsg("nickserv", "identify XXXXXXXX");
}
# Handles some messages you get when you connect
sub on_init {
my ($self, $event) = @_;
my (@args) = ($event->args);
shift (@args);
print "*** @args\n";
}
# What to do when someone leaves a channel the bot is on.
sub on_part {
my ($self, $event) = @_;
my ($channel) = ($event->to)[0];
printf "*** %s (%s) has left %s\n", $event->nick, $event->userhost, $channel;
}
sub on_umode {
my ($self, $event) = @_;
my @to = $event->to;
my ($nick, $mynick) = ($event->nick, $self->nick);
my ($arg) = ($event->args);
# Note that $event->to() returns a list (or arrayref, in scalar
# context) of the message's recipients, since there can easily be
# more than one.
print "<$nick> $arg\n";
if ($arg =~ /^(\s*?)\!quote\b/i) { # Say a Zippy quote if our nick
$self->privmsg([ @to ], &pickrandom()); # appears in the message.
}
#if ($arg =~ /Go away/i) { # Tell him to leave, and he does.
#$self->quit("Yow!!");
#exit 0;
#}
if ($arg =~ /^chat/i) { # Request a DCC Chat initiation
$self->new_chat(1, $event->nick, $event->host);
}
# You can invoke this next part with "Send me Filename" or
# "Send Filename to me". It doesn't much like ending punctuation, though.
$arg =~ s/[^"'\w]*?\b(to|me)\b[^'"\w]*?//g;
if ($arg =~ /^send\s+(\S+)\s*/i) {
if (-e $1) {
$self->privmsg($nick, "Sending $1 in 10 seconds...");
$self->schedule(10, \&Net::IRC::Connection::new_send, $nick, $1);
} else {
$self->privmsg($nick, "No such file as $1, sorry.");
}
}
}
# What to do when we receive a message via DCC CHAT.
sub on_chat {
my ($self, $event) = @_;
my ($sock) = ($event->to)[0];
print '*' . $event->nick . '* ' . join(' ', $event->args), "\n";
$self->privmsg($sock, &pickrandom()); # Say a Zippy quote.
}
# Prints the names of people in a channel when we enter.
sub on_names {
my ($self, $event) = @_;
my (@list, $channel) = ($event->args); # eat yer heart out, mjd!
# splice() only works on real arrays. Sigh.
($channel, @list) = splice @list, 2;
@users = @list;
print "Users on $channel: @list\n";
}
# What to do when we receive a DCC SEND or CHAT request.
sub on_dcc {
my ($self, $event) = @_;
my $type = ($event->args)[1];
if (uc($type) eq 'SEND') {
open TEST, ">/tmp/net-irc.dcctest"
or do { warn "Can't open test file: $!"; return; };
$self->new_get($event, \*TEST);
print "Saving incoming DCC SEND to /tmp/net-irc.dcctest\n";
} elsif(uc($type) eq 'CHAT') {
$self->new_chat($event);
} else {
print STDERR ("Unknown DCC type: " . $type);
}
}
# Yells about incoming CTCP PINGs.
sub on_ping {
my ($self, $event) = @_;
my $nick = $event->nick;
$self->ctcp_reply($nick, join (' ', ($event->args)));
print "*** CTCP PING request from $nick received\n";
}
# Gives lag results for outgoing PINGs.
sub on_ping_reply {
my ($self, $event) = @_;
my ($args) = ($event->args)[1];
my ($nick) = $event->nick;
$args = time - $args;
print "*** CTCP PING reply from $nick: $args sec.\n";
}
# Change our nick if someone stole it.
sub on_nick_taken {
my ($self) = shift;
$self->nick($self->nick . "_");
}
# 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();
}
# Look at the topic for a channel you join.
sub on_topic {
my ($self, $event) = @_;
my @args = $event->args();
# Note the use of the same handler sub for different events.
if ($event->type() eq 'notopic') {
print "No topic set for $args[1].\n";
# If it's being done _to_ the channel, it's a topic change.
} elsif ($event->type() eq 'topic' and $event->to() and $event->nick ne $conn->server) {
print "*** ", $event->nick, " has changed the topic to: $args[0]\n";
} else {
if ($event->nick ne $conn->server) {
print "Topic for $args[1] is: $args[2]\n";
}
}
}
sub on_kick {
my ($self, $event) = @_;
my @args = $event->args();
my @to = $event->to;
if ($to[0] eq $self->nick) {
print "*** You have been kicked from $args[0] by ", $event->nick, " ($args[1])\n";
$self->join($tojoin);
} else {
print "*** ", $event->nick, " has kicked ", $event->to, " from $args[0] ($args[1])\n";
}
}
sub blah {
my ($self, $event) = @_;
print "Got event of type: " . $event->type . "\n";
}
print "Installing handler routines...";
#$conn->add_default_handler(\&blah);
$conn->add_handler('cping', \&on_ping);
$conn->add_handler('crping', \&on_ping_reply);
$conn->add_handler('msg', \&on_msg);
$conn->add_handler('chat', \&on_chat);
$conn->add_handler('public', \&on_public);
$conn->add_handler('caction', \&on_action);
$conn->add_handler('join', \&on_join);
$conn->add_handler('umode', \&on_umode);
$conn->add_handler('part', \&on_part);
$conn->add_handler('cdcc', \&on_dcc);
$conn->add_handler('topic', \&on_topic);
$conn->add_handler('notopic', \&on_topic);
$conn->add_handler('kick', \&on_kick);
$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);
$conn->add_global_handler(433, \&on_nick_taken);
$conn->add_global_handler(353, \&on_names);
print " ...done.\n";
print "Starting...\n";
$irc->start;