# You'd think this was the NetHirc::Handlers package, but you'd be wrong.
# We're just going to nominate our own special friend, and add things
# to their symbol table. It's kinda like squatting.
package NetHirc::Adventurer;
use strict;
use warnings;
use POSIX ();
use NetHirc;
use NetHirc::BigBrother;
use NetHirc::Util;
use constant DEFAULT_VERSION => "Return of the Son of NetHirc! version %s";
use constant DEFAULT_SOURCE => "Still under development, ask me privately";
my %srvmap;
sub reorient
{
my $server = shift;
my $current = $server->current_channel();
unless ($current)
{
nht('nochannels');
return;
}
if ($server->is_query($current))
{
nht('queryswitch', $current);
}
else
{
nht('chanswitch', $current);
}
}
sub nuhsplit
{
my $nuh = shift;
my ($nick, $user, $host) = ($nuh =~ /([^!]+)!([^@]+)@(.*)/);
return ($nick, $user, $host);
}
# Stolen from Net::IRC and adapted. Use on numeric events only!
sub ircsplit
{
my $stuff = shift;
my ($blip, $space, $other, @stuff);
while ($stuff)
{
($blip, $space, $other) = split(/(\s+)/, $stuff, 2);
$space = "" unless $space;
$other = "" unless $other; # Thanks to jack velte...
if (substr($blip, 0, 1) eq ':')
{
push @stuff, substr($blip, 1) . $space . $other;
last;
}
else
{
push @stuff, $blip;
$stuff = $other;
}
}
return @stuff;
}
sub irc_connected
{
debug('i', "connected");
my ($kernel, $sender, $heap, $server) = @_[KERNEL, SENDER, HEAP, ARG0];
$srvmap{$sender->ID()} = $server;
my $inv = $heap->{'rc'};
$inv->set_server($server);
my ($srv) = $inv->has_server($server);
$srv->connected(1);
}
# The server name we get back here is always the one we used to connect,
# not the one that may have been given to us via round-robin DNS.
sub irc_disconnected
{
debug('i', "disconnect");
my ($kernel, $heap, $session, $sender) = @_[KERNEL, HEAP, SESSION, SENDER];
my $server = $_[ARG0];
my $inv = $heap->{'rc'};
my ($srv) = $inv->has_server($server);
$srv->disconnect();
if ($heap->{'quitting'})
{
$kernel->post($session, 'shutdown');
return;
}
my $next = $inv->reorient();
if ($next)
{
nht('serverswitch', $next->name());
}
else
{
nht('noservers');
}
update_statusline();
}
## The server name we get back here could be different than the one we used.
## That's round-robin DNS for you...so we use %srvmap which gets populated
## by irc_connected.
sub irc_001
{
debug('i', "001 welcome");
my ($kernel, $heap, $session, $sender) = @_[KERNEL, HEAP, SESSION, SENDER];
my ($realserver, $message) = @_[ARG0, ARG1];
my $db = $heap->{'db'};
my $inv = $heap->{'rc'};
my $reqserver = $srvmap{$sender->ID()};
my ($srv) = $inv->has_server($reqserver);
my $reqnick = $srv->request_nick();
if ($reqnick and $message =~ /\b$reqnick\b/)
{
$srv->accept_nick();
}
$srv->aka($realserver);
my $nick = $srv->nick();
my $deity = pickrandom($heap->{'db'}->{'deities'});
my $class = pickrandom($heap->{'db'}->{'classes'});
nht('server', $message);
nht('connect0', $nick);
nht('connect1');
nht('connect2', $deity, $class);
update_statusline();
for my $ch ($srv->wanted_channels())
{
$kernel->post($sender, 'join', $ch);
nht('joining', $ch);
}
$kernel->post($session, 'next_connect');
my $commands = $heap->{'commands'};
if ($commands)
{
for my $cmd (@$commands)
{
$kernel->post('nethirc_terminal', 'spit', $cmd);
}
delete $heap->{'commands'};
}
}
sub irc_error
{
debug('i', "error");
my ($kernel, $heap, $sender) = @_[KERNEL, HEAP, SENDER];
my $error = $_[ARG0];
my $server = $srvmap{$sender->ID()};
nht('disconnected', $server, $error);
return if $heap->{'quitting'};
my $inv = $heap->{'rc'};
my ($srv) = $inv->has_server($server);
$srv->disconnect();
update_statusline();
}
sub irc_join
{
debug('i', "join");
my ($kernel, $heap, $sender) = @_[KERNEL, HEAP, SENDER];
my ($nuh, $channel) = @_[ARG0, ARG1];
my ($nick, $user, $host) = nuhsplit($nuh);
nht('join', $nick, $user, $host, $channel);
my $server = $srvmap{$sender->ID()};
my $inv = $heap->{'rc'};
my ($srv) = $inv->has_server($server);
my $srvname = $srv->name();
if ($srv->nick() eq $nick)
{
$srv->add_channel($channel);
update_statusline();
$kernel->post($srvname, 'mode', $channel); # Provoke information.
}
}
sub irc_invite
{
debug('i', "invite");
my ($kernel, $sender) = @_[KERNEL, SENDER];
my ($nuh, $channel) = @_[ARG0, ARG1];
my ($nick, $user, $host) = nuhsplit($nuh);
nht('invite', $nick, $channel);
}
sub irc_kick
{
debug('i', "kick");
my ($kernel, $heap, $sender) = @_[KERNEL, HEAP, SENDER];
my ($kicker, $channel, $victim, $reason) = @_[ARG0..ARG3];
my ($nick, $user, $host) = nuhsplit($kicker);
my $server = $srvmap{$sender->ID()};
my $inv = $heap->{'rc'};
my ($srv) = $inv->has_server($server);
my $mynick = $srv->nick();
if ($victim ne $mynick)
{
if ($nick eq $mynick)
{
nht('selfkick', "You", $reason, $victim, $channel);
}
else
{
nht('kick', $nick, $reason, $victim, $channel);
}
return;
}
# Now what if we're the victim?
if ($nick eq $mynick) # Ow, my foot!
{
nht('selfkick', "You", $reason, "yourself", $channel);
}
else
{
nht('kick', $nick, $reason, "you", $channel);
}
$srv->remove_channel($channel);
reorient($srv);
update_statusline();
}
sub irc_mode
{
debug('i', "mode");
my ($kernel, $heap, $sender) = @_[KERNEL, HEAP, SENDER];
my ($nuh, $object, $modestr, @modeargs) = @_[ARG0..$#_];
my $server = $srvmap{$sender->ID()};
my $inv = $heap->{'rc'};
my $db = $heap->{'db'};
my ($srv) = $inv->has_server($server);
my $nick = $srv->nick();
my @modes = modesplit(ircsplit($modestr), @modeargs);
# Personal modes don't have a full nuh, just a nick.
my $p;
if ($nuh eq $nick)
{
nht('selfmode', ircsplit($modestr));
foreach $p (@modes)
{
nht('plain', $db->{'self_mode_comments'}->{$p->[0]});
$srv->selfmode($p->[0]);
}
}
else
{
if ($nuh =~ /@/)
{
($nick) = nuhsplit($nuh);
}
else
{
$nick = $nuh;
}
nht('channelmode', $object, $nick, $modestr, join(' ', @modeargs));
foreach $p (@modes)
{
my $comment = $db->{'channel_mode_comments'}->{$p->[0]};
my $target = " " . $p->[1] if $p->[1]; # YAPPH.
my $message = sprintf($comment, $object, $target);
nht('plain', $message);
$srv->chanmode($object, @$p);
}
}
update_statusline();
}
sub modesplit
{
my $modestring = shift;
my @targets = @_;
my $parity;
my @results;
for my $c (split(//, $modestring))
{
if (($c eq '+') || ($c eq '-'))
{
$parity = $c;
}
else
{
if ($c =~ /[bov]/)
{
push(@results, [ $parity . $c, shift(@targets) ]);
}
elsif ($c =~ /[kl]/)
{
if ($parity eq '+')
{
push(@results, [ $parity . $c, shift(@targets) ]);
}
else
{
push(@results, [ $parity . $c ]);
}
}
else
{
push(@results, [ $parity . $c ]);
}
}
}
return @results;
}
sub irc_msg
{
debug('i', "msg");
my ($kernel, $heap, $sender) = @_[KERNEL, HEAP, SENDER];
my ($nuh, $recips, $message) = @_[ARG0..ARG2];
my ($origin) = nuhsplit($nuh);
my $server = $srvmap{$sender->ID()};
my $inv = $heap->{'rc'};
my ($srv) = $inv->has_server($server);
my $current = $inv->current_server();
if ($current eq $srv)
{
nht('priv_from', $origin, $message);
}
else
{
nht('opriv_from', $origin, $srv->name(), $message);
}
$kernel->post('nethirc_totalitarian', 'check', $message);
}
# PoCo::IRC 3.7 makes ARG2 a listref containing channels in common.
# If someone thinks of an actual use for this in the context of
# this silly client, please let me know.
sub irc_nick
{
debug('i', "nick");
my ($kernel, $heap, $sender) = @_[KERNEL, HEAP, SENDER];
my ($nuh, $newnick) = @_[ARG0, ARG1];
my ($oldnick) = nuhsplit($nuh);
my $server = $srvmap{$sender->ID()};
my $inv = $heap->{'rc'};
my $current = $inv->current_server();
my ($srv) = $inv->has_server($server);
my $mynick = $srv->nick();
if ($mynick eq $oldnick)
{
nht('mynick', $mynick, $newnick);
$srv->accept_nick();
update_statusline();
}
elsif ($current eq $srv)
{
nht('nick', $oldnick, $newnick);
}
else
{
nht('onick', $server, $oldnick, $newnick);
}
}
sub irc_notice
{
debug('i', "notice");
my ($kernel, $heap, $sender) = @_[KERNEL, HEAP, SENDER];
my ($nuh, $recips, $message) = @_[ARG0..ARG2];
my ($nick) = nuhsplit($nuh);
my $server = $srvmap{$sender->ID()};
my $inv = $heap->{'rc'};
my $current = $inv->current_server()->name();
if ($current ne $server)
{
nht('onotice', $nick, $server, $message);
}
else
{
nht('notice', $nick, $message);
}
$kernel->post('nethirc_counter', 'add', $server, $nick, $message);
$kernel->post('nethirc_totalitarian', 'check', $message);
}
sub irc_part
{
debug('i', "part");
my ($kernel, $heap, $sender) = @_[KERNEL, HEAP, SENDER];
my ($nuh, $channel) = @_[ARG0, ARG1];
my ($nick, $user, $host) = nuhsplit($nuh);
nht('part', $nick, $user, $host, $channel);
my $server = $srvmap{$sender->ID()};
my $inv = $heap->{'rc'};
my ($srv) = $inv->has_server($server);
if ($nick eq $srv->nick())
{
$srv->remove_channel($channel);
reorient($srv);
update_statusline();
}
}
sub irc_ping
{
debug('i', "ping");
}
sub irc_public
{
debug('i', "public");
my ($kernel, $session, $heap, $sender) = @_[KERNEL, SESSION, HEAP, SENDER];
my ($nuh, $channels, $message) = @_[ARG0..ARG2];
my ($nick) = nuhsplit($nuh);
my $target = $channels->[0];
my $server = $srvmap{$sender->ID()};
$kernel->post($session, 'display_public', $server, $target, $nick, $message);
$kernel->post('nethirc_counter', 'add', $server, $nick, $message);
$kernel->post('nethirc_totalitarian', 'check', $message);
}
# PoCo::IRC 3.7 makes ARG2 a listref containing channels in common.
# If someone thinks of an actual use for this in the context of
# this silly client, please let me know.
sub irc_quit
{
debug('i', "quit");
my ($kernel, $heap, $sender) = @_[KERNEL, HEAP, SENDER];
my ($nuh, $message) = @_[ARG0, ARG1];
my ($nick, $user, $host) = nuhsplit($nuh);
my $userhost = sprintf("%s@%s", $user, $host);
my $server = $srvmap{$sender->ID()};
my $inv = $heap->{'rc'};
my ($srv) = $inv->has_server($server);
my $current = $inv->current_server();
if ($current eq $srv)
{
nht('quit', $nick, $userhost, $message);
}
else
{
nht('oquit', $nick, $userhost, $message, $server);
}
}
sub irc_socketerr
{
debug('i', "socketerr");
my ($kernel, $reason) = @_[KERNEL, ARG0];
nht('Esocket', $reason);
}
sub irc_snotice
{
debug('i', "snotice");
my ($kernel, $sender) = @_[KERNEL, SENDER];
my $message = $_[ARG0];
nht('snotice', $message);
}
sub irc_ctcp_action
{
debug('i', "ctcp action");
my ($kernel, $heap, $sender) = @_[KERNEL, HEAP, SENDER];
my ($nuh, $recipients, $message) = @_[ARG0..ARG2];
my $target = $recipients->[0];
my $inv = $heap->{'rc'};
my ($sendernick) = nuhsplit($nuh);
my $server = $srvmap{$sender->ID()};
my ($srv) = $inv->has_server($server);
my $nick = $srv->nick();
my $current = $inv->current_server();
my $channel = $srv->current_channel();
if ($target eq $nick)
{
nht('paction', $sendernick, $sendernick, $message);
}
elsif ($current eq $srv)
{
if (lc($target) eq lc($channel))
{
nht('action', $sendernick, $message);
}
else
{
nht('oaction', $sendernick, $target, $message);
}
}
else
{
nht('ooaction', $sendernick, $target, $server, $message);
}
$kernel->post('nethirc_counter', 'add', $server, $nick, $message);
$kernel->post('nethirc_totalitarian', 'check', $message);
}
sub irc_ctcp_ping
{
debug('i', "ctcp ping");
my ($kernel, $heap, $sender) = @_[KERNEL, HEAP, SENDER];
my ($nuh, $recipients, $message) = @_[ARG0..ARG2];
my ($nick) = nuhsplit($nuh);
nht('cping', $nick);
my $db = $heap->{'db'};
# send back a random disaster notice?
my $disaster = pickrandom($db->{'disasters'});
$kernel->post($sender, 'notice', $nick, $disaster);
# do ctcp reply in kind.
my $now = time();
$kernel->post($sender, 'ctcpreply', [ $nick ], "PING $now");
}
sub irc_ctcp_version
{
debug('i', "ctcp version");
my ($kernel, $heap, $sender) = @_[KERNEL, HEAP, SENDER];
my ($nuh, $recipients, $message) = @_[ARG0..ARG2];
my ($nick) = nuhsplit($nuh);
nht('cversion', $nick);
my $db = $heap->{'db'};
# send back a random disaster notice?
my $disaster = pickrandom($db->{'disasters'});
$kernel->post($sender, 'notice', $nick, $disaster);
# do ctcp reply in kind.
my $version = $db->{'version'} || $db->{'formats'}->{'version'} || DEFAULT_VERSION;
$version = sprintf($version, $NetHirc::VERSION);
$kernel->post($sender, 'ctcpreply', [ $nick ], "VERSION $version")
}
sub irc_ctcp_source
{
debug('i', "ctcp source");
my ($kernel, $heap, $sender) = @_[KERNEL, HEAP, SENDER];
my ($nuh, $recipients, $message) = @_[ARG0..ARG2];
my ($nick) = nuhsplit($nuh);
nht('csource', $nick);
my $db = $heap->{'db'};
# send back a random disaster notice?
my $disaster = pickrandom($db->{'disasters'});
$kernel->post($sender, 'notice', $nick, $disaster);
# do ctcp reply in kind.
my $source = $db->{'source'} || $db->{'formats'}->{'source'} || DEFAULT_SOURCE;
$kernel->post($sender, 'ctcpreply', [ $nick ], "SOURCE $source");
}
sub irc_ctcpreply_ping
{
debug('i', "ctcp ping reply");
my ($kernel, $heap) = @_[KERNEL, HEAP];
my ($nuh, $recipients, $message) = @_[ARG0..ARG2];
my ($nick) = nuhsplit($nuh);
nht('crping', $nick, $message);
}
sub irc_ctcpreply_source
{
debug('i', "ctcp source reply");
my ($kernel, $heap) = @_[KERNEL, HEAP];
my ($nuh, $recipients, $message) = @_[ARG0..ARG2];
my ($nick) = nuhsplit($nuh);
nht('crsource', $nick, $message);
}
sub irc_ctcpreply_version
{
debug('i', "ctcp version reply");
my ($kernel, $heap) = @_[KERNEL, HEAP];
my ($nuh, $recipients, $message) = @_[ARG0..ARG2];
my ($nick) = nuhsplit($nuh);
nht('crversion', $nick, $message);
}
sub irc_topic
{
debug('i', "topic");
my ($kernel, $heap) = @_[KERNEL, HEAP];
my ($nuh, $channel, $topic) = @_[ARG0..ARG2];
my ($nick) = nuhsplit($nuh);
nht('topicchange', $nick);
nht('topic', $channel, $topic);
}
sub irc_391
{
debug('i', "391 time");
my $timestr = $_[ARG1];
my ($srvname, $time) = ircsplit($timestr);
nht('servertime', $srvname, $time);
}
sub irc_myportis
{
}
sub irc_useronchannel
{
}
sub irc_004
{
debug('i', "004 myinfo");
my $message = $_[ARG1];
nht('server', $message);
}
sub irc_toomanytargets
{
}
sub irc_331
{
debug('i', "331 notopic");
my $channel = $_[ARG1];
($channel) = ircsplit($channel);
nht('notopic', $channel);
}
sub irc_summondisabled
{
}
sub irc_324
{
debug('i', "324 channelmodeis");
my ($heap, $sender) = @_[HEAP, SENDER];
my $ircstr = $_[ARG1];
my ($channel, $mode, @modeargs) = ircsplit($ircstr);
nht('channelmodeis', $channel, $mode);
my $server = $srvmap{$sender->ID()};
my $inv = $heap->{'rc'};
my ($srv) = $inv->has_server($server);
my @modes = modesplit($mode, @modeargs);
for my $p (@modes)
{
$srv->chanmode($channel, @$p);
}
update_statusline();
}
# If we want to join channels, do it after we see the motd.
sub irc_376
{
debug('i', "376 endofmotd");
my ($kernel, $heap, $session, $sender) = @_[KERNEL, HEAP, SESSION, SENDER];
my $message = $_[ARG1];
nht('server', $message);
my $server = $srvmap{$sender->ID()};
my $inv = $heap->{'rc'};
my ($srv) = $inv->has_server($server);
}
sub irc_366
{
debug('i', "366 endofnames");
# Now that we've gathered all the names, print them.
my ($kernel, $heap, $sender) = @_[KERNEL, HEAP, SENDER];
my $ircstr = $_[ARG1];
my ($channel, $message) = ircsplit($ircstr);
my $server = $srvmap{$sender->ID()};
my $inv = $heap->{'rc'};
my ($srv) = $inv->has_server($server);
my $names = $srv->retrieve_namreply($channel);
if ($channel eq '*')
{
$channel = "no particular channel";
}
nht('names', scalar @$names, $channel);
while (@$names)
{
nht('namelist', join(' ', splice(@$names, 0, 6)));
}
}
sub irc_433
{
debug('i', "433 nicknameinuse");
my $sender = $_[SENDER];
my $server = $srvmap{$sender->ID()};
nht('nicknameinuse', $server);
}
sub irc_351
{
debug('i', "351 version");
my $message = $_[$#_];
nht('server', $message);
}
sub irc_329
{
debug('i', "329 channelcreate");
my ($heap, $ircstr) = @_[HEAP, ARG1];
my ($channel, $when) = ircsplit($ircstr);
my $db = $heap->{'db'};
my $timeformat = $db->{'formats'}->{'time'};
my $since = POSIX::strftime($timeformat, localtime($when));
nht('channelcreate', $channel, $since);
}
sub irc_255
{
debug('i', "255 luserme");
my ($sender, $message) = @_[SENDER, ARG1];
my $server = $srvmap{$sender->ID()};
nht('notice', $server, $message);
}
sub irc_nopermforhost
{
}
sub irc_259
{
debug('i', "259 adminemail");
my $message = $_[$#_];
nht('server', $message);
}
sub irc_fileerror
{
}
sub irc_368
{
debug('i', "368 endofbanlist");
# We don't care about this.
}
sub irc_notregistered
{
}
sub irc_377
{
debug('i', "377 motd2");
my $message = $_[ARG1];
nht('motd', $message);
}
sub irc_316
{
debug('i', "316 whoischanop");
# Where does this come from?
dumpola(@_);
}
sub irc_nousers
{
}
sub irc_whoismodes
{
}
sub irc_alreadyregistered
{
}
sub irc_noadmininfo
{
}
sub irc_noservicehost
{
}
sub irc_summoning
{
}
sub irc_endofinvitelist
{
}
sub irc_266
{
debug('i', "266 n_global");
my $message = $_[$#_];
nht('server', $message);
}
sub irc_helping
{
}
sub irc_475
{
debug('i', "475 badchannelkey");
my $ircstr = $_[ARG1];
my ($channel, $reason) = ircsplit($ircstr);
nht('badchannelkey', $channel);
}
sub irc_441
{
debug('i', "441 usernotinchannel");
my ($server, $ircstr) = @_[ARG0, ARG1];
my ($channel, $nick, $message) = ircsplit($ircstr);
nht('goof', $server, $message);
}
sub irc_endofusers
{
}
sub irc_inviting
{
}
sub irc_003
{
debug('i', "003 created");
my $message = $_[ARG1];
nht('server', $message);
}
sub irc_keyset
{
}
sub irc_helpfwd
{
}
sub irc_noprivileges
{
}
sub irc_474
{
debug('i', "474 bannedfromchan");
my ($server, $ircstr) = @_[ARG0, ARG1];
my ($channel, $message) = ircsplit($ircstr);
nht('bannedfromchan', $server, $channel);
}
sub irc_nologin
{
}
sub irc_helptlr
{
}
sub irc_422
{
debug('i', "422 nomotd");
my ($sender, $message) = @_[SENDER, ARG1];
my $server = $srvmap{$sender->ID()};
nht('notice', $server, $message);
}
sub irc_helphdr
{
}
sub irc_221
{
debug('i', "221 umodeis");
my $mode = $_[ARG1];
nht('umodeis', $mode);
}
sub irc_badchanmask
{
}
sub irc_helpop
{
}
sub irc_374
{
debug('i', "374 endofinfo");
my $message = $_[$#_];
nht('server', $message);
}
sub irc_442
{
debug('i', "442 notonchannel");
my ($server, $ircstr) = @_[ARG0, ARG1];
my ($channel, $message) = ircsplit($ircstr);
nht('goof', $server, $message);
}
sub irc_406
{
debug('i', "406 wasnosuchnick");
my ($server, $ircstr) = @_[ARG0, ARG1];
my ($nick, $message) = ircsplit($ircstr);
nht('goof', $server, $message);
}
sub irc_258
{
debug('i', "258 adminloc2");
my $message = $_[$#_];
nht('server', $message);
}
sub irc_482
{
debug('i', "482 chanoprivsneeded");
my ($kernel, $heap, $sender) = @_[KERNEL, HEAP, SENDER];
my $ircstr = $_[ARG1];
my ($channel, $error) = ircsplit($ircstr);
my $server = $srvmap{$sender->ID()};
nht('goof', $server, $error);
}
sub irc_nonicknamegiven
{
}
sub irc_302
{
debug('i', "302 userhost");
my $userhosts = $_[ARG1];
my @userhosts = ircsplit($userhosts);
for my $uh (@userhosts)
{
my ($nick, $userhost) = split(/=[+-]?/, $uh);
nht('userhost', $nick, $userhost)
}
}
sub irc_users
{
}
sub irc_rehashing
{
}
sub irc_erroneusnickname
{
}
sub irc_noorigin
{
}
sub irc_321
{
debug('i', "321 liststart");
my ($kernel, $heap, $sender) = @_[KERNEL, HEAP, SENDER];
my $server = $srvmap{$sender->ID()};
nht('liststart', $server);
}
sub irc_toomanychannels
{
}
sub irc_helphlp
{
}
sub irc_002
{
debug('i', '002 yourhost');
my ($message) = $_[ARG1];
nht('server', $message);
}
sub irc_371
{
debug('i', "371 info");
my $message = $_[$#_];
nht('motd', $message);
}
sub irc_306
{
debug('i', "306 nowaway");
my ($kernel, $heap, $sender) = @_[KERNEL, HEAP, SENDER];
my $message = $_[ARG1];
my $server = $srvmap{$sender->ID()};
my $inv = $heap->{'rc'};
my ($srv) = $inv->has_server($server);
my $nick = $srv->nick();
$srv->away(1);
nht('switchaway', $server, $nick, $message);
update_statusline();
}
sub irc_invitelist
{
}
sub irc_322
{
debug('i', "322 list");
my $message = $_[ARG1];
my ($channel, $creatures, $topic) = ircsplit($message);
my $format = ($creatures == 1 ? 'list1' : 'list');
$topic = qq("$topic") if $topic;
$topic ||= "nothing in particular";
nht($format, $channel, $creatures, $topic);
}
sub irc_402
{
debug('i', "402 nosuchserver");
my ($server, $ircstr) = @_[ARG0, ARG1];
my ($srvname, $message) = ircsplit($ircstr);
nht('goof', $server, $message);
}
sub irc_401
{
debug('i', "401 nosuchnick");
my ($server, $ircstr) = @_[ARG0, ARG1];
my ($nick, $message) = ircsplit($ircstr);
nht('goof', $server, $message);
}
sub irc_315
{
debug('i', "315 endofwho");
# We don't care about this.
}
# Gather names only for this channel, and print when we get event 366.
sub irc_353
{
debug('i', "353 namreply");
my ($kernel, $heap, $sender) = @_[KERNEL, HEAP, SENDER];
my $ircstr = $_[ARG1];
my (undef, $channel, $namelist) = ircsplit($ircstr);
my $server = $srvmap{$sender->ID()};
my $inv = $heap->{'rc'};
my ($srv) = $inv->has_server($server);
$srv->gather_namreply($channel, $namelist);
}
sub irc_375
{
debug('i', "375 motdstart");
my $message = $_[ARG1];
nht('motd', $message);
}
sub irc_none
{
}
sub irc_403
{
debug('i', "403 nosuchchannel");
my ($server, $ircstr) = @_[ARG0, ARG1];
my ($channel, $message) = ircsplit($ircstr);
nht('goof', $server, $message);
}
sub irc_youwillbebanned
{
}
sub irc_252
{
debug('i', "252 luserop");
my $message = $_[ARG1];
my @args = ircsplit($message);
nht('server', join(' ', @args));
}
sub irc_333
{
debug('i', "333 topicinfo");
my ($heap, $ircstr) = @_[HEAP, ARG1];
my ($channel, $nuh, $datestamp) = ircsplit($ircstr);
my ($nick) = nuhsplit($nuh);
my $db = $heap->{'db'};
my $timeformat = $db->{'formats'}->{'time'};
my $when = POSIX::strftime($timeformat, localtime($datestamp));
nht('topicinfo', $nick, $when);
}
sub irc_whoishelp
{
}
sub irc_250
{
debug('i', "250 luserconns");
my ($sender, $message) = @_[SENDER, ARG1];
my $server = $srvmap{$sender->ID()};
nht('notice', $server, $message);
}
sub irc_303
{
debug('i', "303 ison");
my $message = $_[ARG1];
my ($nicks) = ircsplit($message);
if ($nicks)
{
nht('ison', $nicks);
}
else
{
nht('isnton');
}
}
sub irc_471
{
debug('i', "471 channelisfull");
my $ircstr = $_[ARG1];
my ($channel, $message) = ircsplit($ircstr);
nht('channelisfull', $channel);
}
sub irc_youreoper
{
}
sub irc_305
{
debug('i', "305 unaway");
my ($kernel, $heap, $sender) = @_[KERNEL, HEAP, SENDER];
my $message = $_[ARG1];
my $server = $srvmap{$sender->ID()};
my $inv = $heap->{'rc'};
my ($srv) = $inv->has_server($server);
my $nick = $srv->nick();
nht('switchaway', $server, $nick, $message);
$srv->away(0);
update_statusline();
}
sub irc_323
{
debug('i', "323 listend");
my ($kernel, $heap, $sender) = @_[KERNEL, HEAP, ARG1];
my $server = $srvmap{$sender->ID()};
nht('listend', $server);
}
sub irc_yourebannedcreep
{
}
sub irc_killdone
{
}
sub irc_unknowncommand
{
}
sub irc_umodeunknownflag
{
}
sub irc_usersstart
{
}
sub irc_254
{
debug('i', "254 luserchannels");
my $message = $_[ARG1];
my @args = ircsplit($message);
nht('server', join(' ', @args));
}
sub irc_welcome
{
}
sub irc_404
{
debug('i', "404 cannotsendtochan");
my ($server, $ircstr) = @_[ARG0, ARG1];
my ($channel, $message) = ircsplit($ircstr);
nht('goof', $server, $message);
}
sub irc_373
{
debug('i', "373 infostart");
# We probably don't care, but just to make sure...
dumpola(@_);
}
sub irc_412
{
debug('i', "412 nottexttosend");
my ($server, $ircstr) = @_[ARG0, ARG1];
nht('goof', $server, $ircstr);
}
sub irc_usersdisabled
{
}
sub irc_notoperanymore
{
}
sub irc_usersdontmatch
{
}
sub irc_nooperhost
{
}
sub irc_passwdmismatch
{
}
sub irc_closeend
{
}
sub irc_needmoreparams
{
}
#10 '#nethirc 92g1d2aovw ethics-gradient.nog.net screwdriver.csua.berkeley.edu tnalpgge H :0 Experimental Non-Rabbit'
sub irc_352
{
debug('i', "352 whoreply");
my $ircstr = $_[ARG1];
my @whobits = ircsplit($ircstr);
nht('whoreply', @whobits[0,4,5,1,2,6]);
}
sub irc_257
{
debug('i', "257 adminloc1");
my $message = $_[$#_];
nht('server', $message);
}
sub irc_473
{
debug('i', "473 inviteonlychan");
my $ircstr = $_[ARG1];
my ($channel, $message) = @_;
nht('inviteonlychan', $channel);
}
sub irc_301
{
debug('i', "301 away");
my $message = $_[ARG1];
my ($nick, $reason) = ircsplit($message);
nht('away', $nick, $reason);
}
sub irc_251
{
debug('i', "251 luserclient");
my $message = $_[ARG1];
nht('server', $message);
}
sub irc_nickcollision
{
}
sub irc_luserunknown
{
}
sub irc_332
{
debug('i', "332 topic");
my $ircstr = $_[ARG1];
my ($channel, $topic) = ircsplit($ircstr);
nht('topicpre');
nht('topic', $channel, $topic);
}
sub irc_472
{
debug('i', "472 unknownmode");
my $ircstr = $_[ARG1];
my ($flag, $message) = ircsplit($ircstr);
nht('unknownmode', $flag);
}
sub irc_367
{
debug('i', "367 banlist");
my $heap = $_[HEAP];
my $ircstr = $_[ARG1];
my ($channel, $ban, $who, $when) = ircsplit($ircstr);
my $db = $heap->{'db'};
my $timefmt = $db->{'formats'}->{'time'};
my $since = POSIX::strftime($timefmt, localtime($when));
nht('banlist', $channel, $ban, $who, $since);
}
sub irc_closing
{
}
sub irc_cantkillserver
{
}
sub irc_265
{
debug('i', "265 n_local");
my $message = $_[$#_];
nht('server', $message);
}
sub irc_411
{
debug('i', "411 norecipient");
# How are we going to generate this, except perhaps via quote?
dumpola(@_);
}
sub irc_256
{
debug('i', "256 adminme");
my $message = $_[$#_];
nht('server', $message);
}
sub irc_372
{
debug('i', "372 motd");
my $message = $_[ARG1];
nht('motd', $message);
}
sub irc_005
{
debug('i', "005 map");
my $message = $_[ARG1];
my @args = ircsplit($message);
nht('server', join(' ', @args));
}
sub irc_501
{
debug('i', "501 umodeunknownflag");
my ($server, $ircstr) = @_[ARG0, ARG1];
my $message = ircsplit($ircstr);
nht('goof', $server, $message);
}
sub dumpola
{
my $i = 0;
map{ nht('dumpola', $i++, "$_") } @_[ARG0..$#_];
}
##
## New in the 3.x line of PoCo::IRC. Combines:
## irc_311 (whoisuser)
## irc_312 (whoisserver)
## irc_313 (whoisoperator)
## irc_317 (whoisidle)
## irc_319 (whoischannels)
## irc_320 (whoisidentified, Freenode only, ignored)
## irc_318 (endofwhois)
##
sub irc_whois
{
debug('i', "whois");
my ($heap, $sender, $w) = @_[HEAP, SENDER, ARG0];
my $nick = $w->{'nick'};
nht('whoisuser', $nick, $w->{'user'}, $w->{'host'}, $w->{'real'});
if ($w->{'channels'})
{
nht('whoischannels', $nick, join(' ', @{$w->{'channels'}}));
}
else
{
nht('whoisnochannels', $nick);
}
nht('whoisserver', $nick, $w->{'server'});
if ($w->{'oper'})
{
my $weapon = artifact($nick, $heap, $sender->ID());
nht('whoisoperator', $nick, $weapon);
}
if ($w->{'idle'} and $w->{'signon'})
{
nht('whoisidle', $nick, $w->{'idle'}, scalar(localtime($w->{'signon'})));
}
}
sub artifact
{
my ($nick, $heap, $sender) = @_;
my $inv = $heap->{'rc'};
my $server = $srvmap{$sender};
my ($srv) = $inv->has_server($server);
my $weapon = $srv->artifact($nick);
unless ($weapon)
{
my $db = $heap->{'db'};
my $weapons = $db->{'weapons'};
$weapon = $weapons->[int rand @$weapons];
$srv->artifact($nick, $weapon);
}
return $weapon;
}
##
## New in the 3.x line of PoCo::IRC. Combines:
## irc_314 (whowasuser)
## irc_312 (whoisserver)
## irc_369 (endofwhowas)
##
sub irc_whowas
{
debug('i', "whowas");
my $w = $_[ARG0];
my $nick = $w->{'nick'};
nht('whowasuser', $nick, $w->{'user'}, $w->{'host'}, $w->{'real'});
nht('whoisserver', $nick, $w->{'server'});
}
1;
__END__
syntax highlighted by Code2HTML, v. 0.9.1