package IRCApp;
# TODO: настроить в логгировании loglevel, всякие [ERRO] [WARN] [INFO] итд
# общие модули - синтаксис, кодировки итд
use 5.018;
use strict;
use warnings;
use utf8;
use open qw (:std :utf8);

# модули для работы приложения
use Date::Format::ISO8601 qw (gmtime_to_iso8601_datetime);
use Log::Any qw ($log);
use Mojo::Redis;
use Mojo::IOLoop;
use Mojo::IRC;
use Data::Dumper;

use Conf qw (LoadConf);

use version; our $VERSION = qw (1.0);
use Exporter qw (import);
our @EXPORT_OK = qw (RunIRCApp);

my $c = LoadConf ();
my $identified = 0;

# основной парсер
my $parse_redis_message = sub {
	my $self = shift;
	my $m = shift;
	my $answer = $m;
	my $send_to = $answer->{from};

	$self->json ($send_to)->notify (
		$send_to => {
			from    => $answer->{from},
			userid  => $answer->{userid},
			chatid  => $answer->{chatid},
			plugin  => $answer->{plugin},
			message => $answer->{message}
		}
	);

	return;
};

my $on_irc_privmsg = sub {
	my $self = shift;
	my $m = shift;
	
	my $reply;

	if (substr ($text, 1, 3) eq 'rum' || substr ($text, 1, 3) eq 'ром') {
		my $target;

		if ((length ($text) > 5)) {
			$target = trim (substr $text, 5);
		}

		if (! defined $target || ($target eq '')) {
			$target = $chattername;
		}

		$reply = 'притаскивает на подносе стопку рома для ' . $target . ', края стопки искрятся кристаллами соли.';
		$bot->send_long_message ('utf8', 0, "PRIVMSG\001ACTION", $chatid, $reply);
		return;
	} elsif (substr ($text, 1, 5) eq 'vodka' || substr ($text, 1, 5) eq 'водка') {
		my $target;

		if ((length ($text) > 7)) {
			$target = trim (substr $text, 7);
		}

		if (! defined $target || ($target eq '')) {
			$target = $chattername;
		}

		$reply = 'подаёт шот водки с небольшим маринованным огурчиком на блюдце для ' . $target . '. Из огурчика торчит небольшая вилочка.';
		$bot->send_long_message ('utf8', 0, "PRIVMSG\001ACTION", $chatid, $reply);
		return;
	} elsif (substr ($text, 1, 4) eq 'beer' || substr ($text, 1, 4) eq 'пиво') {
		my $target;

		if ((length ($text) > 6)) {
			$target = trim (substr $text, 6);
		}

		if (! defined $target || ($target eq '')) {
			$target = $chattername;
		}

		$reply = 'бахает об стол перед ' . $target . ' кружкой холодного пива, часть пенной шапки сползает по запотевшей стенке кружки.';
		$bot->send_long_message ('utf8', 0, "PRIVMSG\001ACTION", $chatid, $reply);
		return;
	} elsif (substr ($text, 1, 7) eq 'tequila') {
		my $target;

		if ((length ($text) > 9)) {
			$target = trim (substr $text, 9);
		}

		if (! defined $target || ($target eq '')) {
			$target = $chattername;
		}

		$reply = 'ставит рядом с ' . $target . ' шот текилы, аккуратно на ребро стопки насаживает дольку лайма и ставит кофейное блюдце с горочкой соли.';
		$bot->send_long_message ('utf8', 0, "PRIVMSG\001ACTION", $chatid, $reply);
		return;
	} elsif (substr ($text, 1, 6) eq 'текила') {
		my $target;

		if ((length ($text) > 8)) {
			$target = trim (substr $text, 8);
		}

		if (! defined $target || ($target eq '')) {
			$target = $chattername;
		}

		$reply = 'ставит рядом с ' . $target . ' шот текилы, аккуратно на ребро стопки насаживает дольку лайма и ставит кофейное блюдце с горочкой соли.';
		$bot->send_long_message ('utf8', 0, "PRIVMSG\001ACTION", $chatid, $reply);
		return;
	} elsif (substr ($text, 1, 6) eq 'whisky') {
		my $target;

		if ((length ($text) > 8)) {
			$target = trim (substr $text, 8);
		}

		if (! defined $target || ($target eq '')) {
			$target = $chattername;
		}

		$reply = 'демонстративно достаёт из морозилки пару кубических камушков, бросает их в толстодонный стакан и аккуратно наливает Jack Daniels. Запускает стакан вдоль барной стойки, он останавливается около ' . $target . '.';
		$bot->send_long_message ('utf8', 0, "PRIVMSG\001ACTION", $chatid, $reply);
		return;
	} elsif (substr ($text, 1, 5) eq 'виски') {
		my $target;

		if ((length ($text) > 7)) {
			$target = trim (substr $text, 7);
		}

		if (! defined $target || ($target eq '')) {
			$target = $chattername;
		}

		$reply = 'демонстративно достаёт из морозилки пару кубических камушков, бросает их в толстодонный стакан и аккуратно наливает Jack Daniels. Запускает стакан вдоль барной стойки, он останавливается около ' . $target . '.';
		$bot->send_long_message ('utf8', 0, "PRIVMSG\001ACTION", $chatid, $reply);
		return;
	} elsif (substr ($text, 1, 8) eq 'absinthe') {
		my $target;

		if ((length ($text) > 10)) {
			$target = trim (substr $text, 10);
		}

		if (! defined $target || ($target eq '')) {
			$target = $chattername;
		}

		$reply = 'наливает абсент в стопку. Смочив кубик сахара в абсенте кладёт его на дырявую ложечку и пожигает. Как только пламя потухнет, ' . $c->{nick} . ' размешивает оплавившийся кубик в абсенте и подносит стопку ' . $target . '.';
		$bot->send_long_message ('utf8', 0, "PRIVMSG\001ACTION", $chatid, $reply);
		return;
	} elsif (substr ($text, 1, 6) eq 'абсент') {
		my $target;

		if ((length ($text) > 8)) {
			$target = trim (substr $text, 8);
		}

		if (! defined $target || ($target eq '')) {
			$target = $chattername;
		}

		$reply = 'наливает абсент в стопку. Смочив кубик сахара в абсенте кладёт его на дырявую ложечку и пожигает. Как только пламя потухнет, ' . $c->{nick} . ' размешивает оплавившийся кубик в абсенте и подносит стопку ' . $target . '.';
		$bot->send_long_message ('utf8', 0, "PRIVMSG\001ACTION", $chatid, $reply);
		return;
	} elsif (substr ($text, 1, 2) eq 'w '  ||  substr ($text, 1, 2) eq 'п ') {
		my $city = substr $text, 2;
		$reply = Weather ($city) =~ tr/\n/ /r;
	} elsif (substr ($text, 1) eq 'anek'  ||  substr ($text, 1) eq 'анек' || substr ($text, 1) eq 'анекдот' ) {
		$reply = Anek ();
	} elsif (substr ($text, 1) eq 'coin' || substr ($text, 1) eq 'монетка') {
		if (rand (101) < 0.016) {
			$reply = 'ребро';
		} else {
			if (irand (2) == 0) {
				if (irand (2) == 0) {
					$reply = 'орёл';
				} else {
					$reply = 'аверс';
				}
			} else {
				if (irand (2) == 0) {
					$reply = 'решка';
				} else {
					$reply = 'реверс';
				}
			}
		}
	} elsif (substr ($text, 1) eq 'roll' || substr ($text, 1) eq 'dice' || substr ($text, 1) eq 'кости') {
		$reply = sprintf 'На первой кости выпало %d, а на второй — %d.', irand (6) + 1, irand (6) + 1;
	} elsif (substr ($text, 1) eq 'version'  ||  substr ($text, 1) eq 'ver') {
		$reply = 'Версия нуль.чего-то_там.чего-то_там';
	} elsif (substr ($text, 1) eq 'lat'  ||  substr ($text, 1) eq 'лат') {
		$reply = Lat ();
	} elsif (substr ($text, 1) eq 'cat'  ||  substr ($text, 1) eq 'кис') {
		$reply = Kitty ();
	} elsif (substr ($text, 1) eq 'fox'  ||  substr ($text, 1) eq 'лис') {
		$reply = Fox ();
	} elsif (substr ($text, 1) eq 'frog'  ||  substr ($text, 1) eq 'лягушка') {
		$reply = Frog ();
	} elsif (substr ($text, 1) eq 'horse'  ||  substr ($text, 1) eq 'лошадь'  || substr ($text, 1) eq 'лошадка') {
		$reply = Horse ();
	} elsif (substr ($text, 1) eq 'snail'  ||  substr ($text, 1) eq 'улитка') {
		$reply = Snail ();
	} elsif (substr ($text, 1) eq 'dig'  ||  substr ($text, 1) eq 'копать') {
		$reply = Dig ($chattername);
	} elsif (substr ($text, 1) eq 'fish'  ||  substr ($text, 1) eq 'fisher'  ||  substr ($text, 1) eq 'рыба'  ||  substr ($text, 1) eq 'рыбка'  ||  substr ($text, 1) eq 'рыбалка') {
		$reply = Fish ($chattername);
	} elsif (substr ($text, 1) eq 'buni') {
		$reply = Buni ();
	} elsif (substr ($text, 1) eq 'xkcd') {
		$reply = Xkcd ();
	} elsif (substr ($text, 1) eq 'monkeyuser') {
		$reply = Monkeyuser ();
	} elsif (substr ($text, 1) eq 'drink' || substr ($text, 1) eq 'праздник') {
		$reply = Drink ();
	} elsif (substr ($text, 1) eq 'bunny' || substr ($text, 1) eq 'rabbit' || substr ($text, 1) eq 'кролик') {
		$reply = Rabbit ();
	} elsif (substr ($text, 1) eq 'owl' || substr ($text, 1) eq 'сова') {
		$reply = Owl ();
	} elsif ((length ($text) >= 6 && (substr ($text, 1, 6) eq 'karma ' || substr ($text, 1, 6) eq 'карма '))  ||  substr ($text, 1) eq 'karma'  ||  substr ($text, 1) eq 'карма') {
		my $mytext = '';

		if (length ($text) > 6) {
			$mytext = substr $text, 7;
			chomp $mytext;
			$mytext = trim $mytext;
		} else {
			$mytext = '';
		}

		$reply = KarmaGet ($chatid, $mytext);
	} elsif (substr ($text, 1) eq 'friday'  ||  substr ($text, 1) eq 'пятница') {
		$reply = Friday ();
	} elsif (substr ($text, 1) eq 'proverb'  ||  substr ($text, 1) eq 'пословица') {
		$reply = Proverb ();
	} elsif (substr ($text, 1) eq 'fortune'  ||  substr ($text, 1) eq 'фортунка'  ||  substr ($text, 1) eq 'f'  ||  substr ($text, 1) eq 'ф') {
		my $phrase = Fortune ();
		$reply = $phrase;
	} elsif (substr ($text, 1) eq 'ping') {
		$reply = 'Pong.';
	} elsif (substr ($text, 1) eq 'пинг') {
		$reply = 'Понг.';
	} elsif (substr ($text, 1) eq 'kde' || substr ($text, 1) eq 'кде') {
		my @phrases = (
			'Нет, я не буду поднимать вам плазму.',
			'Повторяйте эту мантру по утрам не менее 5 раз: "Плазма не падает." И, возможно, она перестанет у вас падать.'
		);

		$reply = $phrases[irand ($#phrases + 1)];
	} elsif (substr ($text, 1) eq '=(' || substr ($text, 1) eq ':(' || substr ($text, 1) eq '):') {
		$reply = ':)';
	} elsif (substr ($text, 1) eq '=)' || substr ($text, 1) eq ':)' || substr ($text, 1) eq '(:') {
		$reply = ':D';
	}

	$log->warn (Dumper ($m));
	return;
};

my $on_ctcp_source = sub {
	my $self = shift;
	my $msg = shift;
	my $response_to = (split /!/, $msg->{prefix}, 2)[0];
	$self->write (NOTICE => $response_to => $self->ctcp (SOURCE => 'https://github.com/aleesa-bot/aleesa-irc'));
	return;
};

my $on_ctcp_finger = sub {
	my $self = shift;
	my $msg = shift;
	my $response_to = (split /!/, $msg->{prefix}, 2)[0];
	$self->write (NOTICE => $response_to => $self->ctcp (FINGER => $c->{nick}));
	return;
};

my $on_ctcp_ping = sub {
	my $self = shift;
	my $msg = shift;
	my $response_to = (split /!/, $msg->{prefix}, 2)[0];
	$self->write (NOTICE => $response_to => $self->ctcp (PING => $msg->{params}->[1]));
	return;
};

my $on_ctcp_time = sub {
	my $self = shift;
	my $msg = shift;
	my $response_to = (split /!/, $msg->{prefix}, 2)[0];
	$self->write (NOTICE => $response_to => $self->ctcp (TIME => gmtime_to_iso8601_datetime (time ())));
	return;
};

my $on_ctcp_clientinfo = sub {
	my $self = shift;
	my $msg = shift;
	my $response_to = (split /!/, $msg->{prefix}, 2)[0];
	$self->write (NOTICE => $response_to => $self->ctcp (CLIENTINFO => 'ACTION CLIENTINFO FINGER PING SOURCE TIME USERINFO VERSION'));
	return;
};

my $on_irc_end_of_motd = sub {
	my $self = shift;

	# Идентифицируемся в NickServ, если надо
	if (defined ($c->{identify}) && $c->{identify} ne '') {
		# TODO: invent heuristics to detect different login|identify commands depending on particular irc net or
		#       known ircd detected during login procedure
		# Эта команда используется на фриноде (мир праху её) и libera.chat
		$self->write ( qw (PRIVMSG NickServ IDENTIFY $c->{nick} $c->{identify}), \&_on_nickserv_identify);

		until ($identified) { ## no critic (ControlStructures::ProhibitUntilBlocks)
			sleep 1;
		}
	}

	# А теперь заходим на все интересующие нас каналы
	foreach my $chan (@{$c->{channels}}) {
		$self->write ( ('JOIN', $chan), \&_on_join_channel);
	}
	return;
};

sub _on_nickserv_identify {
	my $self = shift;
	my $error = shift;

	if ($error) {
		$log->error ("NickServ identify failed: $error");
		exit 1;
	} else {
		$log->info ('Identified with Nickserv');
		$identified = 1;
	}

	return;
}

sub _on_join_channel {
	my $self = shift;
	my $error = shift;

	if ($error) {
		$log->error ("Unable to join: $error");
	} else {
		$log->info ('Joined');
	}

	return;
}

# зовётся в момент "после коннекта"
sub _on_connect {
	my $self = shift;
	my $error = shift;

	if ($error) {
		$log->error ("Unable to connect: $error");
		exit 1;
	} else {
		$log->info ('Connected.');
	}

	return;
}

sub _on_disconnect {
	my $self = shift;
	my $error = shift;

	if ($error) {
		$log->error ("Unable to Disconnect: $error");
	} else {
		$log->info ('Disconnected.');
	}

	return;
}


# main loop, он же event loop
sub RunIRCApp {
	my $redis = Mojo::Redis->new (
		sprintf 'redis://%s:%s/1', $c->{server}, $c->{port}
	);

	my $pubsub = $redis->pubsub;
	my $sub;

	$pubsub->listen (
		# Вот такая ебическая конструкция для авто-подписывания на все новые каналы.
		# Странное ограничение, при котором на шаблон каналов можно подписаться только, подписавшись на каждый из
		# каналов. То есть подписка создаётся по запросу. В AnyEvent::Redis подписаться можно сразу на * :(
		# Но конкретно в моём случае этот момент неважен, т.к. подразумевается, что каналы будут добавляться, но не 
		# будут убавляться.
		'webapp:*' => sub {
			my ($ps, $channel) = @_ ;

			unless (defined $sub->{$channel}) {
				$log->info ("Subscribing to $channel");

				$sub->{$channel} = $ps->json ($channel)->listen (
					$channel => sub { return $parse_redis_message->(@_); }
				);
			}
		}
	);

	my $irc = Mojo::IRC->new (
		nick => $c->{nick},
		user => $c->{nick},
		server => sprintf '%s:%s', $c->{server}, $c->{port},
	);

	# Нахуй эту вашу проверку подлинности, нам работать надо, а не шашечки.
	if ($c->{ssl}) {
		$irc->tls({ 'insecure' => 1 });
	}

	# включим обработку ctcp-событий
	$irc->parser(Parse::IRC->new(ctcp => 1));

	# добавим коллбэк на момент "после подключения"
	$irc->connect(\&_on_connect);

	# когда приходит это событие, сервер нас поприветствовал и мы можем уже пробовать идентифицироваться у nickserv
	# (если надо) и джойниться к каналам.
	$irc->on ( irc_rpl_endofmotd => sub { return $on_irc_end_of_motd->(@_); } );

	# этот коллбэк будет зваться по мере бесед, сюда попадают все фразы и ctcp
	$irc->on ( irc_privmsg => sub { return $on_irc_privmsg->(@_); } );

	# эти коллбэки будет зваться когда приходят ctcp запросы.
	$irc->on ( ctcp_source => sub { return $on_ctcp_source->(@_); } );
	$irc->on ( ctcp_finger => sub { return $on_ctcp_finger->(@_); } );
	$irc->on ( ctcp_userinfo => sub { return $on_ctcp_finger->(@_); } );
	$irc->on ( ctcp_ping => sub { return $on_ctcp_ping->(@_); } );
	$irc->on ( ctcp_time => sub { return $on_ctcp_time->(@_); } );
	$irc->on ( ctcp_clientinfo => sub { return $on_ctcp_clientinfo->(@_); } );

	# зарегистрируем дефолтные коллбэки на всё, что не закастомизировано
	$irc->register_default_event_handlers;

	do { Mojo::IOLoop->start } until Mojo::IOLoop->is_running;
	return;
}

1;

# vim: set ft=perl noet ai ts=4 sw=4 sts=4: