# 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