# $Id: .sircrc.pl,v 1.58 2015-05-21 13:29:08-04 roderick Exp roderick $

# XXX
#     - bind ^w delete_previous_word
#     - have autoop follow nick changes
#     - have autoop follow drops, otherwise an oppable person can drop
#       and a different one can take their nick

package mypack;

use strict;
use lib qw(/home/roderick/src/pm/sirc/lib /home/roderick/src/sirc);
use sigtrap qw(die untrapped normal-signals);

#------------------------------------------------------------------------------

# Supply dummy definitions for -c testing.
BEGIN {
    eval "
    	sub main::addhook { }
    " unless $::version || $::version;
}

use FileHandle		  ();
use POSIX		qw(mktime strftime);
use Proc::SyncExec	qw(sync_popen_noshell);
use RS::Handy		qw(data_dump plural shuffle);
use Sirc::Autoop	qw(@Autoop %Autovoice);
use Sirc::Chantrack	qw(%Chan_op %Chan_user chantrack_check chantrack_show);
use Sirc::Kick		qw(kbtmp);
use Sirc::LckHash	  ();
use Sirc::LimitMan	  ();
use Sirc::Silent	  ();
use Sirc::Status	  ();
use Sirc::URL		  ();
use Sirc::Util		qw(add_hook addcmd addhook arg_count_error
			    ban_pattern deltimer describe docommand doset
			    have_ops have_ops_q ieq msg newtimer notice
			    optional_channel
			    remhook settable_boolean settable_int sl tell
			    tell_error tell_question timer userhost
			    xgetarg xtell xrestrict);
use Time::HiRes		  ();

require 'tryexec.pl';

use vars qw($Debug $Init_done $Is_efnet $nickserv_nick);

$nickserv_nick ||= 'nickserv';

if (!$Init_done) {
    srand;
    $Debug = 0;
    settable_boolean('rs_debug', \$Debug);

    $::username = $::nick;
    doset 'ircname', $::nick; #"$::nick (finger for commands)";
    #doset 'finger', 'Commands (via /msg or by saying "<mynick>, <command>"): '
    #	    	    	. ' tune';
    doset 'userinfo', '';
    doset 'eight_bit', 'on';
    doset 'url_browser', 'desktop-ssh open %s &';

    docommand '^alias autovoice /reval show \%Autovoice';
    docommand '^alias finger ctcp $0 finger';
    docommand '^alias google /m purl google for';
    docommand '^alias n names';
    docommand '^alias pe /msg #perl';
    docommand '^alias perltopic topic #perl'
    	    	. ' No WWW/CGI/FAQ questions, bold colons, public aways,'
    	    	. ' kewlt0k, u/ne1/plz, or singing.';
    docommand '^alias showdis /reval show \@disconnect';
    docommand '^alias weather /m purl weather kcho';

    @::listenport = (30000..30100);

    @Sirc::Status::Status_element = @Sirc::Status::Status_element_compact;

    $nickserv_nick ||= 'nickserv';
}

#------------------------------------------------------------------------------

# Disable standard bolding.

sub main::tell {
    my $s = shift;
    $s =~ s/^\cb(\*.\*)\cb/$1/;
    $s =~ s/^\*\cb([^E])\cb\*/*$1*/;
    $::silent || main::print($s);
}
*Sirc::Util::tell = \&main::tell;

sub debug {
    xtell 'debug ' . join '', @_
	if $Debug;
}

sub show {
    xtell 'show ' . data_dump @_;
}

sub main::hook_rs_raw {
    xtell "from $::who!$::user\@$::host @_";
}

#sub do_disconnect {
#    xtell "Disconnecting from $::server";
#    close $::S;
#    delete $::buffer{$::S};
#    $::connected = 0;
#    &::dohooks("disconnect");
#}
#
#sub main::sl {
#    no strict 'refs';
#    if (!print $::S $_[0]."\n") {
#	tell_error "Error writing to server: $! ($_[0])";
#	do_disconnect;
#    }
#}
#*Sirc::Util::sl = \&main::sl;

# simple commands and command redefinitions -----------------------------------

sub main::cmd_quit {
    $::args ||= $::nick;
    docommand "/quit $::args";
}
addcmd 'quit';
docommand '^alias bye quit';
docommand '^alias exit quit';
docommand '^alias signoff quit';

sub main::cmd_list {
    optional_channel or return;
    docommand "/list $::args";
}
addcmd 'list';
docommand '^alias l list';

sub main::cmd_names {
    optional_channel or return;
    docommand "/names $::args";
}
addcmd 'names';

sub main::cmd_reload_module {
    my @module = split ' ', $::args;
    if (!@module) {
	tell_question 'No modules specified';
	return;
    }

    for my $module (@module) {
	my $file = $module;
	$file =~ s-::-/-g;
	$file .= '.pm';
	if (!defined do $file) {
	    tell_error "Error loading $module: "
		. ($@ ? $@ : $! ? $! : 'did not return a defined value');
	}
    }
}
addcmd 'reload_module';

# Reverse /msg.

sub main::cmd_rev {
    optional_channel or return;
    my ($channel, $s) = split ' ', $::args, 2;
    msg $channel, reverse $s;
}
addcmd 'rev';

