aleesa-phrases/lib/Phrases.pm

package Phrases;

# Общие модули - синтаксис, кодировки итд
use 5.018; ## no critic (ProhibitImplicitImport)
use strict;
use warnings;
use utf8;
use open qw (:std :utf8);

# Модули для работы приложения
use Clone qw (clone);
use Log::Any qw ($log);
use Math::Random::Secure qw (irand);
# Чтобы "уж точно" использовать hiredis-биндинги, загрузим этот модуль перед Mojo::Redis
use Protocol::Redis::XS ();
use Mojo::Redis ();
use Mojo::IOLoop ();
use Mojo::IOLoop::Signal ();
use Mojo::Util qw (trim);
use Data::Dumper qw (Dumper);

use Conf qw (LoadConf);
use Fortune qw (Fortune);
use Friday qw (Friday);
use Karma qw (KarmaGet KarmaSet);
use Proverb qw (Proverb);

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

my $c = LoadConf ();
my $fwd_cnt = $c->{'forward_max'} // 5;

# Основной парсер
my $parse_message = sub {
	my $self = shift;
	my $m = shift;
	my $answer = clone ($m);
	$answer->{from} = 'phrases';
	my $send_to = $m->{plugin};
	my $reply;

	if (defined $answer->{misc}) {
		unless (defined $answer->{misc}->{fwd_cnt}) {
			$answer->{misc}->{fwd_cnt} = 1;
		} else {
			if ($answer->{misc}->{fwd_cnt} > $fwd_cnt) {
				$log->error ('Forward loop detected, discarding message.');
				$log->debug (Dumper $m);
				return;
			} else {
				$answer->{misc}->{fwd_cnt}++;
			}
		}

		unless (defined $answer->{misc}->{answer}) {
			$answer->{misc}->{answer} = 1;
		}

		unless (defined $answer->{misc}->{csign}) {
			$answer->{misc}->{csign} = '!';
		}
	} else {
		$answer->{misc}->{answer} = 1;
		$answer->{misc}->{csign} = '!';
		$answer->{misc}->{msg_format} = 0;
	}

	$answer->{userid} = 0 + $m->{userid};
	$answer->{chatid} = 0 + $m->{chatid};

	$log->debug ('[DEBUG] Incoming message ' . Dumper ($m));

	# Нормальная команда
	if (substr ($m->{message}, 0, length ($answer->{misc}->{csign})) eq $answer->{misc}->{csign}) {
		my $cmd = substr $m->{message}, length ($answer->{misc}->{csign});

		if ($cmd eq 'friday'  ||  $cmd eq 'пятница') {
			$reply = Friday ();
		} elsif ($cmd eq 'proverb'  ||  $cmd eq 'пословица') {
			$reply = Proverb ();
		} elsif ($cmd eq 'fortune'  ||  $cmd eq 'фортунка'  ||  $cmd eq 'f'  ||  $cmd eq 'ф') {
			if ($m->{plugin} eq 'telegram') {
				if ($m->{misc}->{good_morning}){
					# fortune mod
					my @intro = (
						'Сегодняшний день пройдёт под эгидой фразы:',
						'Крылатая фраза на сегодня:',
						'Сегодняшняя фраза дня:',
					);

					$reply = sprintf "%s\n```\n%s\n```\n", $intro[irand ($#intro + 1)], trim (Fortune ());
				} else {
					$reply = sprintf "```\n%s\n```\n", trim (Fortune ());
				}
			} else {
				$reply = trim (Fortune ());
			}
		} elsif (length ($cmd) >= length ('karma ')  &&  substr ($cmd, 0, length ('karma ')) eq 'karma ') {
			# По-умолчанию достаём карму пустоты
			my $text = undef;

			if (length ($cmd) > length ('karma ')) {
				$text = substr $cmd, length ('karma ');
			}

			$reply = KarmaGet ($m->{chatid}, $text);
		} elsif (length ($cmd) >= length ('карма ')  &&  substr ($cmd, 0, length ('карма ')) eq 'карма ') {
			# По-умолчанию достаём карму пустоты
			my $text = undef;

			if (length ($cmd) > length ('карма ')) {
				$text = substr $cmd, length ('карма ');
			}

			$reply = KarmaGet ($m->{chatid}, $text);
		# Достаём карму пустоты :)
		} elsif ($cmd eq 'karma') {
			$reply = KarmaGet ($m->{chatid}, undef);
		# Достаём карму пустоты :)
		}elsif ($cmd eq 'карма') {
			$reply = KarmaGet ($m->{chatid}, undef);
		}
	# Скорее всего изменение кармы, но это не точно
	} elsif (length ($m->{message}) > length ('++')) {
		if (substr ($m->{message}, 0 - length ('++')) eq '++'  ||  substr ($m->{message}, 0 - length ('--')) eq '--') {
			my @arr = split /\n/s, $m->{message};

			# Предполагается, что фраза - это только одна строка
			if ($#arr < 1) {
				$reply = KarmaSet (
					$m->{chatid},
					trim (substr $m->{message}, 0, 0 - length ('++')),
					substr $m->{message}, 0 - length ('++'),
				);
			# Если у нас более одной строки - пусть с этим разбирается craniac, у него есть *мозги*
			} else {
				$send_to = 'craniac';
				$reply = $m->{message};
			}
		}
	}

	if (defined $reply && $answer->{misc}->{answer}) {
		$answer->{message} = $reply;
		$log->debug ("[DEBUG] Sending message to channel $send_to " . Dumper ($answer));

		$self->json ($send_to)->notify (
			$send_to => $answer,
		);
	} else {
		$log->debug ('[DEBUG] No reply generated, skip sending message.');
	}

	return;
};

my $__signal_handler = sub {
	my ($self, $name) = @_;
	$log->info ("[INFO] Caught a signal $name");

	if (defined $main::pidfile && -e $main::pidfile) {
		unlink $main::pidfile;
	}

	exit 0;
};


# main loop, он же event loop
sub RunPhrases {
	$log->info ("[INFO] Connecting to $c->{server}, $c->{port}");

	my $redis = Mojo::Redis->new (
		sprintf 'redis://%s:%s/1', $c->{server}, $c->{port},
	);

	$log->info ('[INFO] Registering connection-event callback');

	$redis->on (
		connection => sub {
			my ($r, $connection) = @_;

			$log->info ('[INFO] Triggering callback on new client connection');

			# Залоггируем ошибку, если соединение внезапно порвалось.
			$connection->on (
				error => sub {
					my ($conn, $error) = @_;
					$log->error ("[ERROR] Redis connection error: $error");
					return;
				},
			);

			return;
		},
	);

	my $pubsub = $redis->pubsub;
	my $sub;
	$log->info ('[INFO] Subscribing to redis channels');

	foreach my $channel (@{$c->{channels}}) {
		$log->debug ("[DEBUG] Subscribing to $channel");

		$sub->{$channel} = $pubsub->json ($channel)->listen (
			$channel => sub { $parse_message->(@_); },
		);
	}

	Mojo::IOLoop::Signal->on (
		TERM => $__signal_handler,
		INT  => $__signal_handler,
	);

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

1;

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