# -*- mode: perl; coding: utf-8 -*-
# Keitairc::IrcCallback
#
# Copyright (c) 2008 Jun Morimoto <morimoto@mrmt.net>
# This program is covered by the GNU General Public License 2

package Keitairc::IrcCallback;
use POE;
use Encode qw(decode);
use strict;
use warnings;

################################################################
sub irc_start{
	my $heap = $_[HEAP];
	$heap->{Irc}->yield(register => 'all');
}

################################################################
sub irc_registered{
	my $heap = $_[HEAP];
	$heap->{Irc}->yield(connect => {});
}

################################################################
sub irc_001{
	my ($kernel, $heap, $sender) = @_[KERNEL, HEAP, SENDER];
	my $ib = $heap->{IrcBuffer};
	my $cf = $heap->{Config};
	my $msg = 'Connected to irc server!';

	if ($cf->show_console()) {
		$ib->add_message($ib->name2cid('*Console*'), $msg);
	} else {
		for my $cid ($ib->channels()) {
			$ib->add_message($cid, $msg);
		}
	}
	$heap->{disconnect_msg} = 1;
	$kernel->delay(autoping => $cf->ping_delay());
}

################################################################
sub irc_public{
	my ($kernel, $heap, $who, $channel, $msg) = @_[KERNEL, HEAP, ARG0 .. ARG2];
	my $ib = $heap->{IrcBuffer};
	my $cf = $heap->{Config};
	$who =~ s/!.*//;
	$msg = decode($cf->irc_charset(), $msg);
	my $cid = $ib->name2cid(decode($cf->irc_charset(), $channel->[0]));
	$heap->{IrcBuffer}->add_message($cid, $msg, $who);
	$heap->{seen_traffic} = 1;
	$heap->{disconnect_msg} = 1;
}

################################################################
sub irc_join{
	my ($kernel, $heap, $who, $channel) = @_[KERNEL, HEAP, ARG0, ARG1];
	my $ib = $heap->{IrcBuffer};
	my $cf = $heap->{Config};

	$who =~ s/!.*//;

	$channel = decode($cf->irc_charset(), $channel);

	# chop off after the gap to workaround madoka's bug
	$channel =~ s/ .*//;

	$ib->join($channel);
	if($who ne $cf->irc_nick() && $cf->show_joinleave()) {
		my $cid = $ib->name2cid($channel);
		if ($cf->show_console()) {
			my $ch = $ib->compact_channel_name($cid);
			$ib->add_message($ib->name2cid('*Console*'),
					 "$who joined to $ch");
		} else {
			$ib->add_message($cid, "$who joined");
		}
	}

	if($cf->follow_nick()){
		$heap->{Irc}->yield(who => $channel);
	}
	$heap->{seen_traffic} = 1;
	$heap->{disconnect_msg} = 1;
}

################################################################
sub irc_part{
	my ($kernel, $heap, $who, $channel) = @_[KERNEL, HEAP, ARG0, ARG1];
	my $ib = $heap->{IrcBuffer};
	my $cf = $heap->{Config};

	$who =~ s/!.*//;

	$channel = decode($cf->irc_charset(), $channel);
	# chop off after the gap (bug workaround of POE::Filter::IRC)
	$channel =~ s/ .*//;

	my $cid = $ib->name2cid($channel);
	if($who eq $cf->irc_nick()){
		$ib->part($cid);
	} elsif ($cf->show_joinleave()) {
		if ($cf->show_console()) {
			my $ch = $ib->compact_channel_name($cid);
			$ib->add_message($ib->name2cid('*Console*'),
					 "$who leaves from $ch");
		} else {
			$ib->add_message($cid, "$who leaves");
		}
	}
	$ib->remove_nick($cid, $who);
	$heap->{seen_traffic} = 1;
	$heap->{disconnect_msg} = 1;
}

################################################################
sub irc_quit{
	my ($kernel, $heap, $who, $message) = @_[KERNEL, HEAP, ARG0, ARG1];
	my $ib = $heap->{IrcBuffer};
	my $cf = $heap->{Config};

	$who =~ s/!.*//;
	$message = decode($cf->irc_charset(), $message);

	for my $cid ($ib->channels()) {
		for my $name ($ib->list_nick($cid)) {
			if($who ne $name) {
				next;
			}
			if($who eq $cf->irc_nick()){
				$ib->part($cid);
			} elsif (!$cf->show_console() &&
				 $cf->show_joinleave()) {
				$ib->add_message($cid,
					"$who leaves from IRC ($message)");
			}
			$ib->remove_nick($cid, $who);
			last;
		}
	}

	if ($cf->show_console() && $cf->show_joinleave()) {
		$ib->add_message($ib->name2cid('*Console*'),
			"$who leaves from IRC ($message)");
	}

	$heap->{seen_traffic} = 1;
	$heap->{disconnect_msg} = 1;
}

################################################################
sub irc_whoreply{
	my ($kernel, $heap, $arg) = @_[KERNEL, HEAP, ARG1];
	my ($channel, $user, $host, $server, $nick, $hg, $hop, @realname) =
		split(/\s/, $arg);
	my $ib = $heap->{IrcBuffer};
	my $cf = $heap->{Config};
	my $op = ($hg =~ /@/ ? 1 : 0);
	my $cid = $ib->name2cid(decode($cf->irc_charset(), $channel));
	# @realname may be irc channel's charset
	$ib->add_nick($cid, $nick, $op, decode($cf->irc_charset(), join(' ', @realname)));
}