sub main::cmd_think {
    optional_channel or return;
    my ($channel, $s) = split ' ', $::args, 2;
    describe $channel, ". o O ($s)";
}
addcmd 'think';

#sub mode_runner {
#    my (@mode) = @_;
#    unless (@mode <= 4) {
#	tell_error "Too many modes passed to mode_runner (@mode)";
#	return;
#    }
#    my $atonce = int(4 / @mode);
#
#    optional_channel or return;
#    my ($channel, @nick) = split ' ', $::args;
#
#    while (@nick) {
#	my @this = splice @nick, 0, $atonce;
#	my @mode = @mode;
#	my $mode = '';
#	my $dir = '';
#	for (1..$atone) {
#	    $
#	    $mode .=shift @mode;
#	my $dir = $mode =~ /^-/;
#
#	$mode = '';
#	while (@this_nick < 4) {
#	    $mode .= join '', @mode;
#

sub voice {
    my $direction = shift;
    optional_channel or return;
    my ($channel, @nick) = split ' ', $::args;
    while (@nick) {
	my @this = splice @nick, 0, 4;
	docommand  "mode $channel $direction" . 'v' x @this . " @this";
    }
}

sub main::cmd_voice {
    voice '+';
}
addcmd 'voice';

sub main::cmd_devo {
    voice '-';
}
addcmd 'devo';

sub main::cmd_nick {
    my @arg = split ' ', $::args;

    if (@arg != 1) {
	tell_question '/nick takes 1 arg';
	return;
    }
    elsif (length $arg[0] > 9) {
	tell_question 'New nick too long';
	return;
    }
    else {
	sl "nick $arg[0]";
    }
}
addcmd 'nick';

sub now_playing {
    my ($response_to) = @_;
    my ($r);

    if (open TUNE, "$ENV{HOME}/.xmms/now-playing") {
	my $tune = <TUNE>;
	chomp $tune;
	if ($tune ne '') {
	    $r = "Tune spinning:  $tune";
	    my $since = (stat TUNE)[9];
	    if ($since) {
		my $diff = time - $since;
		if ($diff > 60 * 60) {
		    $r .= " (for the last " . elapsed($diff) . ")";
		}
	    }
	}
	close TUNE;
    }

    if (!defined $r) {
	$r = "I can't figure out what's playing.";
    }

    notice $response_to, $r;
}

sub maybe_command_me {
    my ($response_to, $cmd) = @_;

    $cmd =~ s/^\s+//;
    $cmd =~ s/\s*\?*\s*$//;
    $cmd = lc $cmd;

    if ($cmd eq 'help') {
	notice $response_to,
	    qq(Try "/finger $::nick".)
	    . "  PS:  I'm not actually a bot, it's just a souped-up sirc."
    }
    elsif ($cmd eq 'tune') {
	now_playing $response_to;
    }
    else {
	return;
    }

    if ((!ieq($::who, $::nick) || !ieq($response_to, $::nick))
	    && open CMD_LOG, ">>$ENV{HOME}/.sirc.cmdlog") {
	printf CMD_LOG "%s from %-9s to %-9s %s\n",
	    strftime('%Y-%m-%d %H:%M:%S', localtime),
	    $::who, $response_to, $cmd;
	close CMD_LOG;
    }
}

sub main::hook_rs_command_me_public {
    my ($channel, $msg) = @_;

    $msg =~ s/^\s*\Q$::nick\E[,:;\s]+//i
	or return;
    maybe_command_me $channel, $msg;
}
addhook 'public', 'rs_command_me_public';

sub main::hook_rs_command_me_msg {
    my ($msg) = @_;
    maybe_command_me $::who, $msg;
}
addhook 'msg', 'rs_command_me_msg';

sub blah {
    my $fmt = shift;
    $::args =~ /\S/ || optional_channel || return;
    my @arg = split ' ', $::args;
    unless (@arg == 1) {
	tell_question "0 or 1 args expected, got [$::args]";
	return;
    }
    my ($channel) = @arg;

    my $word = `word`;
    if ($? || $word !~ /\S/) {
	tell_error "Can't get word (return $?)";
	return;
    }
    chomp $word;
    describe $channel, sprintf $fmt, ucfirst $word;
}

for ([blah => 'exclaims, "%s!"'],
    	['blah?' => 'asks, "%s?"'],
    	['blah.' => 'states, "%s."'],
    	['blah!' => 'screams, "%s!!!"']) {
    my ($name, $fmt) = @$_;
    no strict 'refs';
    *{ "main::cmd_$name" } = sub { blah $fmt, @_ };
    addcmd $name;
}

sub rot13 {
    local $_ = shift;
    tr/a-zA-Z/n-za-mN-ZA-M/;
    return $_;
}

sub main::cmd_rot13 {
    tell "rot13: ", rot13 $::args;
}
addcmd 'rot13';

# main::print() enhancements --------------------------------------------------

use vars qw($do_nohighlight $do_timestamp
	    $do_silentstamp $silentstamp_timer
	    $old_print);

unless ($Init_done) {
    settable_boolean 'rs_nohighlight',		\$do_nohighlight;
    settable_boolean 'rs_timestamp',		\$do_timestamp;
    settable_int 'rs_silentstamp', \$do_silentstamp, sub { $_[1] >= 0 };
}

BEGIN {
    $old_print = \&main::print;
}

sub main::print {
    if ($do_silentstamp) {
	my $s = localtime;
	timer $do_silentstamp, sub {
	    local $do_silentstamp = 0;
	    xtell $s;
	}, $silentstamp_timer ||= newtimer;
    }
    my @arg = @_;
    $arg[0] =~ s/\cC\d{0,2}(,\d{1,2})?//g;
    $arg[0] = sprintf "%02d:%02d:%02d %s", (localtime)[2,1,0], $arg[0]
	if $do_timestamp;
    $arg[0] =~ tr/\cB\cV\037//d
	if $do_nohighlight;

    return $old_print->(@arg);
}

use vars qw($Log_format $Log_rotate_timer);
$Log_format = "sirc.%Y-%m-%d.log" unless $Init_done;

sub log_rotate {
    $::logfile = strftime $Log_format, localtime;

    my $dir = '';
    my @part = split /\//, $::logfile;
    pop @part;
    for (@part) {
	$dir .= '/' . $_;
	unless (mkdir($dir, 0777) || $! == POSIX::EEXIST()) {
	    tell_error "Not rotating log, can't mkdir $dir ($!)";
	    return;
	}
    }

    docommand "set log on";
    my @then = localtime;
    @then[0..2] = (15, 0, 0);
    $then[3]++;
    my $then = mktime @then;
    timer $then - time, \&log_rotate, $Log_rotate_timer ||= newtimer;
    debug "new log file $::logfile, next change at ", scalar localtime $then;
}

# various kinds of audible signals --------------------------------------------

use vars qw($beep $beep_fh);

if (!$Init_done) {
    $beep = 0;
    settable_boolean 'rs_beep', \$beep;
}

sub beep {
    my ($type) = @_;

    return unless $beep;

    my $dir = '/usr/local/share/sound';
    my $file = $type > 1
		? 'quake/enforcer-sight3.wav'
		: 'quake/items-r_item2.wav';
    system "desktop-sound \Q$dir/$file\E";
    return if $? == 0;

    if (!$beep_fh) {
	unless (open BEEP_TTY, '>/dev/tty') {
	    tell_error "Disabling beeping, can't open /dev/tty ($!)";
	    doset 'rs_beep', 'off';
	    return;
	}
	my $old = select BEEP_TTY;
	$| = 1;
	select $old;
	$beep_fh = 1;
    }
    unless (print BEEP_TTY "\a") {
	tell_error "Disabling beeping, can't write to /dev/tty ($!)";
	doset 'rs_beep', 'off';
    }
}

BEGIN {
    *bell = \&beep;
}

# message logging -------------------------------------------------------------

use vars qw($msg_log_active @msg $msg_file $msg_opened);

sub log_msg_ignore {
    my ($who, $msg) = @_;

    return 1 if ieq($who, $::nick)
		    # infobots
		    || ieq($who, 'a')
		    || ieq($who, 'b')
		    || ieq($who, 'bot')
		    || ieq($who, 'chanserv')
		    || ieq($who, 'cpan')
		    || ieq($who, 'i-bot')
		    || ieq($who, 'laotse')
		    || ieq($who, $nickserv_nick)
		    || ieq($who, 'purl')
		    || ieq($who, 'Henzell') # ##crawl bot
		    || ieq($who, 'Gretell') # ##crawl bot
		    || ieq($who, 'Sequell') # ##crawl bot
}

sub log_msg {
    my ($dir, $who, $msg) = @_;

    return if !$msg_log_active;
    return if log_msg_ignore $who, $msg;

    my $s = sprintf "%s %s %-9s %s\n",
		strftime('%Y-%m-%d %H:%M:%S', localtime),
		$dir, $who, $msg;
    push @msg, $s;
    main::dostatus;

    if (!$msg_opened) {
	if (open MSG, ">>$msg_file") {
	    $msg_opened = 1;
	    my $old = select MSG;
	    $| = 1;
	    select $old;
	}
	else {
	    tell_error "Disabling message logging, can't append to $msg_file ($!)";
	    $msg_opened = -1;
	}
    }

    return if $msg_opened < 0;

    unless (print MSG $s) {
	tell_error "Error writing to $msg_file ($!)";
	close MSG;
	$msg_opened = undef;
    }
}

sub main::hook_rs_msglog_send {
    my ($who, $msg) = @_;
    log_msg '>', $who, $msg unless $who =~ /^[#&]/;
}

sub main::hook_rs_msglog {
    my ($msg) = @_;
    log_msg '<', $::who, $msg;
}

sub main::hook_rs_msglog_status {
    $_[0] .= " " . (0+@msg) . " message" . plural 0+@msg
	if @msg;
}

if (!$Init_done) {
    $msg_log_active = 1;
    $msg_file = "$ENV{HOME}/.sirc.msglog";
    addhook 'send_text', 'rs_msglog_send';
    addhook 'msg', 'rs_msglog';
    addhook 'status', 'rs_msglog_status';
    docommand '^alias msgdel /reval @msg = (); main::dostatus';
    docommand '^alias msgshow /reval xtell "message log:"; print @msg';
}

# talk private messages and public ones which mention my name -----------------

use vars qw($festival $do_festival);

if (!$Init_done) {
    $do_festival = 0;
    settable_boolean 'rs_talk', \$do_festival;
}

sub say {
    my ($type, $s) = @_;

    return unless $do_festival;
    beep $type;
    return;

    unless (defined $festival) {
	require Festival::Client;
	unless ($festival = Festival::Client->new) {
	    tell_error "Error running festival: $!";
	    $festival = '';
	}
    }

    if ($festival) {
	local $SIG{PIPE} = 'IGNORE';
	local $SIG{__WARN__} = sub {
	    warn $_[0] unless $_[0] =~ /^Error writing to festival server:/;
	};
	if (!$festival->say($s)) {
	    #tell_error "Error writing to festival: $!";
	    # Try to restart and say it again.
	    undef $festival;
	    say($s);
	}
    }
}

sub maybe_say {
    my $s = shift;
    say 1, $s if $s =~ /roderick|\brod\b|\broder\b/i;
}

sub main::hook_rs_speak_msg {
    my ($msg) = @_;
    say 2, $msg unless log_msg_ignore($::who, $msg) || $msg =~ /^\s*autovoice\b/i;
}
addhook 'msg', 'rs_speak_msg';

sub main::hook_rs_speak_public {
    my ($channel, $msg) = @_;
    maybe_say $msg;
}
addhook 'public', 'rs_speak_public';

sub main::hook_rs_speak_action {
    my ($dest, $action) = @_;
    maybe_say "$::who $action";
}
addhook 'action', 'rs_speak_action';

# slightly improved /ignoring -------------------------------------------------

# The standard one isn't case insensitive!
BEGIN { undef &main::ignored }
sub main::ignored {
  foreach (@::ignore) {
    return 1 if $_[0] =~ /^${_}$/i;
  }
  return '';
}

# This /ignore supplies a pattern if you use a nick.  XXX add escape mechanism

sub main::cmd_ignore {
    my $spec = xgetarg;
    if ($spec ne '' && $spec ne '-' && $spec !~ /[!@]/) {
	my $remove = $spec =~ s/^-// ? '-' : '';
	userhost $spec, sub {
	    my $pat = ban_pattern $::who, $::user, $::host;
	    docommand "/ignore $remove$pat";
	}, sub {
	    docommand "/ignore $remove$spec";
	}
    }
    else {
	docommand "/ignore $spec";
    }
}
addcmd 'ignore';
docommand '^alias ig ignore' if !$Init_done;

# This can't hook msg because that never runs for ignored messages.

my $ignore_notice_verbose;
if (!$Init_done) {
    $ignore_notice_verbose = 1;
    settable_boolean 'rs_ignore_notice_verbose', \$ignore_notice_verbose;
}

sub main::hook_rs_send_ignore_notice {
    my $cmd = shift;
    return unless $cmd eq 'PRIVMSG';
    my ($dest, $rest) = split ' ', shift, 2;
    return unless ieq $dest, $::nick;
    #return if $rest =~ /^:\001/;	# don't send for CTCP
    return unless main::ignored "$::who!$::user\@$::host";
    xtell "ignored: $::who!$::user\@$::host $rest"
	if $ignore_notice_verbose;
    sl "NOTICE $::who :You are being ignored.";
}
addhook 'raw_irc', 'rs_send_ignore_notice';

# kick people who send public auto-away messages ------------------------------

use vars qw($debug_autoaway_kick %autoaway_kick_watch);
$debug_autoaway_kick = 0;

sub debug_autoaway_kick {
    xtell 'aak ' . join '', @_
	if $debug_autoaway_kick;
}

sub main::hook_rs_autoaway_kick_watch {
    my ($nick, $channel, $text) = @_;

    debug_autoaway_kick "seeing kick of $nick on $channel";
    $nick = lc $nick;
    $channel = lc $channel;
    $autoaway_kick_watch{$channel}{$nick} = 1
	if exists $autoaway_kick_watch{$channel}{$nick};
}
addhook 'kick', 'rs_autoaway_kick_watch';

sub detect_autoaway {
    my ($nick, $channel, $text) = @_;

    return unless $Chan_op{$channel}{$::nick};
    return if $Chan_op{$channel}{$nick};
    return unless $Is_efnet && lc($channel) eq '#perl';

    return if $text !~ /\b((auto.?)?(away|gone|dead))\b/i;
    return if !defined $2
	    	&& $text !~ /\b(
				auto(.?away|ma[tg]ic(ally)?)?
			       |idle
			       |inactiv(e|ity)
    	    	    	    )\b/xi;
    return if $text =~ /\b(not|non|isn.?t)\b/i;	# "not automatic"

    if (exists $autoaway_kick_watch{lc $channel}{lc $nick}) {
	debug_autoaway_kick "skipping delayed kick for $nick on $channel";
    }
    else {
	debug_autoaway_kick "scheduling delayed kick for $nick on $channel";
	$autoaway_kick_watch{lc $channel}{lc $nick} = 0;
	timer 30, sub {
	    if (delete $autoaway_kick_watch{lc $channel}{lc $nick}) {
		debug_autoaway_kick "skipping kick of $nick on $channel";
	    }
	    else {
		kbtmp $channel, $nick, "Please disable your public auto-away.";
		notice $nick,
		    'The ban is temporary, to thwart an auto-rejoin.'
		    . '  You can rejoin the channel in 10 seconds.'
    	    	    . '  To disable Bitchx\'s public away, put'
		    . ' "/set send_away off" in your ~/.bitchxrc.'
	    }
	};
    }
}

sub main::hook_rs_autoaway_action {
    my ($dest, $action) = @_;
    detect_autoaway $::who, $dest, $action if 1;
}
addhook 'action', 'rs_autoaway_action';

# kick for auto-rejoin --------------------------------------------------------

use vars qw($autorejoin_kick_debug
	    $autorejoin_kick
	    $autorejoin_kick_threshold
    	    $autorejoin_kick_clean_interval
	    %autorejoin_kick_time
    	    %autorejoin_kick_channel);

if (!$Init_done) {
    $autorejoin_kick_debug		= 0;
    $autorejoin_kick			= 0;
    $autorejoin_kick_threshold		= 0.75;
    $autorejoin_kick_clean_interval	= $autorejoin_kick_debug ? 15 : 300;
    tie %autorejoin_kick_time, 'Sirc::LckHash';
    tie %autorejoin_kick_channel, 'Sirc::LckHash';

    settable_boolean 'rs_autorejoin_kick_debug', \$autorejoin_kick_debug;
    settable_boolean 'rs_autorejoin_kick', \$autorejoin_kick;
    settable_int
	'rs_autorejoin_kick_threshold',
	\$autorejoin_kick_threshold,
    	sub { $_[1] > 0 };
}

sub debug_autorejoin_kick {
    xtell 'ark ' . join '', @_
	if $autorejoin_kick_debug;
}

sub main::hook_rs_autorejoin_kick_kick {
    my ($nick, $channel, $text) = @_;
    return unless $autorejoin_kick_channel{$channel};
    return unless $Chan_op{$channel}{$::nick};
    my $now = Time::HiRes::time;
    $autorejoin_kick_time{"$channel $nick"} = $now;
    debug_autorejoin_kick "kick of $nick on $channel at $now";
}
addhook 'kick', 'rs_autorejoin_kick_kick';

sub main::hook_rs_autorejoin_kick_join {
    return unless $autorejoin_kick;
    my $channel = shift;
    return unless $autorejoin_kick_channel{$channel};
    return unless $Chan_op{$channel}{$::nick};
    my $nick = $::who;
    my $kick_time = $autorejoin_kick_time{"$channel $nick"};
    return unless $kick_time;
    my $now = Time::HiRes::time;
    my $diff = $now - $kick_time;
    debug_autorejoin_kick "join of $nick at $now (diff $diff)";
    return if $diff > $autorejoin_kick_threshold;
    kbtmp $channel, $nick, '10 second ban to thwart auto-rejoin';
}
addhook 'join', 'rs_autorejoin_kick_join';

sub autorejoin_clean {
    timer $autorejoin_kick_clean_interval, \&autorejoin_clean;
    my $keep_time = Time::HiRes::time - $autorejoin_kick_threshold * 100;
    my @old = grep { $autorejoin_kick_time{$_} < $keep_time }
    	    	keys %autorejoin_kick_time;
    return unless @old;
    debug_autorejoin_kick "cleaning @old";
    delete @autorejoin_kick_time{@old};
}
autorejoin_clean;

# For testing only, really!

sub main::hook_rs_autorejoin {
    my ($nick, $channel, $text) = @_;
    return unless lc($nick) eq lc($::nick);
    sl "join $channel";
}

# re-take an in-use nick ------------------------------------------------------

my $retake_nick;
my $retake_nick_time = 60;
my $retake_nick_timer;

sub main::hook_rs_retake_nick_taken {
    my $curnick = xgetarg;
    my $badnick = xgetarg;
    $::skip = 1 if defined($retake_nick) && $badnick eq $retake_nick;
}
addhook '433', 'rs_retake_nick_taken';

sub retake_nick {
    $retake_nick = shift if @_;
    if ($retake_nick eq '' || $::nick eq $retake_nick) {
	$retake_nick = undef;
	return;
    }
    sl "NICK $retake_nick";
    timer $retake_nick_time, \&retake_nick, $retake_nick_timer ||= newtimer;
}

sub main::cmd_retake_nick {
    retake_nick $::args;
}
addcmd 'retake_nick';

sub main::hook_retake_purl_msg {
    notice $::who,
	"I am not purl, I am squatting on the name until she shows up.";
}

sub main::cmd_retake_purl {
    $beep = 0;
    $msg_log_active = 0;
    retake_nick 'purl';
    addhook 'msg', 'retake_purl_msg';
}
addcmd 'retake_purl';

# LIZ_PHAIR++ spam ------------------------------------------------------------

sub elapsed {
    my $s = shift;
    my ($m, $i);

    die if $s < 0;
    return '0 seconds' if $s == 0;
    for ([60*60*24, 'day'], [60*60, 'hour'], [60, 'minute'], [1, 'second']) {
	my ($secs, $name) = @$_;
	my $i = int($s / $secs);
	if ($i) {
	    $s -= $i * $secs;
	    $m .= sprintf ", %d %s%s", $i, $name, plural $i;
	}
    }
    return substr $m, 2;
}

use vars qw($do_phair $phair_file $phair_threshold);
if (!$Init_done) {
    $phair_file = "$ENV{HOME}/.sirc.phair";
    $phair_threshold = 60*60*24*1;
    $do_phair = 0;
    settable_boolean 'rs_phair', \$do_phair;
}

sub main::hook_rs_phair {
    return unless $do_phair;
    my $cmd = shift;
    return unless $cmd eq 'PRIVMSG';
    my ($dest, $msg) = split ' ', shift, 2;
    return if ieq $dest, $::nick;
    return unless $msg =~ /\bLiz[\s_]*Phair\s*\)?\s*\+\+/i;
    my $now = time;
    debug "seeing phair at $now";
    if (open PHAIR, "+<$phair_file") {
	my $last = <PHAIR>;
	chomp $last;
	if ($last > 0) {
	    my $w = $::who;
	    $w = 'skrewtape' if ieq $w, 'purl';
	    my $diff = $now - $last;
	    debug "phair difference $diff (" . elapsed($diff) . ")";
	    if ($diff < $phair_threshold) {
		msg $dest, "$w-- " . elapsed($diff)
		    . " since last increment, show some restraint!";
	    }
	    elsif (0) {
		msg $dest,
		    "$w++ " . elapsed($diff) . " since last increment";
	    }
	}
	unless (seek(PHAIR, 0, 0) && truncate(PHAIR, 0)) {
	    tell_error "can't rewind/truncate $phair_file: $!";
	    close PHAIR;
	    return;
	}
    }
    elsif (!open PHAIR, ">$phair_file") {
	tell_error "can't write to $phair_file: $!";
	return;
    }
    print PHAIR "$now\n"	or tell_error "can't print to $phair_file: $!";
    close PHAIR			or tell_error "error closing $phair_file: $!";
}
addhook 'raw_irc', 'rs_phair';

