##
## commands.pl
## 
## Defaults for user commands.
##
## This file is part of NetHirc.  (c) 1998-1999 Tony Monroe.
##

push @rcs_id, q$Id: commands.pl,v 1.14 1999/08/28 04:12:30 tony Exp $;

sub do_msg { 
    my ($conn, $first, $rest) = @_;
    my ($recipient, $text) = split(' ', $rest, 2);
    my $t = &ircformat('priv_to', $recipient, $text);
    if ($recipient =~ /^[#&]/) {
	$conn->print(&ircformat('Emsg'));
    } else {
	$conn->privmsg($recipient, $text);
	if ($stuff{'echo'}) { $conn->print($t); }
	if ($stuff{'log'}) { $stuff{'log'}->print(time() . " $t\n"); }
    }
}

sub do_ctcp { 
    my ($conn, $first, $rest) = @_;
    my ($target, $type, $evenmore) = split(' ', $rest, 3); # Consistent w/ircII
    $conn->ctcp($type, $target, $evenmore);
    $type = uc($type);
    my $t = &ircformat('ctcp', "$type sent to $target");
    if ($type eq 'PING') {
	$stuff{'cpings'}->{$target} = time();
    }
    $conn->print($t);
    if ($stuff{'log'}) { $stuff{'log'}->print(time() . " $t\n"); }
}

#sub do_dcc { 
#    my ($conn, $first, $rest) = @_;
#    my ($type, $target, $evenmore) = split(' ', $rest, 3);
#    my ($address, $port);
#    $type = uc($type);
#    if ($type eq 'CHAT') {
#	## Magically select an address and port.  The DCC spec seems
#	## to indicate stupid tricks with port 0 and INADDR_ANY.
#	$conn->new_chat(1, $target, INADDR_ANY, 0);
#	## This object is added to the list of sockets.  We need to
#	## maintain it on our list of channels though.
#	&admin_print("You are covered in ice!  The ice doesn't feel cold!");
#    } elsif ($type eq 'GET') {
#	## Check the list of files that have been offered to us,
#	## and snarf this one if it is there.  The list will be
#	## indexed by nick or filename, perhaps...
#	&admin_print("The blast of fire hits you!  Yon don't feel hot!");
#    } elsif ($type eq 'SEND') {
#	## Put this on a send queue.  The rest is handled in a handler.
#	&admin_print("The rust monster hits you!  Your boots are unaffected!");
#    } else {
#	&admin_print("The imp casts aspersions on your ancestry.");
#    }
#}

sub do_eval { 
    my ($conn, $first, $rest) = @_;
    eval $rest;
    if ($@) {
	$conn->print(&ircformat('Eeval', $@));
    }
}


sub do_cmd_char { 
    my ($conn, $first, $rest) = @_;
    my ($cc) = &firstword($rest);
    $stuff{'cmd_char'} = $cc;
}

sub do_system { 
    my ($conn, $first, $rest) = @_;
    my $rc;
    $rc = system($rest);	## It is not my place to protect you.
    if ($rc != 0) {
	$conn->print(&ircformat('Esystem0'));
	$conn->print(&ircformat('Esystem1', $rc));
    };
}

sub do_pipe { 
    my ($conn, $first, $rest) = @_;
    my $fh = new IO::File;
    if (not $stuff{'defchannel'}) {
	$conn->print(&ircformat('Epipesay'));
	return;
    }
    unless ($fh->open("$rest |")) {
	$conn->print(&ircformat('Epipe', $!));
	return;
    }
    $irc->addfh($fh, &saytoer($conn, $stuff{'defchannel'}, $fh, $rest));
    $conn->print(&ircformat('pipe', $rest, $stuff{'defchannel'}));
}

sub do_pipemsg { 
    my ($conn, $first, $rest) = @_;
    my $fh = new IO::File;
    my ($recipient, $cmd) = split(' ', $rest, 2);
    if (not $recipient) {
	$conn->print(&ircformat('Epipesay'));
	return;
    }
    unless ($fh->open("$cmd |")) {
	$conn->print(&ircformat('Epipe', $!));
	return;
    }
    $irc->addfh($fh, &saytoer($conn, $recipient, $fh, $cmd));
    $conn->print(&ircformat('pipe', $cmd, $recipient));
}

sub do_bye { 
    my ($conn, $first, $rest) = @_;
    &bail($first eq 'pickle' ? "Let's pickle!" : $rest);
}

sub do_echo { 
    my ($conn, $first, $rest) = @_;
    if (lc($rest) eq 'on') {
	$conn->print(&ircformat('echo_on'));
	$stuff{'echo'} = 1;
    } elsif (lc($rest) eq 'off') {
	$conn->print(&ircformat('echo_off'));
	$stuff{'echo'} = 0;
    } else {
	$conn->print(&ircformat('Eecho', uc $first, $first, $first));
    }
}

sub do_admin { 
    my ($conn, $first, $rest) = @_;
    $conn->admin($rest);
}

sub do_server { 
    my ($conn, $first, $rest) = @_;
    unless ($rest) {
	$conn->print(&ircformat('Eserver'));
	return;
    }
    ## This is a really gross hack.  But it saves us from nasty
    ## stdin-falling-out-of-sync errors.  So far, at least.
    $newconn = $irc->newconn( Nick => $conn->nick,
			      Ircname => $conn->ircname,
			      Username => $conn->username,
			      LocalAddr => $opts{'h'},
			      Server => $rest );
    if ($newconn) {
	&do_reload($newconn, 'reload', 'handlers');
	$stuff{'conn'} = $newconn;
	$conn->quit("Changing servers");
    }
#    push @{$stuff{'oldlist'}}, @{$stuff{'chanlist'}}; ## dammit.
#    delete $stuff{'chanlist'};
    ## Rejoining old channels is done at endofmotd, since we know
    ## we're connected there.
}

sub do_ignore { 
    my ($conn, $first, $rest) = @_;
    my ($type, $masks) = split(' ', $rest, 2);
    unless (grep { $type eq $_ } 
	    qw(public msg ctcp notice channel nick other all)) {
	$conn->print(&ircformat('Eignore'));
	return;
    }
    $conn->ignore($type, $masks);
}

sub do_info { 
    my ($conn, $first, $rest) = @_;
    $conn->info($rest);
}

sub do_invite { 
    my ($conn, $first, $rest) = @_;
    my ($target, $more) = &firstword($rest);
    my $tchan;
    if ($more =~ /^[#&]/) {
	($tchan) = &firstword($more);
    } else {
	$tchan = $stuff{'defchannel'};
    }
    $conn->invite($target, $tchan);
}

sub do_ison { 
    my ($conn, $first, $rest) = @_;
    unless ($rest) {
	$conn->print(&ircformat('Eison'));
	return;
    }
    $conn->ison($rest);
}

sub do_kick {
    my ($conn, $first, $rest) = @_;
    my ($channel, $target, $more) = split(' ', $rest, 3);
    unless (grep { $_ eq $channel } @{$stuff{'chanlist'}}) {
	$conn->print(&ircformat('Enotinchannel', $channel));
	return;
    } 
    $conn->kick($channel, $target, $more);
}

sub do_mode { 
    my ($conn, $first, $rest) = @_;
    my ($target, $mode, $args);
    ($target, $mode, $args) = split(' ', $rest, 3);
    $conn->mode($target, $mode, $args);
}

sub do_op {
    my ($conn, $first, $rest) = @_;
    my (@nicks) = split $rest;
    my ($mode, @chunk);
    while (@nicks) {
	@chunk = splice(@nicks, 0, 4);
	$mode = "+" . ("o" x @chunk);
	$conn->mode($stuff{'defchannel'}, $mode, @chunk);
    }
}

sub do_links { 
    my ($conn, $first, $rest) = @_;
    $conn->links(split $rest);		## Connection.pm says to read the RFC.
}

sub do_list { 
    my ($conn, $first, $rest) = @_;
    if ($rest) {
	&do_list_0($conn, $rest);
    } else {
	&confirm($formats{'Clist'}, "y", [\&do_list_0, $conn, $rest]);
    }
}

sub do_list_0 {
    my ($conn, $rest) = @_;
    $conn->list($rest);
}

sub do_lusers { 
    my ($conn, $first, $rest) = @_;
    $conn->lusers($rest);
}

sub do_me { 
    my ($conn, $first, $rest) = @_;
    my $t = &ircformat('action', $conn->nick, $rest);
    my $u = &ircformat('oaction', $conn->nick, $stuff{'defchannel'}, $rest);
    unless ($stuff{'defchannel'}) {
	$conn->print(&ircformat('Eme'));
	return;
    }
    $conn->me($stuff{'defchannel'}, $rest);
    if ($stuff{'echo'}) { $conn->print($t); } 
    if ($stuff{'log'}) { $stuff{'log'}->print(time() . " $u\n"); }
}

sub do_motd {
    my ($conn, $first, $rest) = @_;
    $conn->motd($rest);
}

sub do_nick { 
    my ($conn, $first, $rest) = @_;
    $stuff{'oldnick'} = $conn->nick;
    $conn->nick($rest);
}

sub do_oper { 
    my ($conn, $first, $rest) = @_;
    my (@words) = split(' ', $rest);
    my ($mynick, $operpasswd);
    if (@words < 1) {
	&prompt($formats{'Poper'}, [\&do_oper_0, $conn, $conn->nick]);
    } elsif (@words == 1) {
	$conn->print(&ircformat('Woperpasswd'));
	$operpasswd = $words[0];
	$mynick = $conn->nick;
    } else {
	($mynick, $operpasswd) = @words;
    }
    $conn->oper($mynick, $operpasswd);
}

sub do_oper_0 {
    my ($passwd, $conn, $mynick) = @_;
    $conn->oper($mynick, $passwd);
} 

sub do_leave { 
    my ($conn, $first, $rest) = @_;
    my (@channels) = split(' ', $rest);
    unless (@channels) {
#	$conn->print(&ircformat('Epart'));		## ircII behaviour.
#	return;
	$conn->print(&ircformat('Wpart', $stuff{'chanlist'}->[0]));
	push @channels, $stuff{'chanlist'}->[0];	## Mmm, heuristics.
    }
    my @newchan;
    for my $c (@channels) {
	unless (grep { lc($c) eq lc($_) } @{$stuff{'chanlist'}}) {
	    $conn->print(&ircformat('Enotinchannel', $c));
	}
    }
    $conn->part(@channels);
    for my $c (@channels) {
	@{$stuff{'chanlist'}} = grep { lc($_) ne lc($c) } @{$stuff{'chanlist'}};
    }
    if (@{$stuff{'chanlist'}} == 0) {
	delete $stuff{'defchannel'};
	$conn->print(&ircformat('nochannels'));
    } else {
	&set_channel($stuff{'chanlist'}->[0]);
    }
}

sub do_sconnect { 
    my ($conn, $first, $rest) = @_;
    unless (split(' ', $rest) > 1) {
	$conn->print(&ircformat('Esconnect'));
	return;
    }
    $conn->sconnect($rest);
}

sub do_squit { 
    my ($conn, $first, $rest) = @_;
    my ($server, $comment) = split(' ', $rest, 2);
    unless ($server) {
	my $monster = &pickrandom(@monsters);
	$conn->print(&ircformat('Esquit0', $monster, &pickrandom(@scrolls)));
	$conn->print(&ircformat('Esquit1', $monster));
	return;
    }
    $conn->squit(split $rest);
}

sub do_stats { 
    my ($conn, $first, $rest) = @_;
    my ($statbits, $server) = split(' ', $rest, 2);
    unless ($statbits) {
	$conn->print(&ircformat('Estats'));
	return;
    }
    $conn->stats($statbits, $server);
}

sub do_time { 
    my ($conn, $first, $rest) = @_;
    $conn->time($rest);
}

sub do_topic { 
    my ($conn, $first, $rest) = @_;
    my ($channel, $topic) = split(' ', $rest, 2);
    $conn->topic($channel, $topic);			## no defaults!
}

sub do_trace { 
    my ($conn, $first, $rest) = @_;
    $conn->trace($rest);
}

sub do_userhost { 
    my ($conn, $first, $rest) = @_;
    unless ($rest) {
	$conn->print(&ircformat('Euserhost'));
    }
    $conn->userhost($rest);
}

sub do_users { 
    my ($conn, $first, $rest) = @_;
    $conn->users($rest);
}

sub do_version { 
    my ($conn, $first, $rest) = @_;
    $conn->version($rest);
}

sub do_wallops { 
    my ($conn, $first, $rest) = @_;
    unless ($rest) {
	$conn->print(&ircformat('Ewallops'));
	return;
    }
    $conn->wallops($rest);
}

sub do_who { 
    my ($conn, $first, $rest) = @_;
    $conn->who($rest);
}

sub do_whois { 
    my ($conn, $first, $rest) = @_;
    unless ($rest) {
	$conn->print(&ircformat('Ewhois'));
    }
    $conn->whois($rest);
}

sub do_whowas { 
    my ($conn, $first, $rest) = @_;
    unless ($rest) {
	$conn->print(&ircformat('Ewhowas'));
    }
    $conn->whowas($rest);
}

sub do_say {
    my ($conn, $first, $rest) = @_;
    my $destchan = $stuff{'defchannel'};
    chomp($rest);
    my $t = &ircformat('public', $conn->nick, $rest);
    my $u = &ircformat('ochan', $conn->nick, $destchan, $rest);
    unless ($destchan) {
	$conn->print(&ircformat('Esay'));
	return;
    }
    $conn->privmsg($destchan, $rest);
    if ($stuff{'echo'}) { $conn->print($t); }
    if ($stuff{'log'}) { $stuff{'log'}->print(time() . " $u\n"); }
}

sub do_reverse {
    my ($conn, $first, $rest) = @_;
    my $reversed = scalar reverse($rest);
    &do_say($conn, 'say', $reversed);
}

sub do_key {
    my ($conn, $first, $rest) = @_;
    my ($channel, @other) = split $rest;
    $conn->mode($channel, '+k', @other);
}

sub do_ban {
    my ($conn, $first, $rest) = @_;
    my ($channel, @other) = split $rest;
    $conn->mode($channel, '+b', @other);
}

sub do_unban {
    my ($conn, $first, $rest) = @_;
    my ($channel, @other) = split $rest;
    $conn->mode($channel, '-b', @other);
}

sub do_kickban {
    my ($conn, $first, $rest) = @_;
    my ($channel, @other) = split $rest;
    $conn->kick($channel, @other);
    $conn->mode($channel, '+b', @other);
}

sub do_notice {
    my ($conn, $first, $rest) = @_;
    my ($target, $text) = split(' ', $rest, 2);
    my $t = &ircformat('notice', $target, $text);
    $conn->notice($target, $text);
    if ($stuff{'echo'}) { $conn->print($t); }
    if ($stuff{'log'}) { $stuff{'log'}->print(time() . " $t\n"); }
}

sub do_names {
    my ($conn, $first, $rest) = @_;
    if ($rest) {
	&do_names_0($conn, $rest);
    } else {
	&confirm($formats{'Cnames'}, "y", [\&do_names_0, $conn, $rest]);
    }
}

sub do_names_0 {
    my ($conn, $rest) = @_;
    $conn->names($rest);
}

sub do_channels {
    my ($conn, $first, $rest) = @_;
    if (@{$stuff{'chanlist'}} == 0) {
	&admin_print($conn, "You are empty-handed.");
	return;
    }
    $conn->print(&ircformat('channels', join(' ', @{$stuff{'chanlist'}})));
}

sub do_nothing {
    ## Hey!  Let's do nothing!
}

sub do_join_or_switch {
    my ($conn, $first, $rest) = @_;
    my $channel;
    ($channel = $rest) =~ s/\s.*//;
    if ($channel !~ /^[#&]/) {
	$conn->print(&ircformat('Ebadchannel'));
	return;
    } 
    if (grep { lc($_) eq lc($channel) } @{$stuff{'chanlist'}}) {
	## Already here, eh?
	&set_channel($channel);
	return;
    }
    $conn->print(&ircformat('joining', $channel));
    $conn->join($channel);
}

sub do_quote {
    my ($conn, $first, $rest) = @_;
    $conn->sl($rest);
}

sub do_happyslash {
    my ($conn, $first, $rest) = @_;
    if ($rest) {
	$stuff{'happyslash'} = &get_boolean($rest);
    }
    $conn->print(&ircformat('hsstatus', &print_boolean($stuff{'happyslash'}, "disabled/enabled")));
}

sub do_debug {
    my ($conn, $first, $rest) = @_;
    my $bool;
    if ($rest) {
	$bool = &get_boolean($rest);
	$irc->debug($bool);
	$conn->debug($bool);
	## This should be good enough for now; do we want to modify
	## Net::IRC to recurse through all its Connection objects
	## and turn their debugging on when its debugging is turned
	## on?  It's a touchy-feely preference thingy...
    }
    $conn->print(&ircformat('debugstatus', &print_boolean($irc->debug, "disabled/enabled")));
}

sub do_away {
    my ($conn, $first, $rest) = @_;
    $conn->away($rest);
}

sub do_rehash {
    my ($conn, $first, $rest) = @_;
    $conn->rehash($rest);
}

sub do_restart {
    my ($conn, $first, $rest) = @_;
    $conn->restart;
}

sub do_summon {
    my ($conn, $first, $rest) = @_;
    unless ($rest) {
	$conn->print(&ircformat('Esummon'));
	return;
    }
    $conn->summon($rest);
}

sub do_yoda {
    my ($conn, $first, $rest) = @_;
    &do_say($conn, $first, &yoda_front($rest));
}

sub do_yodamsg {
    my ($conn, $first, $rest) = @_;
    my ($recipient, $text) = split(' ', $rest, 2);
    &do_msg($conn, $first, $recipient . " " . &yoda_front($text));
}	

sub do_pigl {
    my ($conn, $first, $rest) = @_;
    &do_say($conn, $first, &pigl_front($rest));
}

sub do_piglmsg {
    my ($conn, $first, $rest) = @_;
    my ($recipient, $text) = split(' ', $rest, 2);
    &do_msg($conn, $first, $recipient . " " . &pigl_front($text));
}	

sub do_mirror {
    my ($conn, $first, $rest) = @_;
    &do_say($conn, $first, &mirror($rest));
}

sub do_mirrormsg {
    my ($conn, $first, $rest) = @_;
    my ($recipient, $text) = split(' ', $rest, 2);
    &do_msg($conn, $first, $recipient . " " . &mirror($text));
}

sub do_log {
    my ($conn, $first, $rest) = @_;
    my $logfh;
    my $logfn;
    my $bool = &get_boolean($rest);
    my $form = $formats{'logfilename'};
    chomp $form;
    my $logfn = &ircformat($form, time(), $$);
    if ($bool) {
	if ($stuff{'log'}) {
	    $conn->print(&ircformat('Elogging'));
	    return;
	}
	$logfh = new IO::File(">$logfn");
	if ($logfh) {
	    $stuff{'log'} = $logfh;
	    $stuff{'logname'} = $logfn;
	    $stuff{'log'}->autoflush(1);
	    $stuff{'log'}->print(&ircformat('logstarttext', $$, scalar gmtime()) . "\n");
	    $conn->print(&ircformat('logstart0'));
	    $conn->print(&ircformat('logstart1', $logfn));
	} else {
	    $conn->print(&ircformat('Ecantlog', $!));
	}
    } else {
	if ($stuff{'log'}) {
	    $stuff{'log'}->print(&ircformat('logstoptext', $$, scalar gmtime()) . "\n");
	    $stuff{'log'}->close;
	    $conn->print(&ircformat('logstop0'));
	    $conn->print(&ircformat('logstop1', $stuff{'logname'}));
	    delete $stuff{'log'};
	    delete $stuff{'logname'};
	} else {
	    $conn->print(&ircformat('Enotlogging'));
	}
    }
}

1;
