First adoption step for production use with telegram frontend

README

@@ -3,39 +3,33 @@ aleesa-craniac
 Бредогенератор, основанный на цепях Маркова. Попутно сохраняет состояние цепей
 в sqlite-базу. Собственно, является "мозгом" aleesa bot-а.
 
+
 Механика работы
 ------------------------------------------------------------------------------
-Бредогенератор подписан на все каналы, попадающие под шаблон "craniac:*" (без
+Бредогенератор подписан на redis-канал craniac. В этот канал пишет другой
-кавычек). Предполагается, что есть специальный канал "broadcast", на который
+демоночек - aleesa-misc. Причём, особенность такова, что если aleesa-misc не
-подписываются все модули и, если надо, ответ в такой канал получают все.
+распознала фразу как команду для другого модуля, то по-умолчанию такая фраза
+оправляется в канал craniac.
 
-Формат протокола - это json с полями:
+У бредогенератора есть 2 типа входящих сообщений - ключевые фразы, на которые
-from           - модуль, который решил отправить запрос.
+у него есть готовые ответы и остальные, для которых ему надо решить нужен ли
-chatid         - чат, из которого сделан вызов
+ответ и по-необходимости сгенерировать его.
-userid         - пользователь, на чью фразу мы отвечаем
-message        - оригинальный текст сообщения
-plugin         - плагин, нужный для генерации ответа
-misc->{answer} - 1 - ждём ответа на запрос, 0 - не ждём ответа (данные для
-                 добавления в цепи Маркова)
 
-N.B.
+Ответ направляется в redis-канал, указанный в поле plugin входящего сообщения.
-При запуске нового приложения, которое будет пользоваться этим
+
-бредогенератором, оно должно "поприветствовать" craniac-а по всем каналам, для
+Формат протокола - см README от aleesa-misc.
-того, чтобы сработала внутренняя логика и craniac подписался на новые каналы.
-Если этого не сделать, то первое сообщение по новому каналу будет "проглочено"
-и "потрачено" на подписку на этот канал.
 
 
 Как это запустить?
 ------------------------------------------------------------------------------
 Понадобится perl, cpanm и local::lib, а также несколько разных devel-пакетов
 для разных библиотек. Как правило, это находится методом тыка, но точно
-понадобятся sqlite-devel, bdb-devel (или db-devel). Кроме того, понадобятся
+понадобятся sqlite-devel, bdb-devel (или db-devel), hiredis-devel. Кроме того,
-development tools - gcc, gcc-g++, perl-devel, make, cmake и так далее.
+понадобятся development tools - gcc, gcc-g++, perl-devel, make, cmake и так
+далее.
 
 В каталоге с приложением под целевым пользователем запускаем bash bootstrap.sh
 Ждём с надеждой, что оно не обломится в пути.
 
-Если всё хорошо, то после создания data/config.json из data/config_sample.json
+Если всё хорошо, то после запуска redis-а, создания data/config.json из
-и получения ключей и настройки модулей openweathermap и flickr, можно
+data/config_sample.json, можно запускать и само приложение.
-запускать приложение. Оно запустится как unix daemon.

bin/aleesa-craniac

@@ -112,9 +112,9 @@ if (defined $logfile) {
 }
 
 # по-умолчанию, демонизируемся, если явно не указано, что этого делать не надо
-if (defined ($c->{daemonize}) && $c->{daemonize}) {
+if (defined ($C->{daemonize}) && $C->{daemonize}) {
 	daemonize ();
-} elsif ( ! defined ($c->{daemonize})) {
+} elsif ( ! defined ($C->{daemonize})) {
 	daemonize ();
 }
 

cpanfile

@@ -1,12 +1,12 @@
 requires 'Cwd';
 requires 'Cwd::utf8';
-requires 'DateTime';
 requires 'Digest::SHA';
+requires 'Encode';
 requires 'English';
 requires 'File::Basename';
 requires 'File::Path';
 requires 'Hailo';
-requires 'IO::Socket::SSL';
+requires 'JSON::XS';
 requires 'local::lib';
 requires 'Log::Any';
 requires 'Log::Any::Adapter';
@@ -15,4 +15,5 @@ requires 'Math::Random::Secure';
 requires 'Mojo::IOLoop';
 requires 'Mojo::Redis';
 requires 'POSIX';
+requires 'Protocol::Redis::XS';
 requires 'Text::Fuzzy';

data/config_sample.json

@@ -1,15 +1,20 @@
 {
-# server address
     "server" : "redis",
     "port" : "6379",
 
+# inbound redis channels, where we subscribed
+    "channels": [
+        "craniac",
+    ],
+
 # should we fork() and become unix daemon?
     "daemonize": 1,
 
-# where caches go there
+# caches and other data goes there
     "cachedir" : "data/cache",
+    "braindir" : "data/brains",
 
-# unprivileged system user to run bot as
+    # unprivileged system user to run bot as
     "user" : "nobody",
 
 # logs goes there
@@ -17,5 +22,5 @@
     "loglevel": "notice",
 
 # ditto
-    "pid" : "/var/run/aleesa-craniac/aleesa-craniac.pid",
+    "pid" : "/var/run/aleesa-craniac/aleesa-craniac.pid"
 }

lib/Conf.pm

@@ -0,0 +1,37 @@
+package Conf;
+# loads config
+
+use 5.018;
+use strict;
+use warnings;
+use utf8;
+use open qw (:std :utf8);
+use English qw ( -no_match_vars );
+use Encode qw (encode decode);
+use JSON::XS;
+
+use version; our $VERSION = qw (1.0);
+use Exporter qw (import);
+our @EXPORT_OK = qw (LoadConf);
+
+sub LoadConf {
+	my $c = 'data/config.json';
+	open my $CH, '<', $c or die "[FATAL] No conf at $c: $OS_ERROR\n";
+	my $json;
+	my $len = (stat $c) [7];
+	my $readlen = read $CH, $json, $len;
+	$json = encode 'UTF-8', $json;
+
+	unless ($readlen) {
+		close $CH;                                   ## no critic (InputOutput::RequireCheckedSyscalls
+		die "[FATAL] Unable to read $c: $OS_ERROR\n";
+	}
+
+	close $CH;                                       ## no critic (InputOutput::RequireCheckedSyscalls
+	my $j = JSON::XS->new->utf8->relaxed;
+	return $j->decode ($json);
+}
+
+1;
+
+# vim: set ft=perl noet ai ts=4 sw=4 sts=4:

lib/Craniac.pm

@@ -1,57 +1,46 @@
 package Craniac;
+# Предполагается, что craniac - это "маршрут по-умолчанию". То есть сюда попадают все фразы, которые не были распознаны
+# aleesa-misc как команды.
 
-# общие модули - синтаксис, кодировки итд
+# Основная задача мозгов - распознать, требуется ли ответ и обработать фразу.
+# Соответсвенно, мы предполагаем, что фразы делятся на 2 типа:
+# * ключевая фраза, на которую у нас есть один или несколько готовых ответов.
+# * просто фраза в чате, на которую надо напрячь мозги и (в зависимости от необходимости) ответить на неё или 
+#   проигнорировать.
+
+# Общие модули - синтаксис, кодировки итд
 use 5.018;
 use strict;
 use warnings;
 use utf8;
 use open qw (:std :utf8);
+use English qw ( -no_match_vars );
 
-# модули для работы приложения
+# Модули для работы приложения
 use Digest::SHA qw (sha1_base64);
-use JSON::XS;
 use Hailo;
 use Log::Any qw ($log);
+# Чтобы "уж точно" использовать hiredis-биндинги, загрузим этот модуль перед Mojo::Redis
+use Protocol::Redis::XS;
 use Mojo::Redis;
 use Mojo::IOLoop;
 use Math::Random::Secure qw (irand);
 use Text::Fuzzy qw (distance_edits);
 
+use Conf qw (LoadConf);
 use version; our $VERSION = qw (1.0);
 use Exporter qw (import);
 our @EXPORT_OK = qw (RunCraniac);
 
-sub LoadConf ();
 sub RandomCommonPhrase ();
 sub utf2sha1 ($);
 sub fmatch (@);
+sub brains (@);
 sub RunCraniac ();
 
 my $c = LoadConf ();
 my $hailo;
 
-sub LoadConf {
-	my $cfg = 'data/config.json';
-	open my $CH, '<', $c or die "[FATAL] No conf at $c: $OS_ERROR\n";
-	my $len = (stat $cfg) [7];
-	my $json;
-	my $readlen = read $CH, $json, $len;
-
-	unless ($readlen) {
-		close $CH;                                   ## no critic (InputOutput::RequireCheckedSyscalls
-		die "[FATAL] Unable to read $c: $OS_ERROR\n";
-	}
-
-	if ($readlen != $len) {
-		close $CH;                                   ## no critic (InputOutput::RequireCheckedSyscalls
-		die "[FATAL] File $c is $len bytes on disk, but we read only $readlen bytes\n";
-	}
-
-	close $CH;                                       ## no critic (InputOutput::RequireCheckedSyscalls
-	my $j = JSON::XS->new->utf8->relaxed;
-	return $j->decode ($json);
-}
-
 sub RandomCommonPhrase () {
 	my @myphrase = (
 		'Так, блядь...',
@@ -69,7 +58,7 @@ sub RandomCommonPhrase () {
 	return $myphrase[irand ($#myphrase + 1)];
 }
 
-sub utf2sha1 () {
+sub utf2sha1 ($) {
 	my $string = shift;
 
 	if ($string eq '') {
@@ -95,19 +84,15 @@ sub fmatch (@) {
 	}
 }
 
-# основной парсер
+sub brains (@) {
-my $parse_message = sub {
+	my $chatid = shift;
-	my $self = shift;
+	my $telegram = shift // 0;
-	my $m = shift;
-	my $answer = $m;
-	my $send_to = $answer->{from};
-	my $chatid = $m->{chatid};
 
 	unless (defined $hailo->{$chatid}) {
 		my $cid = $chatid;
 
-		# костыль, чтобы не портировать данные из телеграммных мозгов
+		# Костыль, чтобы не портировать данные из телеграммных мозгов
-		unless ($m->{from} eq 'telegram') {
+		unless ($telegram) {
 			$cid = utf2sha1 ($chatid);
 			$cid =~ s/\//-/xmsg;
 		}
@@ -121,82 +106,180 @@ my $parse_message = sub {
 
 		unless (defined $hailo->{$chatid}) {
 			$log->warn ($EVAL_ERROR);
-			return;
+			return 0;
 		}
 
 		$log->info (sprintf 'Lazy init brain: %s', $brainname);
 	}
 
-	if ($m->{misc}->{answer}) {
+	return 1;
+}
 
-		# пытаемся что-то генерировать, если фраза длиннее 3-х букв
+# Основной парсер
-		if (length ($m->{message}) > 3) {
+my $parse_message = sub {
-			$answer->{message} = $hailo->{$chatid}->learn_reply ($m->{message});
+	my $self = shift;
+	my $m = shift;
+	my $send_to = $m->{plugin};
+	my $chatid  = $m->{chatid};
+	my $userid  = $m->{userid};
+	my $phrase  = $m->{message};
+	my $reply;
 
-			# если из реактора вернулся undef выдаём "общую" фразу из словаря
+	# Если $m->{misc}->{answer} не существует, то проставим его как 1, предполагаем, что по-умолчанию ответ от нас
-			unless (defined $answer->{message}) {
+	# всё-таки ожидают. Уточним ниже, по содержимому фразы и по режиму беседы (private или public).
-				$answer->{message} = RandomCommonPhrase ();
+	if (defined $m->{misc}) {
-			}
+		unless (defined $m->{misc}->{answer}) {
-
+			$m->{misc}->{answer} = 1;
-			# если из реактора вернулась пустота выдаём "общую" фразу из словаря
-			if ($answer->{message} eq '') {
-				$answer->{message} = RandomCommonPhrase ();
-			}
-
-			# если сгенерированная фраза слишком похожа на начальную - выдаём "общую" фразу из словаря
-			if (fmatch (lc ($m->{message}), lc($answer->{message}))) {
-				$answer->{message} = RandomCommonPhrase ();
-			}
-
-			$self->json ($send_to)->notify (
-				$send_to => {
-					from    => $answer->{from},
-					userid  => $answer->{userid},
-					chatid  => $answer->{chatid},
-					plugin  => $answer->{plugin},
-					message => $answer->{message}
-				}
-			);
 		}
 	} else {
+		$m->{misc}->{answer} = 1;
+	}
 
+	if (defined $m->{misc}->{bot_nick}) {
+		# Заменим обращение к боту по нику с окружающими запятыми и пробелами на пробел
+		$phrase =~ s/\s*\,?\s*($m->{misc}->{bot_nick})\s*\,?\s*/ /gui;
+	}
+
+	if ($m->{mode} eq 'private') {
+		$phrase =~ s/^\s*(вот\s+)?скажи(\s*мне)?\s*//gui;
+		$phrase =~ s/\s*(,)?\s*а\s*\?$/?/gui;
+
+		if ($phrase =~ /^ *кто +все +эти +люди *\?$/ui) {
+			$reply = 'Какие "люди"? Мы здесь вдвоём, только ты и я.';
+		} elsif ($phrase =~ /^ *кто +я *\?$/ui) {
+			$reply = 'Где?';
+		} elsif ($phrase =~ /^ *кто +(здесь|тут) *\?$/ui) {
+			$reply = 'Ты да я, да мы с тобой.';
+		}
+
+		# TODO: дописать запрос в webapp, для easter egg-ов, либо делать это на уровне aleesa-misc
+
+		if (defined ($reply) && $m->{misc}->{answer}) {
+			$self->json ($send_to)->notify (
+				$send_to => {
+					from    => 'craniac',
+					userid  => $userid,
+					chatid  => $chatid,
+					plugin  => $m->{plugin},
+					message => $reply
+				}
+			);
+
+			return;
+		}
+	} elsif ($m->{mode} eq 'public') {
+		$phrase =~ s/^\s*(вот\s+)?скажи(\s*мне)?\s*//gui;
+		$phrase =~ s/\s*(,)?\s*а\s*\?$/?/gui;
+
+		if ($phrase =~ /^ *кто +все +эти +люди *\?$/ui) {
+			$reply = 'Кто здесь?';
+		} elsif ($phrase =~ /^ *кто +я *?$/ui){
+			$reply = 'Где?';
+		} elsif ($phrase =~ /^ *кто +(здесь|тут) *\?$/ui) {
+			$reply = 'Здесь все: Никита, Стас, Гена, Турбо и Дюша Метёлкин.';
+		}
+
+		if (defined ($reply) && $m->{misc}->{answer}) {
+			$self->json ($send_to)->notify (
+				$send_to => {
+					from    => 'craniac',
+					userid  => $userid,
+					chatid  => $chatid,
+					plugin  => $m->{plugin},
+					message => $reply
+				}
+			);
+
+			return;
+		}
+	}
+
+	# Попадаем сюда только если входящая фраза не распознана ранее как ключевая. 
+	if ($m->{misc}->{answer}) {
+		# Пытаемся что-то генерировать, если фраза длиннее 3-х букв
+		if (length ($m->{message}) > 3) {
+			if (brains ($chatid, 1)) {
+				$reply = $hailo->{$chatid}->learn_reply ($m->{message});
+
+				# Если из реактора вернулся undef выдаём "общую" фразу из словаря
+				unless (defined $reply) {
+					$reply = RandomCommonPhrase ();
+				} else {
+					# Если из реактора вернулась пустота выдаём "общую" фразу из словаря
+					if ($reply eq '') {
+						$reply = RandomCommonPhrase ();
+					}
+
+					# Если сгенерированная фраза слишком похожа на начальную - выдаём "общую" фразу из словаря
+					if (fmatch (lc ($m->{message}), lc ($reply))) {
+						$reply = RandomCommonPhrase ();
+					}
+				}
+
+				$self->json ($send_to)->notify (
+					$send_to => {
+						from    => 'craniac',
+						userid  => $userid,
+						chatid  => $chatid,
+						plugin  => $m->{plugin},
+						message => $reply
+					}
+				);
+			}
+		}
+	} else {
 		# пытаемся что-то запоминать, если фраза длиннее 3-х букв
 		if (length ($m->{message}) > 3) {
-			$hailo->{$chatid}->learn ($m->{message});
+			if (brains ($chatid, 1)) {
+				$hailo->{$chatid}->learn ($m->{message});
+			}
 		}
 	}
 
 	return;
 };
 
-# main loop, он же event loop
+# Main loop, он же event loop
-sub RunCraniac {
+sub RunCraniac () {
+	$log->notice ("[NOTICE] Connecting to $c->{server}, $c->{port}");
+
 	my $redis = Mojo::Redis->new (
 		sprintf 'redis://%s:%s/1', $c->{server}, $c->{port}
 	);
 
-	my $pubsub = $redis->pubsub;
+	$log->notice ('[NOTICE] Registering connection-event callback');
-	my $sub;
 
-	$pubsub->listen (
+	$redis->on (
-		# Вот такая ебическая конструкция для авто-подписывания на все новые каналы.
+		connection => sub {
-		# Странное ограничение, при котором на шаблон каналов можно подписаться только, подписавшись на каждый из
+			my ($r, $connection) = @_;
-		# каналов. То есть подписка создаётся по запросу. В AnyEvent::Redis подписаться можно сразу на * :(
-		# Но конкретно в моём случае этот момент неважен, т.к. подразумевается, что каналы будут добавляться, но не 
-		# будут убавляться.
-		'craniac:*' => sub {
-			my ($ps, $channel) = @_ ;
 
-			unless (defined $sub->{$channel}) {
+			$log->info ('[INFO] Triggering callback on new client connection');
-				$log->info ("Subscribing to $channel");
 
-				$sub->{$channel} = $ps->json ($channel)->listen (
+			# Пишем ошибку в лог, если соединение с редиской внезапно порвалось.
-					$channel => sub { $parse_message->(@_); }
+			$connection->on (
-				);
+				error => sub {
-			}
+					my ($conn, $error) = @_;
+					$log->error ("[ERROR] Redis connection error: $error");
+					return;
+				}
+			);
+
+			return;
 		}
 	);
 
+	my $pubsub = $redis->pubsub;
+	my $sub;
+	$log->notice ('[NOTICE] Subscribing to redis channels');
+
+	foreach my $channel (@{$c->{channels}}) {
+		$log->info ("[INFO] Subscribing to $channel");
+
+		$sub->{$channel} = $pubsub->json ($channel)->listen (
+			$channel => sub { $parse_message->(@_); }
+		);
+	}
+
 	do { Mojo::IOLoop->start } until Mojo::IOLoop->is_running;
 	return;
 }