# op me via an Eggdrop --------------------------------------------------------

# This is controlled via %autoop_self.  Its keys are channels, values are
# references to arrays of references of arrays of (bot, userhost_pattern,
# password) tuples.  Eg:
#
#    %autoop_self = (
#        '#perl' => [
#	    ['rookery',  '^rookery@fishing.w3works.com$', $pw],
#	    ['sanguine', '^sanguine@adsl-.*.bellatlantic.net$', $pw],
#    	 ],
#    );

use vars qw(%autoop_self);

if (!$Init_done) {
    tie %autoop_self, 'Sirc::LckHash';
}

# Try to autoop me on $CHANNEL.

sub try_autoop_self {
    my ($c, $r) = @_;
    my ($bot, $uh_pat, $password, $real_nick) = @$r;

    if ($Chan_op{$c}{$::nick} ) {
	debug "skipping $c/$bot op, already opped";
    }
    elsif (!$Chan_user{$c}{$bot}) {
	debug "skipping $c/$bot op, bot not present";
    }
    elsif (!$Chan_op{$c}{$bot}) {
	debug "skipping $c/$bot op, bot not opped";
    }
    else {
	userhost $bot, sub {
	    if ("$::user\@$::host" !~ /$uh_pat/) {
		tell_error "userhost for bot $bot ($::user\@$::host)"
			    . " doesn't match pattern ($uh_pat)";
	    }
	    else {
		debug "requesting op from $bot";
		local $msg_log_active = 0;
		# ident every time since I use TOR
		msg $bot, "ident $password $real_nick"
		    if defined $real_nick;
		msg $bot, "op $password";
	    }
	};
    }
}

