# 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__