# You'd think this was the NetHirc::Commands package, but you'd be wrong.
# We're just going to nominate our own special friend, and add things
# to their symbol table...
package NetHirc::Adventurer;
use strict;
use warnings;
use NetHirc::Amusements;
use NetHirc::Counter;
use NetHirc::Log;
use NetHirc::Pipe;
use NetHirc::Totalitarian;
use NetHirc::Util;
use constant DEFAULT_QUIT => "You escaped the dungeon.";
use constant DEFAULT_KICK => "Eat flying windmill kick!";
sub cmd_error
{
debug('c', "error");
my ($kernel, $heap, $arg) = @_[KERNEL, HEAP, ARG0];
$arg ||= "error";
nht('Enocmd', $arg);
}
sub cmd_say
{
debug('c', "say");
my ($kernel, $heap, $arg) = @_[KERNEL, HEAP, ARG0];
my $inv = $heap->{'rc'};
my $server = $inv->current_server();
unless ($server)
{
nht('noservers');
return;
}
my $srvname = $server->name();
my $channel = $server->current_channel();
my $nick = $server->nick();
if (not $channel)
{
nht('Esay');
return;
}
$kernel->post($srvname, 'privmsg', $channel, $arg);
if ($server->is_query($channel))
{
nht('priv_to', $channel, $arg);
}
else
{
nht('public', $nick, $arg);
}
$kernel->post('nethirc_counter', 'add', $srvname, $nick, $arg);
$kernel->post('nethirc_totalitarian', 'check', $arg);
}
sub cmd_join
{
debug('c', "join");
my ($kernel, $heap, $channel, $key) = @_[KERNEL, HEAP, ARG0, ARG1];
my $inv = $heap->{'rc'};
my $server = $inv->current_server();
unless ($server)
{
nht('noservers');
return;
}
if ($server->has_channel($channel))
{
nht('chanswitch', $channel);
$server->set_channel($channel);
return;
}
my $srvname = $server->name();
$kernel->post($srvname, 'join', $channel, $key);
nht('joining', $channel);
nht('join_key') if $key;
}
sub cmd_quit
{
debug('c', "quit");
my ($kernel, $session, $heap, $message) = @_[KERNEL, SESSION, HEAP, ARG0];
$message ||= DEFAULT_QUIT;
my $inv = $heap->{'rc'};
my $connected;
for my $srv (@$inv)
{
my $srvname = $srv->name();
if ($srv->connected())
{
$kernel->post($srvname, 'quit', $message);
$connected++;
}
}
$heap->{'quitting'} = 1;
my $server = $inv->current_server() || $inv->[0];
nht('quit', $server->nick(), "i.e. you", $message);
if (not $connected)
{
$kernel->post($session, 'shutdown');
}
}
sub cmd_next
{
debug('c', "next");
my ($kernel, $heap) = @_[KERNEL, HEAP];
my $inv = $heap->{'rc'};
my $server = $inv->current_server();
unless ($server)
{
nht('noservers');
return;
}
my $channel = $server->current_channel();
unless ($channel)
{
nht('nochanlist');
return;
}
my $next = $server->next_channel();
if ($next eq $channel)
{
nht('onechannel', $channel);
}
else
{
nht('chanswitch', $next);
}
update_statusline();
}
sub cmd_msg
{
debug('c', "msg");
my ($kernel, $heap, $recipient, $message) = @_[KERNEL, HEAP, ARG0, ARG1];
my $inv = $heap->{'rc'};
my $server = $inv->current_server();
unless ($server)
{
nht('noservers');
return;
}
my $srvname = $server->name();
$kernel->post($srvname, 'privmsg', $recipient, $message);
nht('priv_to', $recipient, $message);
$kernel->post('nethirc_totalitarian', 'check', $message);
}
sub cmd_part
{
debug('c', "part");
my ($kernel, $heap, $channel) = @_[KERNEL, HEAP, ARG0];
my $inv = $heap->{'rc'};
my $server = $inv->current_server();
unless ($server)
{
nht('noservers');
return;
}
my $srvname = $server->name();
# With no args, leave current channel.
if (not $channel)
{
$channel = $server->current_channel();
nht('Wpart', $channel);
}
# Are we even on that channel?
unless ($server->has_channel($channel))
{
nht('Enotinchannel', $channel);
return;
}
$kernel->post($srvname, 'part', $channel);
# Wait for approval before recording that we actually left.
}
sub cmd_me
{
debug('c', "me");
my ($kernel, $heap, $pose) = @_[KERNEL, HEAP, ARG0];
my $inv = $heap->{'rc'};
my $server = $inv->current_server();
unless ($server)
{
nht('noservers');
return;
}
my $srvname = $server->name();
my $channel = $server->current_channel();
my $nick = $server->nick();
if (not $channel)
{
nht('Eme');
return;
}
$kernel->post($srvname, 'ctcp', [ $channel ], "ACTION $pose");
nht('action', $nick, $pose);
$kernel->post('nethirc_counter', 'add', $srvname, $nick, $pose);
$kernel->post('nethirc_totalitarian', 'check', $pose);
}
sub cmd_describe
{
debug('c', "describe");
my ($kernel, $heap, $recipient, $pose) = @_[KERNEL, HEAP, ARG0, ARG1];
my $inv = $heap->{'rc'};
my $server = $inv->current_server();
unless ($server)
{
nht('noservers');
return;
}
my $srvname = $server->name();
$kernel->post($srvname, 'ctcp', [ $recipient ], "ACTION $pose");
nht('paction_to', $recipient, $server->nick(), $pose);
$kernel->post('nethirc_totalitarian', 'check', $pose);
}
sub cmd_ctcp
{
debug('c', "ctcp");
my ($kernel, $heap) = @_[KERNEL, HEAP];
my ($recipient, $type, $message) = @_[ARG0..ARG2];
my $inv = $heap->{'rc'};
my $server = $inv->current_server();
unless ($server)
{
nht('noservers');
return;
}
my $srvname = $server->name();
$type = uc($type);
$message ||= "";
$kernel->post($srvname, 'ctcp', [ $recipient ], "$type $message");
}
sub cmd_kick
{
debug('c', "kick");
my ($kernel, $heap) = @_[KERNEL, HEAP];
my ($channel, $victim, $message) = @_[ARG0..ARG2];
my $inv = $heap->{'rc'};
my $server = $inv->current_server();
unless ($server)
{
nht('noservers');
return;
}
my $srvname = $server->name();
$message ||= DEFAULT_KICK;
$kernel->post($srvname, 'kick', $channel, $victim, $message);
}
sub cmd_mode
{
debug('c', "mode");
my ($kernel, $heap) = @_[KERNEL, HEAP];
my ($target, $modestr, @modeargs) = @_[ARG0, ARG1, ARG2..$#_];
my $inv = $heap->{'rc'};
my $server = $inv->current_server();
unless ($server)
{
nht('noservers');
return;
}
my $srvname = $server->name();
$kernel->post($srvname, 'mode', $target, $modestr, @modeargs);
}
sub cmd_nick
{
debug('c', "nick");
my ($kernel, $heap, $newnick) = @_[KERNEL, HEAP, ARG0];
my $inv = $heap->{'rc'};
my $server = $inv->current_server();
unless ($server)
{
nht('noservers');
return;
}
my $srvname = $server->name();
$kernel->post($srvname, 'nick', $newnick);
$server->request_nick($newnick);
}
sub cmd_notice
{
debug('c', "notice");
my ($kernel, $heap, $recipient, $message) = @_[KERNEL, HEAP, ARG0, ARG1];
my $inv = $heap->{'rc'};
my $server = $inv->current_server();
unless ($server)
{
nht('noservers');
return;
}
my $srvname = $server->name();
$kernel->post($srvname, 'notice', $recipient, $message);
nht('notice', $recipient, $message);
$kernel->post('nethirc_totalitarian', 'check', $message);
}
sub cmd_admin
{
debug('c', "admin");
my ($kernel, $heap, $host) = @_[KERNEL, HEAP, ARG0];
my $inv = $heap->{'rc'};
my $server = $inv->current_server();
unless ($server)
{
nht('noservers');
return;
}
my $srvname = $server->name();
$kernel->post($srvname, 'admin', $host);
}
sub cmd_away
{
debug('c', "away");
my ($kernel, $heap, $message) = @_[KERNEL, HEAP, ARG0];
my $inv = $heap->{'rc'};
my $server = $inv->current_server();
unless ($server)
{
nht('noservers');
return;
}
my $srvname = $server->name();
$kernel->post($srvname, 'away', $message);
}
sub cmd_info
{
debug('c', "info");
my ($kernel, $heap, $host) = @_[KERNEL, HEAP, ARG0];
my $inv = $heap->{'rc'};
my $server = $inv->current_server();
unless ($server)
{
nht('noservers');
return;
}
my $srvname = $server->name();
$kernel->post($srvname, 'info', $host);
}
sub cmd_version
{
debug('c', "version");
my ($kernel, $heap, $host) = @_[KERNEL, HEAP, ARG0];
my $inv = $heap->{'rc'};
my $server = $inv->current_server();
unless ($server)
{
nht('noservers');
return;
}
my $srvname = $server->name();
$kernel->post($srvname, 'version', $host);
}
sub cmd_invite
{
debug('c', "invite");
my ($kernel, $heap, $nick, $channel) = @_[KERNEL, HEAP, ARG0, ARG1];
my $inv = $heap->{'rc'};
my $server = $inv->current_server();
unless ($server)
{
nht('noservers');
return;
}
my $srvname = $server->name();
$kernel->post($srvname, 'invite', $nick, $channel);
nht('inviting', $nick, $channel);
}
sub cmd_ison
{
debug('c', "ison");
my ($kernel, $heap, @nicks) = @_[KERNEL, HEAP, ARG0..$#_];
my $inv = $heap->{'rc'};
my $server = $inv->current_server();
unless ($server)
{
nht('noservers');
return;
}
my $srvname = $server->name();
$kernel->post($srvname, 'ison', @nicks);
}
sub cmd_list
{
debug('c', "list");
my ($kernel, $heap, @stuff) = @_[KERNEL, HEAP, ARG0..$#_];
my $inv = $heap->{'rc'};
my $server = $inv->current_server();
unless ($server)
{
nht('noservers');
return;
}
my $srvname = $server->name();
if (@stuff)
{
$kernel->post($srvname, 'list', @stuff);
}
else
{
nht('Clist');
$kernel->post('nethirc_terminal', 'confirm', '_cmd_list_confirmed', '_cmd_list_refused');
}
}
sub _cmd_list_confirmed
{
my ($kernel, $heap) = @_[KERNEL, HEAP];
my $inv = $heap->{'rc'};
my $server = $inv->current_server();
my $srvname = $server->name();
nht('Caccepted');
$kernel->post($srvname, 'list');
}
sub _cmd_refused
{
nht('Crefused');
}
sub cmd_names
{
debug('c', "names");
my ($kernel, $heap, @stuff) = @_[KERNEL, HEAP, ARG0..$#_];
my $inv = $heap->{'rc'};
my $server = $inv->current_server();
unless ($server)
{
nht('noservers');
return;
}
my $srvname = $server->name();
if (@stuff)
{
$kernel->post($srvname, 'names', @stuff);
}
else
{
nht('Clist');
$kernel->post('nethirc_terminal', 'confirm', '_cmd_names_confirmed', '_cmd_refused');
}
}
sub _cmd_names_confirmed
{
my ($kernel, $heap) = @_[KERNEL, HEAP];
my $inv = $heap->{'rc'};
my $server = $inv->current_server();
my $srvname = $server->name();
nht('Caccepted');
$kernel->post($srvname, 'names');
}
sub cmd_motd
{
debug('c', "motd");
my ($kernel, $heap, $host) = @_[KERNEL, HEAP, ARG0];
my $inv = $heap->{'rc'};
my $server = $inv->current_server();
unless ($server)
{
nht('noservers');
return;
}
my $srvname = $server->name();
$kernel->post($srvname, 'motd', $host);
}
sub cmd_time
{
debug('c', "time");
my ($kernel, $heap, $host) = @_[KERNEL, HEAP, ARG0];
my $inv = $heap->{'rc'};
my $server = $inv->current_server();
unless ($server)
{
nht('noservers');
return;
}
my $srvname = $server->name();
$kernel->post($srvname, 'time', $host);
}
sub cmd_topic
{
debug('c', "topic");
my ($kernel, $heap, $channel, $newtopic) = @_[KERNEL, HEAP, ARG0, ARG1];
my $inv = $heap->{'rc'};
my $server = $inv->current_server();
unless ($server)
{
nht('noservers');
return;
}
my $srvname = $server->name();
$kernel->post($srvname, 'topic', $channel, $newtopic);
}
sub cmd_userhost
{
debug('c', "userhost");
my ($kernel, $heap, @nicks) = @_[KERNEL, HEAP, ARG0..$#_];
my $inv = $heap->{'rc'};
my $server = $inv->current_server();
unless ($server)
{
nht('noservers');
return;
}
my $srvname = $server->name();
$kernel->post($srvname, 'userhost', @nicks);
}
sub cmd_users
{
debug('c', "users");
my ($kernel, $heap, $host) = @_[KERNEL, HEAP, ARG0];
my $inv = $heap->{'rc'};
my $server = $inv->current_server();
unless ($server)
{
nht('noservers');
return;
}
my $srvname = $server->name();
$kernel->post($srvname, 'users', $host);
}
sub cmd_who
{
debug('c', "who");
my ($kernel, $heap, @stuff) = @_[KERNEL, HEAP, ARG0..$#_];
my $inv = $heap->{'rc'};
my $server = $inv->current_server();
unless ($server)
{
nht('noservers');
return;
}
my $srvname = $server->name();
$kernel->post($srvname, 'who', @stuff);
}
sub cmd_whois
{
debug('c', "whois");
my ($kernel, $heap, @stuff) = @_[KERNEL, HEAP, ARG0..$#_];
my $inv = $heap->{'rc'};
my $server = $inv->current_server();
unless ($server)
{
nht('noservers');
return;
}
my $srvname = $server->name();
$kernel->post($srvname, 'whois', @stuff);
}
sub cmd_whowas
{
debug('c', "whowas");
my ($kernel, $heap, @stuff) = @_[KERNEL, HEAP, ARG0..$#_];
my $inv = $heap->{'rc'};
my $server = $inv->current_server();
unless ($server)
{
nht('noservers');
return;
}
my $srvname = $server->name();
$kernel->post($srvname, 'whowas', @stuff);
}
sub cmd_server
{
debug('c', "server");
my ($kernel, $session, $heap) = @_[KERNEL, SESSION, HEAP];
my ($srvname, $nick, $passwd) = @_[ARG0..ARG2];
my $inv = $heap->{'rc'};
my ($srv) = $inv->has_server($srvname);
if ($srv)
{
if (not $srv->connected())
{
$kernel->post($srvname, 'connect');
}
$inv->set_server($srvname);
nht('serverswitch', $srvname);
update_statusline();
return;
}
my $oldsrv = $inv->current_server();
my $newsrv = {
'channels' => [],
'_joined' => [],
'Server' => $srvname,
};
$newsrv->{'Nick'} = $nick if $nick;
$newsrv->{'Password'} = $passwd if $passwd;
$newsrv->{'LocalPort'} = $oldsrv->{'LocalPort'};
$newsrv->{'LocalAddr'} = $oldsrv->{'LocalAddr'};
$newsrv->{'Ircname'} = $oldsrv->{'Ircname'};
bless $newsrv, "NetHirc::Server";
push(@$inv, $newsrv);
$kernel->post($session, 'next_connect');
}
sub cmd_disconnect
{
debug('c', "disconnect");
my ($kernel, $heap) = @_[KERNEL, HEAP];
my $srvname = $_[ARG0];
my $inv = $heap->{'rc'};
my $srv;
if ($srvname)
{
($srv) = $inv->has_server($srvname);
goto cmd_disconnect_nonesuch unless $srv; ## XXX icky icky icky!
}
else
{
$srv = $inv->current_server();
$srvname = $srv->name();
nht('Wdisconnect', $srvname);
}
my $session = $kernel->alias_resolve($srvname);
if ($session)
{
$kernel->post($session, 'quit');
return;
}
cmd_disconnect_nonesuch:
nht('Edisconnect', $srvname);
}
sub cmd_debug
{
debug('c', "command");
my ($kernel, $heap) = @_[KERNEL, HEAP];
my $inv = $heap->{'rc'};
my $server = $inv->[0];
my $srvname = $server->name();
my $session = $kernel->alias_resolve($srvname);
$session->get_heap()->{'debug'} ^= 1;
$session->get_heap()->{'irc_filter'}->{'debug'} ^= 1;
nht('debug', $srvname);
}
sub cmd_argcount
{
debug('c', "argcount");
my $cmd = $_[ARG0];
dumpola(@_);
nht('needmoreparams', $cmd);
}
sub cmd_yoda
{
debug('c', "yoda");
my ($kernel, $session, $message) = @_[KERNEL, SESSION, ARG0];
$kernel->post($session, 'cmd_say', yoda_front($message));
}
sub cmd_pigl
{
debug('c', "pigl");
my ($kernel, $session, $message) = @_[KERNEL, SESSION, ARG0];
$kernel->post($session, 'cmd_say', pigl_front($message));
}
sub cmd_mirror
{
debug('c', "pigl");
my ($kernel, $session, $message) = @_[KERNEL, SESSION, ARG0];
$kernel->post($session, 'cmd_say', mirror($message));
}
sub cmd_shuffle
{
debug('c', "shuffle");
my ($kernel, $session, $message) = @_[KERNEL, SESSION, ARG0];
$kernel->post($session, 'cmd_say', shuffle($message));
}
sub cmd_inventory
{
debug('c', "inventory");
my ($heap, $server) = @_[HEAP, ARG0];
my $inv = $heap->{'rc'};
my $srv;
if ($server)
{
($srv) = $inv->has_server($server);
}
else
{
$srv = $inv->current_server();
}
unless ($srv)
{
nht('noservers');
return;
}
my @channels = $srv->channels();
if (@channels)
{
nht('channels', join(' ', @channels));
}
else
{
nht('nochanlist');
}
}
sub cmd_help
{
debug('c', "help");
my ($heap, $topic) = @_[HEAP, ARG0];
$topic ||= "help";
my $db = $heap->{'db'};
my $help = $db->{'help'};
for my $i (qw(usage description))
{
nht('help', ucfirst($i), $help->{$topic}->{$i});
}
if ($topic eq 'help')
{
my @commands = sort keys %$help;
nht('commands0');
while (@commands)
{
my @x = splice(@commands, 0, 6);
nht('commands1', join(' ', @x));
}
}
}
sub cmd_log
{
debug('c', "log");
my ($kernel, $session) = @_[KERNEL, SESSION];
my ($arg, $filename) = @_[ARG0, ARG1];
$arg ||= 'status';
if ($arg eq 'stop')
{
$kernel->post($session, '_cmd_log_stop');
}
elsif ($arg eq 'start')
{
$kernel->post($session, '_cmd_log_start', $filename);
}
elsif ($arg eq 'restart')
{
$kernel->post($session, '_cmd_log_stop');
$kernel->post($session, '_cmd_log_start', $filename);
}
elsif ($arg eq 'status')
{
$kernel->post($session, '_cmd_log_status')
}
else
{
nht('Elogcommand', $arg);
}
}
sub _cmd_log_start
{
debug('c', "_cmd_log_start");
my ($kernel, $session, $heap, $filename) = @_[KERNEL, SESSION, HEAP, ARG0];
my $current = $heap->{'_logfile'};
unless ($heap->{'_log'})
{
NetHirc::Log->new();
$heap->{'_log'} = 1;
}
if ($current)
{
if ($current eq $filename)
{
nht('Elogsamefile');
return;
}
$kernel->post($session, '_cmd_log_stop');
}
unless ($filename)
{
nht('Enologfile');
return;
}
my $success = $session->postback('_cmd_log_start_confirmed', $filename);
my $fail = $session->postback('_cmd_log_start_error', $filename);
$kernel->post('nethirc_log', 'begin', $filename, $success, $fail);
}
sub _cmd_log_start_confirmed
{
my ($heap, $arg) = @_[HEAP, ARG0];
my $filename = $arg->[0];
nht('logstart0');
nht('logstart1', $filename);
$heap->{'_logfile'} = $filename;
}
sub _cmd_log_start_error
{
my $arg = $_[ARG1];
my $error = $arg->[0];
nht('Ecantlog', $error);
}
sub _cmd_log_stop_confirmed
{
my $heap = $_[HEAP];
my $filename = $heap->{'_logfile'};
nht('logstop0');
nht('logstop1', $filename);
delete $heap->{'_logfile'};
}
sub _cmd_log_stop
{
debug('c', "_cmd_log_stop");
my ($kernel, $session, $heap) = @_[KERNEL, SESSION, HEAP];
# If we aren't logging, error message.
unless ($heap->{'_logfile'})
{
nht('Enotlogging');
return;
}
my $pb = $session->postback('_cmd_log_stop_confirmed');
$kernel->post('nethirc_log', 'end', $pb);
}
sub _cmd_log_write_error
{
debug('c', "_cmd_log_write_error");
my ($kernel, $session, $heap) = @_[KERNEL, SESSION, HEAP];
$kernel->post($session, '_cmd_log_stop');
}
sub _cmd_log_status
{
debug('c', "_cmd_log_status");
my ($kernel, $session, $heap) = @_[KERNEL, SESSION, HEAP];
my $logfile = $heap->{'_logfile'};
if ($logfile)
{
nht('logstart1', $logfile);
}
else
{
nht('Enotlogging');
}
}
sub cmd_count
{
debug('c', "count");
my ($kernel, $session) = @_[KERNEL, SESSION];
my @args = @_[ARG0, ARG1];
$args[0] ||= 'status';
if ($args[0] eq 'show')
{
$kernel->post($session, '_cmd_count_show', $args[1]);
}
elsif ($args[0] eq 'start')
{
$kernel->post($session, '_cmd_count_start', $args[1]);
}
elsif ($args[0] eq 'stop')
{
$kernel->post($session, '_cmd_count_stop', $args[1]);
}
elsif ($args[0] eq 'status')
{
$kernel->post($session, '_cmd_count_status');
}
elsif ($args[0] eq 'clear')
{
$kernel->post($session, '_cmd_count_clear', $args[1]);
}
else
{
nht('Ecountcommand', $args[0]);
}
}
sub _cmd_count_show
{
debug('c', "_cmd_count_show");
my ($kernel, $session, $heap, $server) = @_[KERNEL, SESSION, HEAP, ARG0];
my $inv = $heap->{'rc'};
my $current = $inv->current_server();
$server ||= $current->name();
my $statsfile = $heap->{'_stats'};
unless ($statsfile)
{
nht('countstateoff');
return;
}
my $pb;
if ($server eq 'all')
{
$pb = $session->postback('_cmd_count_report_all');
$kernel->post('nethirc_counter', 'show_all', $pb);
}
else
{
$pb = $session->postback('_cmd_count_report_one', $server);
$kernel->post('nethirc_counter', 'show', $server, $pb);
}
}
sub _cmd_count_report_all
{
debug('c', "_cmd_count_report_all");
my ($request, $response) = @_[ARG0, ARG1];
for my $i (@$response)
{
my $server = $i->[0]->[-1];
_count_report_one_backend($server, $i);
}
}
sub _cmd_count_report_one
{
debug('c', "_cmd_count_report_one");
my ($request, $response) = @_[ARG0, ARG1];
my $server = $request->[0];
unless (@$response)
{
nht('Enocountserver', $server);
return;
}
_count_report_one_backend($server, $response);
}
sub _count_report_one_backend
{
debug('c', "_count_report_one_backend");
my $server = shift;
my $response = shift;
nht('countheader', $server);
for my $i (@$response)
{
my @order = @{$i}[3,0..2];
nht('countstats', @order);
}
nht('countfooter', $server);
}
sub _cmd_count_start
{
debug('c', "_cmd_count_start");
my ($kernel, $session, $heap, $filename) = @_[KERNEL, SESSION, HEAP, ARG0];
my $success = $session->postback('_cmd_count_start_success', $filename);
my $fail = $session->postback('_cmd_count_start_fail', $filename);
# Are we already tracking stats?
if (exists $heap->{'_stats'})
{
if ($heap->{'_stats'} eq $filename)
{
nht('Ecountalready', $filename);
return;
}
if ($filename)
{
$kernel->post($session, '_cmd_count_stop');
}
}
else
{
NetHirc::Counter->new();
}
unless ($filename)
{
nht('Ecountfile');
return;
}
$kernel->post('nethirc_counter', 'begin', $filename, $success, $fail);
}
sub _cmd_count_start_success
{
debug('c', "_cmd_count_start_success");
my ($heap, $request, $response) = @_[HEAP, ARG0, ARG1];
my $filename = $request->[0];
nht('countopen', $filename);
$heap->{'_stats'} = $filename;
}
sub _cmd_count_start_fail
{
debug('c', "_cmd_count_start_fail");
my ($request, $response) = @_[ARG0, ARG1];
my $error = $response->[0];
nht('Ecountstart', $error);
}
sub _cmd_count_stop
{
debug('c', "_cmd_count_stop");
my ($kernel, $heap, $session) = @_[KERNEL, HEAP, SESSION];
my ($request, $response) = @_[ARG0, ARG1];
my $success = $session->postback('_cmd_count_stop_success');
my $fail = $session->postback('_cmd_count_stop_fail');
if (not exists $heap->{'_stats'})
{
nht('countstateoff');
return;
}
$kernel->post('nethirc_counter', 'end', $success, $fail);
}
sub _cmd_count_stop_success
{
debug('c', "_cmd_count_stop_success");
my ($heap, $request, $response) = @_[HEAP, ARG0, ARG1];
my $filename = $response->[0];
nht('countclose', $filename);
delete $heap->{'_stats'};
}
sub _cmd_count_stop_fail
{
debug('c', "_cmd_count_stop_fail");
my ($heap, $request, $response) = @_[HEAP, ARG0, ARG1];
my $error = $response->[0];
my $filename = $heap->{'_stats'};
nht('Ecountstop', $error);
nht('countclose', $filename);
delete $heap->{'_stats'};
}
sub _cmd_count_status
{
debug('c', "_cmd_count_status");
my $heap = $_[HEAP];
my $statsfile = $heap->{'_stats'};
if ($statsfile)
{
nht('countstateon', $statsfile);
}
else
{
nht('countstateoff');
}
}
sub _cmd_count_clear
{
debug('c', "_cmd_count_clear");
my ($kernel, $heap, $session) = @_[KERNEL, HEAP, SESSION];
my $arg = $_[ARG0];
my $statsfile = $heap->{'_stats'};
unless ($statsfile)
{
nht('Ecountclear');
return;
}
my $inv = $heap->{'rc'};
my $srv = $inv->current_server();
my $srvname = $srv->name();
$arg ||= $srvname;
if ($arg eq 'all')
{
$kernel->post('nethirc_counter', 'clear_all');
nht('countclearall', $statsfile);
return;
}
$kernel->post('nethirc_counter', 'clear', $arg);
nht('countclear0', $statsfile);
nht('countclear1', $srvname);
}
sub cmd_system
{
debug('c', "cmd_system");
my ($kernel, $session, $heap) = @_[KERNEL, SESSION, HEAP];
my $cmd = $_[ARG0];
my $display = $session->postback('_cmd_system_display');
my $error = $session->postback('_cmd_system_error');
NetHirc::Pipe->new(
Command => $cmd,
Display => $display,
Error => $error,
);
}
sub _cmd_system_display
{
my $response = $_[ARG1];
nht('plain', $response->[0]);
}
sub _cmd_system_error
{
my $response = $_[ARG1];
my ($op, $errstr) = @$response;
nht('Esystem0');
nht('Esystem1', $op, $errstr);
}
sub cmd_pipe
{
debug('c', "cmd_pipe");
my ($kernel, $session, $heap) = @_[KERNEL, SESSION, HEAP];
my $cmd = $_[ARG0];
my $inv = $heap->{'rc'};
my $server = $inv->current_server();
unless ($server)
{
nht('noservers');
return;
}
my $srvname = $server->name();
my $channel = $server->current_channel();
if (not $channel)
{
nht('Epipesay');
return;
}
my $display = $session->postback('_cmd_pipe_display', $srvname, $channel);
my $error = $session->postback('_cmd_pipe_error');
my $close = $session->postback('_cmd_pipe_close', $channel, $cmd);
NetHirc::Pipe->new(
Command => $cmd,
Display => $display,
Error => $error,
Close => $close,
);
nht('pipe', $cmd, $channel);
}
sub _cmd_pipe_display
{
my ($kernel, $heap, $session) = @_[KERNEL, HEAP, SESSION];
my ($request, $response) = @_[ARG0, ARG1];
my ($srvname, $target) = @$request;
my $message = $response->[0];
$kernel->post($srvname, 'privmsg', $target, $message);
my $inv = $heap->{'rc'};
my ($srv) = $inv->has_server($srvname);
my $nick = $srv->nick();
$kernel->post($session, 'display_public', $srvname, $target, $nick, $message);
$kernel->post('nethirc_counter', 'add', $srvname, $nick, $message);
$kernel->post('nethirc_totalitarian', 'check', $message);
}
sub _cmd_pipe_error
{
my $response = $_[ARG1];
my ($op, $errstr) = @$response;
nht('Epipe0');
nht('Epipe1', $op, $errstr);
}
sub _cmd_pipe_close
{
my $request = $_[ARG0];
my ($channel, $cmd) = @$request;
nht('pipeclosed', $cmd, $channel);
}
sub cmd_pipemsg
{
debug('c', "cmd_pipemsg");
my ($kernel, $session, $heap) = @_[KERNEL, SESSION, HEAP];
my ($victim, $cmd) = @_[ARG0, ARG1];
my $inv = $heap->{'rc'};
my $server = $inv->current_server();
unless ($server)
{
nht('noservers');
return;
}
my $srvname = $server->name();
my $display = $session->postback('_cmd_pipemsg_display', $srvname, $victim);
my $error = $session->postback('_cmd_pipemsg_error');
my $close = $session->postback('_cmd_pipemsg_close', $victim, $cmd);
NetHirc::Pipe->new(
Command => $cmd,
Display => $display,
Error => $error,
);
nht('pipe', $cmd, $victim);
}
sub _cmd_pipemsg_display
{
my ($kernel, $heap, $request, $response) = @_[KERNEL, HEAP, ARG0, ARG1];
my ($srvname, $victim) = @$request;
my $message = $response->[0];
$kernel->post($srvname, 'privmsg', $victim, $message);
nht('priv_to', $victim, $message);
$kernel->post('nethirc_totalitarian', 'check', $message);
}
sub _cmd_pipemsg_error
{
my $response = $_[ARG1];
my ($op, $errstr) = @$response;
nht('Epipe0');
nht('Epipe1', $op, $errstr);
}
sub _cmd_pipemsg_close
{
my $request = $_[ARG0];
my ($victim, $cmd) = @$request;
nht('pipeclosed', $cmd, $victim);
}
sub cmd_bigbrother
{
debug('c', "cmd_bigbrother");
my ($kernel, $session) = @_[KERNEL, SESSION];
my $cmd = $_[ARG0];
$cmd ||= 'status';
if ($cmd eq 'on')
{
$kernel->post($session, '_cmd_bigbrother_on');
}
elsif ($cmd eq 'off')
{
$kernel->post($session, '_cmd_bigbrother_off');
}
elsif ($cmd eq 'status')
{
$kernel->post($session, '_cmd_bigbrother_status');
}
else
{
nht('Ebigbrothercommand', $cmd);
}
}
sub _cmd_bigbrother_on
{
my ($kernel, $session, $heap) = @_[KERNEL, SESSION, HEAP];
unless ($heap->{'_bigbrother'})
{
my $announce = $session->postback('_cmd_bigbrother_announce');
NetHirc::Totalitarian->new($announce);
$heap->{'_bigbrother'} = 1;
}
$kernel->post('nethirc_totalitarian', 'on');
nht('bigbrother_on0');
nht('bigbrother_on1');
}
sub _cmd_bigbrother_off
{
my ($kernel, $session, $heap) = @_[KERNEL, SESSION, HEAP];
$kernel->post('nethirc_totalitarian', 'off');
nht('bigbrother_off0');
nht('bigbrother_off1');
}
sub _cmd_bigbrother_announce
{
my $response = $_[ARG1];
my @words = @$response;
nht('verboten0');
nht('verboten1', join(' ', map { qq('$_') } @words));
nht('verboten2');
nht('verboten3');
}
sub _cmd_bigbrother_status
{
my ($kernel, $session, $heap) = @_[KERNEL, SESSION, HEAP];
my $toggle = 0;
if ($heap->{'_bigbrother'})
{
my $totalitarian = $kernel->alias_resolve('nethirc_totalitarian');
my $tot_heap = $totalitarian->get_heap();
$toggle = $tot_heap->{'toggle'};
}
my $stat = ('disabled', 'enabled')[$toggle];
nht('bigbrotherstat', $stat);
}
sub cmd_query
{
my ($kernel, $session, $heap) = @_[KERNEL, SESSION, HEAP];
my $nick = $_[ARG0];
if ($nick)
{
$kernel->post($session, '_cmd_query_start', $nick);
}
else
{
$kernel->post($session, '_cmd_query_stop');
}
}
sub _cmd_query_start
{
my ($kernel, $session, $heap) = @_[KERNEL, SESSION, HEAP];
my $nick = $_[ARG0];
my $inv = $heap->{'rc'};
my $server = $inv->current_server();
unless ($server)
{
nht('noservers');
return;
}
if ($server->has_channel($nick))
{
$server->set_channel($nick);
nht('queryswitch', $nick);
}
else
{
$server->add_channel($nick);
nht('querystart', $nick);
}
update_statusline();
}
sub _cmd_query_stop
{
my ($kernel, $session, $heap) = @_[KERNEL, SESSION, HEAP];
my $nick = $_[ARG0];
my $inv = $heap->{'rc'};
my $server = $inv->current_server();
unless ($server)
{
nht('noservers');
return;
}
my $query = $server->current_channel();
my @queries = $server->current_queries();
if (@queries > 1)
{
if (not $server->is_query($query))
{
nht('Emultiquery', scalar @queries);
return;
}
}
elsif (@queries == 0)
{
nht('Enoqueries');
return;
}
if ($query ne $queries[0])
{
nht('Wquerystop', $queries[0]);
}
nht('querystop', $queries[0]);
$server->remove_channel($queries[0]);
reorient($server);
update_statusline();
}
1;
__END__
syntax highlighted by Code2HTML, v. 0.9.1