sub autoop_self {
    if (@_ != 2) {
	tell_question "0 or 1 args expected, got [$::args]";
	return;
    }
    my ($c, $nick) = @_;
    return if $Chan_op{$c}{$::nick};
    return unless $autoop_self{$c};
    for my $r (@{ $autoop_self{$c} }) {
	next unless ieq $nick, $r->[0];
	debug "will try to autoop on $c via $nick";
	timer 5, sub { try_autoop_self $c, $r };
    }
}

# Op myself when the bot gets opped.  I used to try to op myself when I
# joined, too, but +op runs in that case.

add_hook '+op', \&autoop_self;

sub main::cmd_autoop_self {
    optional_channel or return;
    my ($channel, @nick) = split ' ', $::args;
    if (!@nick) {
    	my $rl = $autoop_self{$channel};
	@nick = map { $_->[0] } @$rl if $rl;
	if (!@nick) {
	    tell_question "no bots known on $channel";
	    return;
	}
    }
    debug "try autoop on $channel with bots: @nick";
    autoop_self $channel, $_ for @nick;
}
addcmd 'autoop_self';

# reconnect when disconnected -------------------------------------------------

use vars qw(@server_list @disconnect $connect_time);

$connect_time = 0 if !$Init_done;

{
my $reconnect_active = 0;
sub reconnect {
    return if $reconnect_active;
    $reconnect_active = 1;

    push @disconnect, "from $::server at " . localtime;
    unshift @server_list, $::server0
	unless grep { lc($_) eq lc($::server0) } @server_list;

    # Always start at the beginning to get preferred servers when
    # possible.
    my @s = @server_list;

    # If I connected then disconnect right away, though (full server or
    # the like), start with the next server.
    if (time - $connect_time < 15) {
	for (my $i = 0; $i < $#s; $i++) {
	    if ($s[$i] eq $::server) {
		push @s, splice @s, 0, 1+$i;
		last;
	    }
	}
    }

    xtell "Looping through servers: @s";
    while (!$::connected) {
	for (@s) {
	    docommand "server $_";
	    if ($::connected) {
		$connect_time = time;
		last;
	    }
	}
    }

    $reconnect_active = 0;
} }

