Compare commits
10 Commits
b8291a4c3e
...
v1.0
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
5df11d2437 | ||
|
|
f8d0c3f701 | ||
|
|
b7013d6ab0 | ||
|
|
9c56db452c | ||
|
|
ca0a891522 | ||
|
|
0f58c30603 | ||
|
|
637e5f8261 | ||
|
|
240712bf42 | ||
|
|
64c8300f93 | ||
|
|
468baf7156 |
@@ -93,3 +93,4 @@ lib_sections = NAME | VERSION | DESCRIPTION | AUTHOR | LICENSE AND COPYRIGHT
|
||||
[-ControlStructures::ProhibitDeepNests]
|
||||
# Have to use it, so fuckoff
|
||||
|
||||
[-Variables::ProhibitPackageVars]
|
||||
|
||||
25
Phrases.txt
25
Phrases.txt
@@ -11,13 +11,13 @@
|
||||
* с префиксом в виде любого количества пробельных символов + имени бота + любое количество пробельных символов +
|
||||
опциональньная запятая + любое количество пробельных символов. После команды опциональная точка и любое
|
||||
количество пробельных символов.
|
||||
* символ команды (по-умолчанию - восклицательный знак, задаётся в настройках модуля, отвечающего за конкретны чат-
|
||||
* символ команды (по-умолчанию - восклицательный знак, задаётся в настройках модуля, отвечающего за конкретный чат-
|
||||
протокол) + команда + опциональная точка и любое количество пробельных символов.
|
||||
- Для публичных чатов допустимой являются нотации:
|
||||
* с префиксом в виде любого количества пробельных символов + имени бота + любое количество пробельных символов +
|
||||
опциональньная запятая + любое количество пробельных символов. После команды опциональная точка и любое
|
||||
количество пробельных символов.
|
||||
* символ команды (по-умолчанию - восклицательный знак, задаётся в настройках модуля, отвечающего за конкретны чат-
|
||||
* символ команды (по-умолчанию - восклицательный знак, задаётся в настройках модуля, отвечающего за конкретный чат-
|
||||
протокол) + команда + опциональная точка и любое количество пробельных символов.
|
||||
Ответ на эту фразу - слово "Pong." если фраза была на английском языке или "Понг.", если фраза была на русском языке.
|
||||
|
||||
@@ -28,15 +28,20 @@
|
||||
* с префиксом в виде любого количества пробельных символов + имени бота + любое количество пробельных символов +
|
||||
опциональньная запятая + любое количество пробельных символов. После команды опциональная точка и любое
|
||||
количество пробельных символов.
|
||||
* символ команды (по-умолчанию - восклицательный знак, задаётся в настройках модуля, отвечающего за конкретны чат-
|
||||
* символ команды (по-умолчанию - восклицательный знак, задаётся в настройках модуля, отвечающего за конкретный чат-
|
||||
протокол) + ping + опциональная точка и любое количество пробельных символов.
|
||||
- Для публичных чатов допустимой являются нотации:
|
||||
* с префиксом в виде любого количества пробельных символов + имени бота + любое количество пробельных символов +
|
||||
опциональньная запятая + любое количество пробельных символов. После команды опциональная точка и любое
|
||||
количество пробельных символов.
|
||||
* символ команды (по-умолчанию - восклицательный знак, задаётся в настройках модуля, отвечающего за конкретны чат-
|
||||
* символ команды (по-умолчанию - восклицательный знак, задаётся в настройках модуля, отвечающего за конкретный чат-
|
||||
протокол) + команда + опциональная точка и любое количество пробельных символов.
|
||||
Ответ на эту фразу - слово "Wat?" если фраза была на английском языке или "Шта?", если фраза была на русском языке.
|
||||
* lat или лат
|
||||
- Для приватных и публичных чатов допустимой является нотация:
|
||||
* символ команды (по-умолчанию - восклицательный знак, задаётся в настройках модуля, отвечающего за конкретный чат-
|
||||
протокол) + команда + опциональная точка и любое количество пробельных символов.
|
||||
Ответ на эту фразу - одно произвольное предложение из предсгенерённого "мозга" с цепями Маркова.
|
||||
|
||||
* halp или хэлп
|
||||
- Для приватных чатов допустимой являются нотации:
|
||||
@@ -45,34 +50,34 @@
|
||||
* с префиксом в виде любого количества пробельных символов + имени бота + любое количество пробельных символов +
|
||||
опциональньная запятая + любое количество пробельных символов. После команды опциональная точка и любое
|
||||
количество пробельных символов.
|
||||
* символ команды (по-умолчанию - восклицательный знак, задаётся в настройках модуля, отвечающего за конкретны чат-
|
||||
* символ команды (по-умолчанию - восклицательный знак, задаётся в настройках модуля, отвечающего за конкретный чат-
|
||||
протокол) + команда + опциональная точка и любое количество пробельных символов.
|
||||
- Для публичных чатов допустимой являются нотации:
|
||||
* с префиксом в виде любого количества пробельных символов + имени бота + любое количество пробельных символов +
|
||||
опциональньная запятая + любое количество пробельных символов. После команды опциональная точка и любое
|
||||
количество пробельных символов.
|
||||
* символ команды (по-умолчанию - восклицательный знак, задаётся в настройках модуля, отвечающего за конкретны чат-
|
||||
* символ команды (по-умолчанию - восклицательный знак, задаётся в настройках модуля, отвечающего за конкретный чат-
|
||||
протокол) + команда + опциональная точка и любое количество пробельных символов.
|
||||
Ответ на эту фразу - слово "HALP!!!11".
|
||||
|
||||
* kde или кде
|
||||
- Для приватных и публичных чатов допустимой является нотация:
|
||||
* символ команды (по-умолчанию - восклицательный знак, задаётся в настройках модуля, отвечающего за конкретны чат-
|
||||
* символ команды (по-умолчанию - восклицательный знак, задаётся в настройках модуля, отвечающего за конкретный чат-
|
||||
протокол) + команда + опциональная точка и любое количество пробельных символов.
|
||||
Ответ на эту фразу - одно произвольное предложение из массива ответов на эту фразу.
|
||||
|
||||
* roll или dice или кости
|
||||
- Для приватных и публичных чатов допустимой является нотация:
|
||||
* символ команды (по-умолчанию - восклицательный знак, задаётся в настройках модуля, отвечающего за конкретны чат-
|
||||
* символ команды (по-умолчанию - восклицательный знак, задаётся в настройках модуля, отвечающего за конкретный чат-
|
||||
протокол) + команда + опциональная точка и любое количество пробельных символов.
|
||||
Ответ на эту фразу - "На первой кости выпало M, а на второй — N.", где M и N произвольные целые числа от 1 до 6
|
||||
включительно.
|
||||
|
||||
* ver или version или версия
|
||||
- Для приватных и публичных чатов допустимой является нотация:
|
||||
* символ команды (по-умолчанию - восклицательный знак, задаётся в настройках модуля, отвечающего за конкретны чат-
|
||||
* символ команды (по-умолчанию - восклицательный знак, задаётся в настройках модуля, отвечающего за конкретный чат-
|
||||
протокол) + команда + опциональная точка и любое количество пробельных символов.
|
||||
Ответ на эту фразу - номер версии ПО.
|
||||
Ответ на эту фразу - приблизительный номер версии ПО.
|
||||
|
||||
* кто все эти люди?
|
||||
- Для приватных и публичных чатов допустимой является нотация:
|
||||
|
||||
13
README
13
README
@@ -7,16 +7,17 @@ aleesa-craniac
|
||||
Механика работы
|
||||
-----------------------------------------------------------------------------------------------------------------------
|
||||
Бредогенератор подписан на redis-канал craniac. В этот канал пишет другой демоночек - aleesa-misc. Причём, особенность
|
||||
такова, что если aleesa-misc не распознала фразу как команду для другого модуля, то по-умолчанию такая фраза
|
||||
такова, что если aleesa-misc не распознала фразу, как команду для другого модуля, то по-умолчанию такая фраза
|
||||
оправляется в канал craniac, то есть сюда, в "мозги".
|
||||
|
||||
У бредогенератора есть 2 типа входящих сообщений - ключевые фразы, на которые у него есть готовые (статические) ответы
|
||||
и остальные, для которых ему надо решить нужен ли ответ и по-необходимости сгенерировать его, используя данные в цепях
|
||||
Маркова.
|
||||
|
||||
Ответ направляется в redis-канал, указанный в поле plugin входящего сообщения.
|
||||
Ответ направляется в redis-канал, указанный в поле plugin входящего сообщения, если не предполагается некоей особой
|
||||
логики, связанной с easter egg поведением.
|
||||
|
||||
Формат протокола - см README от aleesa-misc.
|
||||
Формат протокола - см. README от aleesa-misc.
|
||||
|
||||
|
||||
Как это запустить?
|
||||
@@ -30,3 +31,9 @@ aleesa-craniac
|
||||
|
||||
Если всё хорошо, то после запуска redis-а, создания data/config.json из data/config_sample.json, можно запускать и само
|
||||
приложение.
|
||||
|
||||
В каталоге contrib находится скрипт для alpine linux, системы инициализации openrc. Этот скрипт достаточно положить В
|
||||
/etc/init.d/aleesa-craniac сконфигурить сервис по инструкции выше и после этого сервис запускается командой:
|
||||
service aleesa-craniac start
|
||||
в автозагрузку его можно прописать через команду
|
||||
rc-update add aleesa-craniac default
|
||||
|
||||
@@ -11,7 +11,7 @@ use version; our $VERSION = qw (1.0);
|
||||
|
||||
my $workdir;
|
||||
|
||||
# before we run, change working dir
|
||||
# До фактического запуска логики программы, сменим рабочий каталог, чтобы подцепить либы
|
||||
BEGIN {
|
||||
use Cwd qw (chdir abs_path);
|
||||
my @CWD = split /\//xms, abs_path ($PROGRAM_NAME);
|
||||
@@ -31,6 +31,7 @@ use File::Basename qw (basename dirname);
|
||||
use File::Path qw (make_path);
|
||||
use Mojo::Log;
|
||||
use POSIX qw (setgid setuid setsid);
|
||||
|
||||
use Conf qw (LoadConf);
|
||||
use Craniac qw (RunCraniac);
|
||||
|
||||
@@ -43,7 +44,7 @@ my $runAsUid = $UID;
|
||||
|
||||
my $piddir = '/var/run/' . basename (abs_path ($PROGRAM_NAME));
|
||||
my $C = LoadConf ();
|
||||
my $loglevel = $C->{'loglevel'} // 'notice';
|
||||
my $loglevel = $C->{'loglevel'} // 'info';
|
||||
my $logfile;
|
||||
my $log;
|
||||
|
||||
@@ -53,7 +54,8 @@ if (defined $C->{'log'}) {
|
||||
$logfile = $C->{'debug_log'};
|
||||
}
|
||||
|
||||
# if we run under root, create pid dir and set correct owner for it, same for debug log if it is defined
|
||||
# Если мы запускаемся под рутом, то попробуем создать необходимые служебные каталоги и простать на них корректных
|
||||
# владельца и права
|
||||
if ($UID == 0) {
|
||||
my $user = $C->{user};
|
||||
|
||||
@@ -85,7 +87,7 @@ if ($UID == 0) {
|
||||
}
|
||||
}
|
||||
|
||||
# drop privs
|
||||
# Переключаемся на "рабочего" пользователя и сбрасываем привилегии.
|
||||
setgid ($gid) or die "Unable to switch to group of $user($OS_ERROR)\n";
|
||||
setuid ($uid) or die "Unable to switch to account $user($OS_ERROR)\n";
|
||||
} else {
|
||||
@@ -98,14 +100,14 @@ if (defined $logfile) {
|
||||
$log = Mojo::Log->new (path => '/dev/null', level => 'fatal');
|
||||
}
|
||||
|
||||
# по-умолчанию, демонизируемся, если явно не указано, что этого делать не надо
|
||||
# По-умолчанию, демонизируемся, если явно не указано, что этого делать не надо
|
||||
if (defined ($C->{daemonize}) && $C->{daemonize}) {
|
||||
daemonize ();
|
||||
} elsif ( ! defined ($C->{daemonize})) {
|
||||
daemonize ();
|
||||
}
|
||||
|
||||
# write pidfile
|
||||
# Запишем pid-файл
|
||||
my $apath = abs_path $PROGRAM_NAME;
|
||||
|
||||
unless (defined $apath) {
|
||||
@@ -128,13 +130,15 @@ print {$MYPID} $PID or do {
|
||||
|
||||
close $MYPID; ## no critic (InputOutput::RequireCheckedSyscalls
|
||||
|
||||
# При наличии хака в лице Mojo::IOLoop::Signal в Misc.pm, установка хэндлера в этом месте - это фактически
|
||||
# подстраховка на случай ядерной войны.
|
||||
local $SIG{INT} = \&__signal_handler;
|
||||
local $SIG{TERM} = \&__signal_handler;
|
||||
|
||||
# set correct proctitle
|
||||
# Поставим правильное имя процесса в proctitle
|
||||
$PROGRAM_NAME = abs_path $PROGRAM_NAME; ## no critic (Variables::RequireLocalizedPunctuationVars)
|
||||
|
||||
# run main app, at last
|
||||
# И запустим уже наш сервис
|
||||
RunCraniac ();
|
||||
|
||||
if (-f $pidfile) {
|
||||
@@ -147,8 +151,6 @@ sub daemonize {
|
||||
__fork ();
|
||||
POSIX::setsid ();
|
||||
open STDIN, '<', '/dev/null'; ## no critic (InputOutput::RequireCheckedSyscalls, InputOutput::RequireCheckedOpen)
|
||||
#open STDOUT, '>', '/dev/null'; ## no critic (InputOutput::RequireCheckedSyscalls, InputOutput::RequireCheckedOpen)
|
||||
#open STDERR, '>', '/dev/null'; ## no critic (InputOutput::RequireCheckedSyscalls, InputOutput::RequireCheckedOpen)
|
||||
__fork ();
|
||||
umask 0;
|
||||
return;
|
||||
|
||||
27
bin/train_lat.pl
Normal file
27
bin/train_lat.pl
Normal file
@@ -0,0 +1,27 @@
|
||||
#!/usr/bin/perl
|
||||
# Наполняет отдельный "мозг" с бредом латинскими выражениями
|
||||
|
||||
use 5.018;
|
||||
use strict;
|
||||
use warnings;
|
||||
use utf8;
|
||||
use open qw (:std :utf8);
|
||||
use English qw ( -no_match_vars );
|
||||
use version; our $VERSION = qw (1.0);
|
||||
|
||||
my $workdir;
|
||||
|
||||
# До фактического запуска логики программы, сменим рабочий каталог, чтобы подцепить либы
|
||||
BEGIN {
|
||||
use Cwd qw (chdir abs_path);
|
||||
my @CWD = split /\//xms, abs_path ($PROGRAM_NAME);
|
||||
if ($#CWD > 1) { $#CWD = $#CWD - 2; }
|
||||
$workdir = join '/', @CWD;
|
||||
chdir $workdir;
|
||||
}
|
||||
|
||||
use lib ("$workdir/lib", "$workdir/vendor_perl", "$workdir/vendor_perl/lib/perl5");
|
||||
use Craniac::Lat qw (Train);
|
||||
|
||||
Train ();
|
||||
exit 0;
|
||||
11
contrib/aleesa-craniac.openrc
Normal file
11
contrib/aleesa-craniac.openrc
Normal file
@@ -0,0 +1,11 @@
|
||||
#!/sbin/openrc-run
|
||||
|
||||
name="$SVCNAME"
|
||||
command="/var/lib/$SVCNAME/bin/$SVCNAME"
|
||||
pidfile="/var/run/$SVCNAME/$SVCNAME.pid"
|
||||
|
||||
depend() {
|
||||
need net redis
|
||||
use dns
|
||||
after redis
|
||||
}
|
||||
39
cpanfile
39
cpanfile
@@ -1,17 +1,22 @@
|
||||
requires 'Cwd';
|
||||
requires 'Cwd::utf8';
|
||||
requires 'Digest::SHA';
|
||||
requires 'Encode';
|
||||
requires 'English';
|
||||
requires 'File::Basename';
|
||||
requires 'File::Path';
|
||||
requires 'Hailo';
|
||||
requires 'JSON::XS';
|
||||
requires 'local::lib';
|
||||
requires 'Math::Random::Secure';
|
||||
requires 'Mojo::IOLoop';
|
||||
requires 'Mojo::Log';
|
||||
requires 'Mojo::Redis';
|
||||
requires 'POSIX';
|
||||
requires 'Protocol::Redis::XS';
|
||||
requires 'Text::Fuzzy';
|
||||
requires 'Carp', '==1.50';
|
||||
requires 'Cwd', '0';
|
||||
requires 'Cwd::utf8', '==0.011';
|
||||
requires 'Digest::SHA', '==6.02';
|
||||
requires 'Encode', '==3.16';
|
||||
requires 'English', '==1.11';
|
||||
requires 'File::Basename', '0';
|
||||
requires 'File::Path', '==2.18';
|
||||
requires 'Hailo', '==0.75';
|
||||
requires 'JSON::XS', '==4.03';
|
||||
requires 'local::lib', '==2.000028';
|
||||
requires 'Math::Random::Secure', '==0.080001';
|
||||
requires 'Mojolicious', '==9.22';
|
||||
requires 'Mojo::IOLoop', '0';
|
||||
requires 'Mojo::IOLoop::Signal', '==0.003';
|
||||
requires 'Mojo::Log', '0';
|
||||
requires 'Mojo::Redis', '==3.27';
|
||||
requires 'POSIX', '0';
|
||||
requires 'Protocol::Redis::XS', '0';
|
||||
requires 'Text::Fuzzy', '==0.29';
|
||||
requires 'utf8', '0';
|
||||
requires 'version', '==0.9929';
|
||||
|
||||
@@ -1,26 +1,32 @@
|
||||
{
|
||||
"server" : "redis",
|
||||
"port" : "6379",
|
||||
|
||||
# inbound redis channels, where we subscribed
|
||||
"channels": [
|
||||
"craniac",
|
||||
"channels" : [
|
||||
"craniac"
|
||||
],
|
||||
|
||||
# should we fork() and become unix daemon?
|
||||
"daemonize": 1,
|
||||
# should we fork() and become unix daemon?
|
||||
"daemonize" : 1,
|
||||
|
||||
# caches and other data goes there
|
||||
# caches and other data goes there
|
||||
"cachedir" : "data/cache",
|
||||
"braindir" : "data/brains",
|
||||
|
||||
# unprivileged system user to run bot as
|
||||
"user" : "nobody",
|
||||
|
||||
# logs goes there
|
||||
# logs goes there
|
||||
"log" : "/var/log/aleesa-craniac/aleesa-craniac.log",
|
||||
"loglevel": "info",
|
||||
"loglevel" : "info",
|
||||
|
||||
# ditto
|
||||
"pid" : "/var/run/aleesa-craniac/aleesa-craniac.pid"
|
||||
# ditto
|
||||
"pid" : "/var/run/aleesa-craniac/aleesa-craniac.pid",
|
||||
|
||||
# maximal amount of message forwardings, to avoid endless loops
|
||||
"forwards_max" : 5,
|
||||
|
||||
"lat" : {
|
||||
"brain" : "data/lat/brain.sqlite",
|
||||
"src" : "data/lat.txt"
|
||||
}
|
||||
}
|
||||
|
||||
1336
data/lat.txt
Normal file
1336
data/lat.txt
Normal file
File diff suppressed because it is too large
Load Diff
106
lib/Craniac.pm
106
lib/Craniac.pm
@@ -1,6 +1,6 @@
|
||||
package Craniac;
|
||||
# Предполагается, что craniac - это "маршрут по-умолчанию". То есть сюда попадают все фразы, которые не были распознаны
|
||||
# aleesa-misc как команды.
|
||||
# aleesa-misc как команды. В том числе и некоторые команды (но по идее это так и задумано).
|
||||
|
||||
# Основная задача мозгов - распознать, требуется ли ответ и обработать фразу.
|
||||
# Соответсвенно, мы предполагаем, что фразы делятся на 2 типа:
|
||||
@@ -20,6 +20,7 @@ use English qw ( -no_match_vars );
|
||||
use Digest::SHA qw (sha1_base64);
|
||||
use Hailo;
|
||||
use Mojo::IOLoop;
|
||||
use Mojo::IOLoop::Signal;
|
||||
use Mojo::Log;
|
||||
# Чтобы "уж точно" использовать hiredis-биндинги, загрузим этот модуль перед Mojo::Redis
|
||||
use Protocol::Redis::XS;
|
||||
@@ -28,6 +29,8 @@ use Math::Random::Secure qw (irand);
|
||||
use Text::Fuzzy qw (distance_edits);
|
||||
|
||||
use Conf qw (LoadConf);
|
||||
use Craniac::Lat qw (Lat);
|
||||
|
||||
use version; our $VERSION = qw (1.0);
|
||||
use Exporter qw (import);
|
||||
our @EXPORT_OK = qw (RunCraniac);
|
||||
@@ -40,6 +43,7 @@ sub RunCraniac ();
|
||||
|
||||
my $c = LoadConf ();
|
||||
my $loglevel = $c->{'loglevel'} // 'info';
|
||||
my $fwd_cnt = $c->{'forward_max'} // 5;
|
||||
my $logfile;
|
||||
my $log;
|
||||
|
||||
@@ -57,6 +61,8 @@ if (defined $logfile) {
|
||||
|
||||
my $hailo;
|
||||
|
||||
# Несколько фраз общего характера, используемые как универсальный ответ, когда ответить нечего (по тем или иным
|
||||
# причинам) или ответ не будет достаточно вменяемым (слишком похож на фразу, на которую отвечаем)
|
||||
sub RandomCommonPhrase () {
|
||||
my @myphrase = (
|
||||
'Так, блядь...',
|
||||
@@ -100,32 +106,37 @@ sub fmatch (@) {
|
||||
}
|
||||
}
|
||||
|
||||
# Ленивая инициализация мозга. Создаём/открываем мозг только если нам надо "подумать" а не на каждую входящую фразу.
|
||||
sub brains (@) {
|
||||
my $chatid = shift;
|
||||
my $telegram = shift // 0;
|
||||
|
||||
unless (defined $hailo->{$chatid}) {
|
||||
my $cid = $chatid;
|
||||
my $brainname;
|
||||
|
||||
# Костыль, чтобы не портировать данные из телеграммных мозгов
|
||||
# Костыль, чтобы не портировать данные из телеграммных мозгов и не заниматься переименованием
|
||||
unless ($telegram) {
|
||||
$cid = utf2sha1 ($chatid);
|
||||
$cid =~ s/\//-/xmsg;
|
||||
$brainname = sprintf '%s/%s.sqlite', $c->{braindir}, $cid;
|
||||
} else {
|
||||
$brainname = sprintf '%s/%s.brain.sqlite', $c->{braindir}, $cid;
|
||||
}
|
||||
|
||||
my $brainname = sprintf '%s/%s.sqlite', $c->{braindir}, $cid;
|
||||
|
||||
$hailo->{$chatid} = Hailo->new (
|
||||
$hailo->{$chatid} = eval {
|
||||
Hailo->new (
|
||||
brain => $brainname,
|
||||
order => 3
|
||||
);
|
||||
};
|
||||
|
||||
unless (defined $hailo->{$chatid}) {
|
||||
$log->warn ($EVAL_ERROR);
|
||||
if (defined $hailo->{$chatid}) {
|
||||
$log->info (sprintf '[INFO] Lazy init brain: %s', $brainname);
|
||||
} else {
|
||||
$log->error ("[ERROR] $EVAL_ERROR");
|
||||
return 0;
|
||||
}
|
||||
|
||||
$log->info (sprintf 'Lazy init brain: %s', $brainname);
|
||||
}
|
||||
|
||||
return 1;
|
||||
@@ -144,6 +155,18 @@ my $parse_message = sub {
|
||||
# Если $m->{misc}->{answer} не существует, то проставим его как 1, предполагаем, что по-умолчанию ответ от нас
|
||||
# всё-таки ожидают. Если что - уточним ниже.
|
||||
if (defined $m->{misc}) {
|
||||
unless (defined $m->{misc}->{fwd_cnt}) {
|
||||
$m->{misc}->{fwd_cnt} = 1;
|
||||
} else {
|
||||
if ($m->{misc}->{fwd_cnt} > $fwd_cnt) {
|
||||
$log->error ('[ERROR] Forward loop detected, discarding message.');
|
||||
$log->debug (Dumper $m);
|
||||
return;
|
||||
} else {
|
||||
$m->{misc}->{fwd_cnt}++;
|
||||
}
|
||||
}
|
||||
|
||||
unless (defined $m->{misc}->{answer}) {
|
||||
$m->{misc}->{answer} = 1;
|
||||
}
|
||||
@@ -170,6 +193,8 @@ my $parse_message = sub {
|
||||
# В ключевых фразах можно обратиться с некоторыми командами к боту по нику, не используя символ команды
|
||||
if ($m->{message} =~ /^\s*\Q;m->{misc}->{bot_nick}\E\s*;/ui) {
|
||||
$reply = 'Чего?';
|
||||
} elsif ($m->{message} =~ /^(\Q$m->{misc}->{csign}\E|\Q$m->{misc}->{bot_nick}\E\s*\,?\s+)ping\.?\s*$/i) {
|
||||
$reply = 'Pong.';
|
||||
} elsif ($m->{message} =~ /^(\Q$m->{misc}->{csign}\E|\Q$m->{misc}->{bot_nick}\E\s*\,?\s+)pong\.?\s*$/i) {
|
||||
$reply = 'Wat?';
|
||||
} elsif ($m->{message} =~ /^(\Q$m->{misc}->{csign}\E|\Q$m->{misc}->{bot_nick}\E\s*\,?\s+)пин(г|х)\.?\s*$/ui) {
|
||||
@@ -181,7 +206,9 @@ my $parse_message = sub {
|
||||
}
|
||||
} else {
|
||||
# Если нам не сообщили ник бота, то ищем команды, используя символ команды
|
||||
if ($m->{message} =~ /^\Q$m->{misc}->{csign}\Epong\.?\s*$/i) {
|
||||
if ($m->{message} =~ /^\Q$m->{misc}->{csign}\Eping\.?\s*$/ui) {
|
||||
$reply = 'Pong.';
|
||||
} elsif ($m->{message} =~ /^\Q$m->{misc}->{csign}\Epong\.?\s*$/i) {
|
||||
$reply = 'Wat?';
|
||||
} elsif ($m->{message} =~ /^\Q$m->{misc}->{csign}\Eпин(г|х)\.?\s*$/ui) {
|
||||
$reply = 'Понг.';
|
||||
@@ -189,8 +216,6 @@ my $parse_message = sub {
|
||||
$reply = 'Шта?';
|
||||
} elsif ($m->{message} =~ /^\Q$m->{misc}->{csign}\E(хэлп|halp)\s*$/ui) {
|
||||
$reply = 'HALP!!!11';
|
||||
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
@@ -227,6 +252,8 @@ my $parse_message = sub {
|
||||
$reply = sprintf 'На первой кости выпало %d, а на второй — %d.', irand (6) + 1, irand (6) + 1;
|
||||
} elsif ($m->{message} =~ /^\Q$m->{misc}->{csign}\E(ver|version|версия)$/ui) {
|
||||
$reply = 'Версия: Четыре.Технологическое_превью';
|
||||
} elsif ($m->{message} =~ /^\Q$m->{misc}->{csign}\E(lat|лат)\s*$/ui) {
|
||||
$reply = Lat ();
|
||||
}
|
||||
}
|
||||
|
||||
@@ -246,9 +273,26 @@ my $parse_message = sub {
|
||||
}
|
||||
} else {
|
||||
# Пока что нам нечего ответить, известных фраз не нашлось. Ищем дальше, на сей раз фразы, зависящие от режима
|
||||
# общения - приватного ли публичного.
|
||||
# общения - приватного или публичного.
|
||||
if ($m->{mode} eq 'private') {
|
||||
$phrase =~ s/^\s*(вот\s+)?скажи(\s*мне)?\s*//gui;
|
||||
# Если указанной в unless-е строки во фразе нету, то можно поискать другие приватные фразы
|
||||
unless ($phrase =~ s/^\s*(вот\s+)?скажи(\s*мне)?\s*//gui) {
|
||||
if ($phrase =~ /покажи +(сиськи|сиси|титьки)\s*$/ui) {
|
||||
$send_to = 'webapp';
|
||||
$reply = '!boobs';
|
||||
} elsif ($phrase =~ /show +(titts|tities|boobs)\s*$/i) {
|
||||
$send_to = 'webapp';
|
||||
$reply = '!boobs';
|
||||
} elsif ($phrase =~ /покажи +(попку|попу) *$/ui) {
|
||||
$send_to = 'webapp';
|
||||
$reply = '!ass';
|
||||
} elsif ($phrase =~ /show +(ass|butt|butty) *$/i) {
|
||||
$send_to = 'webapp';
|
||||
$reply = '!ass';
|
||||
}
|
||||
}
|
||||
|
||||
unless (defined $reply) {
|
||||
$phrase =~ s/\s*(,)?\s*а\s*\?$/?/gui;
|
||||
|
||||
if ($phrase =~ /^\s*кто\s+все\s+эти\s+люди\s*\?\s*$/ui) {
|
||||
@@ -258,6 +302,7 @@ my $parse_message = sub {
|
||||
} elsif ($phrase =~ /^\s*кто\s+(здесь|тут)\s*\?\s*$/ui) {
|
||||
$reply = 'Ты да я, да мы с тобой.';
|
||||
}
|
||||
}
|
||||
|
||||
# TODO: дописать запрос в webapp, для easter egg-ов, либо делать это на уровне aleesa-misc
|
||||
if (defined ($reply) && $m->{misc}->{answer}) {
|
||||
@@ -304,8 +349,14 @@ my $parse_message = sub {
|
||||
if ($m->{misc}->{answer}) {
|
||||
# Пытаемся что-то генерировать, если фраза длиннее 3-х букв
|
||||
if (length ($m->{message}) > 3) {
|
||||
my $telegram = 0;
|
||||
|
||||
if ($m->{plugin} eq 'telegram') {
|
||||
$telegram = 1;
|
||||
}
|
||||
|
||||
# Lazy brain init
|
||||
if (brains ($chatid, 1)) {
|
||||
if (brains ($chatid, $telegram)) {
|
||||
$reply = $hailo->{$chatid}->learn_reply ($m->{message});
|
||||
|
||||
# Если из реактора вернулся undef выдаём "общую" фразу из словаря
|
||||
@@ -337,7 +388,13 @@ my $parse_message = sub {
|
||||
} else {
|
||||
# пытаемся что-то запоминать, если фраза длиннее 3-х букв
|
||||
if (length ($m->{message}) > 3) {
|
||||
if (brains ($chatid, 1)) {
|
||||
my $telegram = 0;
|
||||
|
||||
if ($m->{plugin} eq 'telegram') {
|
||||
$telegram = 1;
|
||||
}
|
||||
|
||||
if (brains ($chatid, $telegram)) {
|
||||
$hailo->{$chatid}->learn ($m->{message});
|
||||
}
|
||||
}
|
||||
@@ -347,6 +404,18 @@ my $parse_message = sub {
|
||||
return;
|
||||
};
|
||||
|
||||
my $__signal_handler = sub {
|
||||
my ($self, $name) = @_;
|
||||
$log->info ("[INFO] Caught a signal $name");
|
||||
|
||||
if (defined $main::pidfile && -f $main::pidfile) {
|
||||
unlink $main::pidfile;
|
||||
}
|
||||
|
||||
exit 0;
|
||||
};
|
||||
|
||||
|
||||
# Main loop, он же event loop
|
||||
sub RunCraniac () {
|
||||
$log->info ("[INFO] Connecting to $c->{server}, $c->{port}");
|
||||
@@ -388,6 +457,11 @@ sub RunCraniac () {
|
||||
);
|
||||
}
|
||||
|
||||
Mojo::IOLoop::Signal->on (
|
||||
TERM => $__signal_handler,
|
||||
INT => $__signal_handler
|
||||
);
|
||||
|
||||
do { Mojo::IOLoop->start } until Mojo::IOLoop->is_running;
|
||||
return;
|
||||
}
|
||||
|
||||
90
lib/Craniac/Lat.pm
Normal file
90
lib/Craniac/Lat.pm
Normal file
@@ -0,0 +1,90 @@
|
||||
package Craniac::Lat;
|
||||
# Крылатые латинские выражения спёрты с https://ru.wikipedia.org/wiki/Список_крылатых_латинских_выражений
|
||||
|
||||
use 5.018;
|
||||
use strict;
|
||||
use warnings;
|
||||
use utf8;
|
||||
use open qw (:std :utf8);
|
||||
use English qw ( -no_match_vars );
|
||||
use Carp qw (cluck);
|
||||
use File::Basename qw (dirname);
|
||||
use File::Path qw (make_path);
|
||||
use Hailo;
|
||||
use Mojo::Log;
|
||||
|
||||
use Conf qw (LoadConf);
|
||||
|
||||
use version; our $VERSION = qw (1.0);
|
||||
use Exporter qw (import);
|
||||
our @EXPORT_OK = qw (Train Lat);
|
||||
|
||||
# В нашем случае среднее количество слов в фразе равно 3, поэтому ставим 2 :)
|
||||
my $brain_order = 2;
|
||||
|
||||
my $c = LoadConf ();
|
||||
my $brain = $c->{lat}->{brain};
|
||||
my $srcfile = $c->{lat}->{src};
|
||||
my $loglevel = $c->{'loglevel'} // 'info';
|
||||
my $log;
|
||||
|
||||
if (defined $c->{'log'}) {
|
||||
$logfile = $c->{'log'};
|
||||
} elsif (defined $c->{'debug_log'}) {
|
||||
$logfile = $c->{'debug_log'};
|
||||
}
|
||||
|
||||
if (defined $logfile) {
|
||||
$log = Mojo::Log->new (path => $logfile, level => $loglevel);
|
||||
} else {
|
||||
$log = Mojo::Log->new (path => '/dev/null', level => 'fatal');
|
||||
}
|
||||
|
||||
sub Train () {
|
||||
my $braindir = dirname $brain;
|
||||
|
||||
unless (-d $braindir) {
|
||||
make_path ($braindir) or do {
|
||||
cluck "Unable to create $braindir: $OS_ERROR";
|
||||
exit 1;
|
||||
};
|
||||
}
|
||||
|
||||
my $lat = Hailo->new (
|
||||
brain => $brain,
|
||||
order => $brain_order
|
||||
);
|
||||
|
||||
$lat->train ($srcfile);
|
||||
my ($tokens, $expressions) = ($lat->stats ())[0,1];
|
||||
printf "Total tokens: %s\nTotal expressions: %s\n", $tokens, $expressions;
|
||||
$lat->save ();
|
||||
return;
|
||||
}
|
||||
|
||||
# Просто вернём ответ
|
||||
sub Lat () {
|
||||
my $braindir = dirname $brain;
|
||||
|
||||
unless (-d $braindir) {
|
||||
$log->error ("[ERROR] No lat module data: $braindir is absent! Train lat first.");
|
||||
return '';
|
||||
}
|
||||
|
||||
unless (-f $brain) {
|
||||
$log->error ("[ERROR] No lat module data: $brain is absent! Train lat first.");
|
||||
return '';
|
||||
}
|
||||
|
||||
my $lat = Hailo->new (
|
||||
brain => $brain,
|
||||
order => $brain_order,
|
||||
save_on_exit => 0
|
||||
);
|
||||
|
||||
return $lat->reply ();
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
# vim: ft=perl noet ai ts=4 sw=4 sts=4:
|
||||
Reference in New Issue
Block a user