################################################################
sub irc_mode{
	my ($kernel, $heap, $from, $channel, $mode, @args) =
		@_[KERNEL, HEAP, ARG0, ARG1, ARG2, ARG3 .. $#_];

	my $ib = $heap->{IrcBuffer};
	my $cf = $heap->{Config};
	my $cid = $ib->name2cid(decode($cf->irc_charset(), $channel));
	if($mode =~ s/^\+//){
		while($mode =~ s/^o//){
			my $nick = shift @args;
			$ib->op_nick($cid, $nick);
		}
	}elsif($mode =~ s/^-//){
		while($mode =~ s/^o//){
			my $nick = shift @args;
			$ib->deop_nick($cid, $nick);
		}
	}
}

################################################################
sub irc_nick{
	my ($kernel, $heap, $who, $nick) = @_[KERNEL, HEAP, ARG0, ARG1];
	my $ib = $heap->{IrcBuffer};
	my $cf = $heap->{Config};

	$who =~ s/!.*//;

	if($who eq $cf->irc_nick()) {
		$cf->irc_nick($nick);
	}

	for my $cid ($ib->channels()) {
		for my $name ($ib->list_nick($cid)) {
			if($who ne $name) {
				next;
			}
			my $realname = $ib->get_nick_realname($cid, $who);
			my $op = $ib->get_nick_op($cid, $who);
			$ib->remove_nick($cid, $who);
			$ib->add_nick($cid, $nick, $op, $realname);

			if (!$cf->show_console() && $cf->show_joinleave()) {
				$ib->add_message($cid, "$who -> $nick");
			}
			last;
		}

	}

	if ($cf->show_console() && $cf->show_joinleave()) {
		$ib->add_message($ib->name2cid('*Console*'), "$who -> $nick");
	}
}

################################################################
sub irc_notice{
	my ($kernel, $heap, $who, $channel, $msg) = @_[KERNEL, HEAP, ARG0 .. ARG2];
	my $ib = $heap->{IrcBuffer};
	my $cf = $heap->{Config};

	$who =~ s/!.*//;
	my $cid = $ib->name2cid(decode($cf->irc_charset(), $channel->[0]));
	$msg = decode($cf->irc_charset(), $msg);

	$ib->add_message($cid, $msg, $who);
	$heap->{seen_traffic} = 1;
	$heap->{disconnect_msg} = 1;
}

################################################################
sub irc_topic{
	my ($kernel, $heap, $who, $channel, $topic) = @_[KERNEL, HEAP, ARG0 .. ARG2];
	my $ib = $heap->{IrcBuffer};
	my $cf = $heap->{Config};
	my $cid = $ib->name2cid(decode($cf->irc_charset(), $channel));
	$topic = decode($cf->irc_charset(), $topic);
	$ib->topic($cid, $topic);
	$who =~ s/!.*//;
	$ib->add_message($cid, "$who set topic: $topic");
	$heap->{seen_traffic} = 1;
	$heap->{disconnect_msg} = 1;
}

################################################################
sub irc_topicraw{
	my ($kernel, $heap, $raw) = @_[KERNEL, HEAP, ARG1];
	my ($channel, $topic) = ($raw =~ m/(\S+)\s+:?(.*)$/);
	my $ib = $heap->{IrcBuffer};
	my $cf = $heap->{Config};
	my $cid = $ib->name2cid(decode($cf->irc_charset(), $channel));
	$ib->topic($cid, decode($cf->irc_charset(), $topic));
	$heap->{seen_traffic} = 1;
	$heap->{disconnect_msg} = 1;
}

################################################################
sub irc_msg{
	my ($kernel, $heap, $who, $channel, $msg) = @_[KERNEL, HEAP, ARG0 .. ARG2];
	my $ib = $heap->{IrcBuffer};
	my $cf = $heap->{Config};
	my $buddy;

	$who =~ s/!.*//;

	if ($who eq $cf->irc_nick()) {
		# XXX: $channel may contain two or more nicks.
		$buddy = $channel->[0];
	} else {
		$buddy = $who;
	}
	$buddy = decode($cf->irc_charset(), $buddy);
	$ib->join($buddy); # XXX: join $buddy if not joined
	my $cid = $ib->name2cid($buddy);
	$msg = decode($cf->irc_charset(), $msg);
	$ib->add_message($cid, $msg, $who);
	$heap->{seen_traffic} = 1;
	$heap->{disconnect_msg} = 1;
}

################################################################
sub irc_ctcp_action{
	my ($kernel, $heap, $who, $channel, $msg) = @_[KERNEL, HEAP, ARG0 .. ARG2];
	my $ib = $heap->{IrcBuffer};
	my $cf = $heap->{Config};

	$who =~ s/!.*//;
	my $cid = $ib->name2cid(decode($cf->irc_charset(), $channel->[0]));
	$msg = decode($cf->irc_charset(), $msg);
	$ib->add_message($cid, sprintf('* %s %s', $who, $msg));
	$heap->{seen_traffic} = 1;
	$heap->{disconnect_msg} = 1;
}

################################################################
sub irc_reconnect{
	my ($kernel, $heap) = @_[KERNEL, HEAP];
	my $ib = $heap->{IrcBuffer};
	my $cf = $heap->{Config};
	my $msg = 'Disconnected from irc server, trying to reconnect...';

	if ($heap->{disconnect_msg}) {
		if ($cf->show_console()) {
			$ib->add_message($ib->name2cid('*Console*'), $msg);
		} else {
			for my $cid ($ib->channels()) {
				$ib->add_message($cid, $msg);
			}
		}
	}
	$heap->{disconnect_msg} = 0;
	$kernel->delay(connect => $cf->reconnect_delay());
}

################################################################
sub irc_connect{
	my ($kernel, $heap) = @_[KERNEL, HEAP];
	$kernel->post(keitairc_irc => connect => {});
}

################################################################
sub irc_autoping{
	my ($kernel, $heap) = @_[KERNEL, HEAP];
	my $cf = $heap->{Config};

	$kernel->post(keitairc_irc => time) unless $heap->{seen_traffic};
	$heap->{seen_traffic} = 0;
	$kernel->delay(autoping => $cf->ping_delay());
}

1;