sub main::hook_rs_disconnect {
    reconnect;
}
addhook 'disconnect', 'rs_disconnect';

# Sometimes you'll get disconnected and reconnect before the network
# realizes you're gone, so your old self will be there taking your nick.
# That causes sirc to do a blocking prompt, which prevents the reconnect
# from going through, so I choose a semi-random nick instead.

{

my $orig_nick;
use vars qw(%nick_pref);
%nick_pref = (
    roderick	=> 'rs',
    rs		=> 'ROSCH',
);

sub main::hook_rs_nick_taken {
    return if $::connected > 1;
    my $bad = $::nick;
    $orig_nick = $bad if !defined $orig_nick;
    if (exists $nick_pref{lc $bad}) {
	$::nick = $nick_pref{lc $bad}
    }
    else {
	$::nick = $orig_nick;
	chop $::nick while length $::nick > 7;
	$::nick .= '-' . ('A' .. 'Z')[rand 26];
    }
    xtell "Nick `$bad' already taken, trying `$::nick'";
    sl "NICK $::nick";
    main::dostatus();
    docommand "retake_nick $orig_nick";
    $::skip = 1;
}

}
addhook '433', 'rs_nick_taken';

sub from_server_desc {
    $::who eq $::myserver ? '' : " (from $::who)";
}

sub main::hook_rs_cannot_join_channel {
    my $nick = xgetarg;
    my $channel = xgetarg;
    $::args =~ s/^://;

    $::skip = 1;
    tell_question "Can't join $channel: $::args" . from_server_desc
		    . " (rejoin queued)";

    timer 60, sub {
	docommand "join $channel" if !$Chan_user{$channel};
    };
}
addhook '437', 'rs_cannot_join_channel'; # "Nick/channel is temp. unavailable"
addhook '471', 'rs_cannot_join_channel'; # channel full
# XXX You need a way to kill an existing rejoin.  When you have it you
# can add these:
#addhook '473', 'rs_cannot_join_channel'; # invite-only
#addhook '474', 'rs_cannot_join_channel'; # banned
#addhook '475', 'rs_cannot_join_channel'; # key

# I might lose my connection but not notice it.  Watch for server
# messages.  If none come for a long time, send something to the
# server.
#
# This used to be all I needed, as the TCP socket would break.  When
# using TOR this isn't always the case, so if there's still nothing from
# the server after a while, disconnect.

{

my $last_receive		= time;
my $last_receive_interval	= 60;
my $last_receive_timeout	= 60 * 2;
my $last_receive_break		= 60 * 10;

sub main::hook_rs_last_receive {
    $last_receive = time;
}
addhook 'raw_irc', 'rs_last_receive';

sub main::hook_rs_ignore_time {
    debug 'ignoring time response';
    remhook '391', 'rs_ignore_time';
    $::skip = 1;
}

sub test_last_receive {
    my $s = time - $last_receive;
    if (!$::connected) {
	debug "test_last_receive $s not connected";
	reconnect;
    }
    elsif ($s > $last_receive_break) {
	tell_error "No data from server in $s seconds, disconnecting";
	docommand "disconnect";
    }
    elsif ($s > $last_receive_timeout) {
	debug "test_last_receive $s sending TIME";
	addhook '391', 'rs_ignore_time';
	timer 15, sub { remhook '391', 'rs_ignore_time' };
	sl 'TIME';
    }
    timer $last_receive_interval, \&test_last_receive;
}
timer $last_receive_interval, \&test_last_receive;

}

# Set nick but only if it's currently the default.

sub config_nick {
    my ($nick) = @_;

    $::nick = $nick
	if $::nick eq ($ENV{SIRCNICK} || $ENV{IRCNICK} || $ENV{LOGNAME});
}

sub config_anonymous {
    my ($nick) = @_;

    config_nick $nick;
    %nick_pref = ();
    doset 'ircname', $::nick;
    $::username = $::nick;
}

#------------------------------------------------------------------------------

# Work around sirc bug which causes it not to send all the /userhosts on
# join (or something) by sending other data to help flush them through.

use vars qw($send_notices_count $send_notices_timer);

sub send_notices {
    notice $::nick, ++$send_notices_count;
    timer 4, \&send_notices, $send_notices_timer;
}

sub main::cmd_send_notices {
    if ($send_notices_count) {
	xtell "Disabling notice send";
	$send_notices_count = 0;
	deltimer $send_notices_timer;
    }
    else {
	$send_notices_timer = newtimer;
	send_notices;
    }
}
addcmd 'send_notices';

# remaining initializations ---------------------------------------------------

use vars qw(@auto_join $nickserv_pw);

# XXX Isn't there a better way to do this than hooking into motd?
# ircii provides /on connect.

sub main::hook_rs_motd {
    docommand "mode $::nick +i";
    if (defined $nickserv_pw) {
        msg $nickserv_nick, "identify $nickserv_pw";
        # let nickserv authenticate before auto-joining
        # XXX should do this based on the return notice
        sleep 3 if @auto_join;
    }
    for (@auto_join) {
	docommand "join $_"
	    if $::nick !~ /^xxx/i;
    }
}
addhook '376', 'rs_motd';

if (!$Init_done) {
    use vars qw(@efnet_ignore);
    do '.sircrc.pw';
    tell_error "error reading .sircrc.pw: $@"
	if $@;

    doset 'rs_nohighlight',	'on';
    doset 'rs_silentstamp',	300;

    $::server = undef
	if $::server eq 'irc.primenet.com' || $::server eq 'irc.debian.org';

    if ($::server =~ /\.(freenode\.\w+|openprojects\.net|debian\.org)$/i) {
    	config_freenode();
	# daily logs
	$Log_format = "$ENV{HOME}/tmp/log/freenode/%Y/%Y-%m-%d.log";
	log_rotate;
    }

    if ($::server =~ /\.dapcentral\.org$/i) {
	config_dapcentral();
    }

    elsif ($::server =~ /^jones(\.argon\.org)?$/i && $::port == 6668) {
	@auto_join = ('#mis');
    }

    elsif ($::server =~ /^(jones(\.argon\.org)?|localhost)$/i) {
	@auto_join = ('#infobot');
	doset 'silent', 'off';
    }

    elsif ($::server =~ /\.dal\.net$/i) {
    	config_dalnet();
    }

    elsif (ieq($::server, 'irc.infobot.org')
	   || ieq($::server, 'irc.perl.org')
	   || ieq($::server, 'irc.rhizomatic.net')
	   || ieq($::server, 'irc.grou.ch')
	   || ieq($::server, 'rhizo.mati.ca')) {
	config_magnet();
    }

    elsif ($::server =~ /\.esper\.net$/i) {
    	config_esper();
    }

    elsif (defined $::server) {
    	config_anonymous $::nick;
    }

    else {
	$Is_efnet = 1;
	$autorejoin_kick_channel{'#perl'} = 1;
	@auto_join = ('#poe', '#pound-perl.pm', '#perl');
	docommand "limitman #perl";
	@server_list = shuffle qw(
	    irc.easynews.com
	    irc.choopa.net
    	    irc.mindspring.com
	    irc.servercentral.net
	    irc.blackened.com
	    irc.mzima.net
	    irc.blessed.net
	    irc.nac.net
	    irc.dks.ca
	);
	# needs ident:
	    # irc.easynews.com
	    # irc.choopa.net
	# didn't work with tor:
    	    # irc.mindspring.com
	    # irc.servercentral.net
	    # irc.blackened.com
	    # irc.mzima.net
	    # irc.blessed.net
	    # irc.nac.net
	    # irc.dks.ca
	    # irc.kagmir.ca
	    # irc.igs.ca
	    # irc.he.net
	    # irc.colosolutions.net
	# old:
	    # irc.arcti.ca
	    # irc.mpls.ca
	    # irc.aloha.net
	    # irc.vrfx.com
	    # irc.qeast.net
	    # irc.arcti.ca
	    # irc.colorado.edu
	    # irc.east.gblx.net
	    # irc.west.gblx.net
	    # irc.carrier1.net.uk
	    # irc.rt.ru
	    # irc.etsmtl.ca
	    # irc.lightning.net	no connection
	    # irc.prison.net	no idlers

	push @::ignore, @efnet_ignore;
	$::server0 = $::server = $server_list[0];

	# daily logs
	$Log_format = "$ENV{HOME}/tmp/log/efnet/%Y/%Y-%m-%d.log";
	log_rotate;

	# current participants and their delays:
	#      2 me
	#      6 a-mused
	#	   8 Masque
	#     12 petey
	#     15 Fletch_
	#
	# config for new people:
	#     use Sirc::Autoop qw(%Autovoice);
	#     $Autovoice{'#perl'} = undef;
	#     doset 'autovoice_delay', <number>;
	$Autovoice{'#perl'} = undef;
	doset 'autovoice_delay', 2;
    }
}

#------------------------------------------------------------------------------

# Put this last so it can see all lexicals.  XXX There's a bug in Perl
# which prevents this from actually seeing the lexicals, so I've mostly
# switched to using globals instead.

sub main::cmd_reval {
    debug "reval $::args";
    return if xrestrict;
    eval $::args;
    if ($@) {
	chomp $@;
	tell_error "eval error: $@";
    }
}
addcmd 'reval';

$Init_done = 1;

#------------------------------------------------------------------------------