Compare commits
3 Commits
7b32737b33
...
ouput_json
| Author | SHA1 | Date | |
|---|---|---|---|
|
4706322c4e | ||
|
|
03634958a1 | ||
|
|
6eeb8e7b89 |
169
lib/Craniac.pm
169
lib/Craniac.pm
@@ -145,45 +145,70 @@ my $parse_message = sub {
|
||||
my $phrase = $m->{message};
|
||||
my $reply;
|
||||
|
||||
# Если $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}++;
|
||||
if (defined $answer->{misc}) {
|
||||
unless (defined $answer->{misc}->{answer}) {
|
||||
$answer->{misc}->{answer} = 1;
|
||||
}
|
||||
}
|
||||
|
||||
unless (defined $m->{misc}->{answer}) {
|
||||
$m->{misc}->{answer} = 1;
|
||||
}
|
||||
unless (defined $answer->{misc}->{bot_nick}) {
|
||||
$answer->{misc}->{bot_nick} = '';
|
||||
}
|
||||
|
||||
unless (defined $m->{misc}->{csign}) {
|
||||
$m->{misc}->{csign} = $c->{csign};
|
||||
}
|
||||
unless (defined $answer->{misc}->{csign}) {
|
||||
$answer->{misc}->{csign} = $c->{csign};
|
||||
}
|
||||
|
||||
unless (defined $m->{misc}->{bot_nick}) {
|
||||
$m->{misc}->{bot_nick} = '';
|
||||
}
|
||||
unless (defined $answer->{misc}->{fwd_cnt}) {
|
||||
$answer->{misc}->{fwd_cnt} = 1;
|
||||
} else {
|
||||
if ($answer->{misc}->{fwd_cnt} > $fwd_cnt) {
|
||||
$log->error ('[ERROR] Forward loop detected, discarding message.');
|
||||
$log->debug (Dumper $m);
|
||||
return;
|
||||
} else {
|
||||
$answer->{misc}->{fwd_cnt}++;
|
||||
}
|
||||
}
|
||||
|
||||
unless (defined $answer->{misc}->{good_morning}) {
|
||||
$answer->{misc}->{good_morning} = 0;
|
||||
}
|
||||
|
||||
unless (defined $answer->{misc}->{msg_format}) {
|
||||
$answer->{misc}->{msg_format} = 0;
|
||||
}
|
||||
|
||||
unless (defined $answer->{misc}->{username}) {
|
||||
$answer->{misc}->{username} = 'user';
|
||||
}
|
||||
} else {
|
||||
$m->{misc}->{answer} = 1;
|
||||
$m->{misc}->{csign} = $c->{csign};
|
||||
$m->{misc}->{bot_nick} = '';
|
||||
$answer->{misc}->{answer} = 1;
|
||||
$answer->{misc}->{bot_nick} = '';
|
||||
$answer->{misc}->{csign} = $c->{csign};
|
||||
$answer->{misc}->{fwd_cnt} = 1;
|
||||
$answer->{misc}->{good_morning} = 0;
|
||||
$answer->{misc}->{msg_format} = 0;
|
||||
$answer->{misc}->{username} = 'user';
|
||||
}
|
||||
|
||||
my $csign = $m->{misc}->{csign};
|
||||
my $csign = $answer->{misc}->{csign};
|
||||
$answer->{message} = '';
|
||||
|
||||
my $is_command = 0;
|
||||
my $cmd = $m->{message};
|
||||
|
||||
if ($m->{message} =~ /^\Q$csign/u) {
|
||||
$cmd = substr $m->{message}, length ($csign);
|
||||
$is_command = 1;
|
||||
}
|
||||
|
||||
if ($m->{misc}->{bot_nick} ne '') {
|
||||
# Если нам сообщили ник бота, попробуем вымарать его из оригинального текста сообщения, в большинстве случаев он
|
||||
# нам не интересн.
|
||||
# нам не интересен.
|
||||
$phrase =~ s/\s*\,?\s*($m->{misc}->{bot_nick})\s*\,?\s*/ /gui;
|
||||
|
||||
# TODO: проработать реакцию на "пьяный бред".
|
||||
|
||||
# В ключевых фразах можно обратиться с некоторыми командами к боту по нику, не используя символ команды
|
||||
if ($m->{message} =~ /^\s*\Q$m->{misc}->{bot_nick}\E\s*$/ui) {
|
||||
$reply = 'Чего?';
|
||||
@@ -200,54 +225,59 @@ my $parse_message = sub {
|
||||
}
|
||||
} else {
|
||||
# Если нам не сообщили ник бота, то ищем команды, используя символ команды
|
||||
if ($m->{message} =~ /^\Q$csign\Eping\.?\s*$/ui) {
|
||||
$reply = 'Pong.';
|
||||
} elsif ($m->{message} =~ /^\Q$csign\Epong\.?\s*$/i) {
|
||||
$reply = 'Wat?';
|
||||
} elsif ($m->{message} =~ /^\Q$csign\Eпин(г|х)\.?\s*$/ui) {
|
||||
$reply = 'Понг.';
|
||||
} elsif ($m->{message} =~ /^\Q$csign\Eпон(г|х)\.?\s*$/ui) {
|
||||
$reply = 'Шта?';
|
||||
} elsif ($m->{message} =~ /^\Q$csign\E(хэлп|halp)\s*$/ui) {
|
||||
$reply = 'HALP!!!11';
|
||||
if ($is_command) {
|
||||
if ($cmd =~ /^ping\.?\s*$/ui) {
|
||||
$reply = 'Pong.';
|
||||
} elsif ($cmd =~ /^pong\.?\s*$/i) {
|
||||
$reply = 'Wat?';
|
||||
} elsif ($cmd=~ /^пин(г|х)\.?\s*$/ui) {
|
||||
$reply = 'Понг.';
|
||||
} elsif ($cmd =~ /^пон(г|х)\.?\s*$/ui) {
|
||||
$reply = 'Шта?';
|
||||
} elsif ($cmd=~ /^(хэлп|halp)\s*$/ui) {
|
||||
$reply = 'HALP!!!11';
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
# Поищем в тексте входящего сообщения команды общего плана, с символом команды.
|
||||
unless (defined $reply) {
|
||||
if ($m->{message} =~ /^\Q$csign\E(kde|кде)\s*$/ui) {
|
||||
my @phrases = (
|
||||
'Нет, я не буду поднимать вам плазму.',
|
||||
'Повторяйте эту мантру по утрам не менее 5 раз: "Плазма не падает." И, возможно, она перестанет у вас падать.',
|
||||
'Плазма не падает, она просто выходит отдохнуть.',
|
||||
'Плазма это не агрегатное состояние, это суперпозиция. Во время работы она находится сразу в жидком, мягком и тёплом состояниях.',
|
||||
);
|
||||
if ($is_command) {
|
||||
if ($cmd =~ /^(kde|кде)\s*$/ui) {
|
||||
my @phrases = (
|
||||
'Нет, я не буду поднимать вам плазму.',
|
||||
'Повторяйте эту мантру по утрам не менее 5 раз: "Плазма не падает." И, возможно, она перестанет у вас падать.',
|
||||
'Плазма не падает, она просто выходит отдохнуть.',
|
||||
'Плазма это не агрегатное состояние, это суперпозиция. Во время работы она находится сразу в жидком, мягком и тёплом состояниях.',
|
||||
);
|
||||
|
||||
$reply = $phrases[irand ($#phrases + 1)];
|
||||
} elsif ($m->{message} =~ /^\Q$csign\E(coin|монетка)$/ui) {
|
||||
if (rand (101) < 0.016) {
|
||||
$reply = 'ребро';
|
||||
} else {
|
||||
if (irand (2) == 0) {
|
||||
if (irand (2) == 0) {
|
||||
$reply = 'орёл';
|
||||
} else {
|
||||
$reply = 'аверс';
|
||||
}
|
||||
$reply = $phrases[irand ($#phrases + 1)];
|
||||
} elsif ($cmd =~ /^(coin|монетка)$/ui) {
|
||||
# Нам тут говорили, что есть некая вероятность, что монета упадёт ребром... И даже цифры называли.
|
||||
if (rand (101) < 0.016) {
|
||||
$reply = 'ребро';
|
||||
} else {
|
||||
if (irand (2) == 0) {
|
||||
$reply = 'решка';
|
||||
if (irand (2) == 0) {
|
||||
$reply = 'орёл';
|
||||
} else {
|
||||
$reply = 'аверс';
|
||||
}
|
||||
} else {
|
||||
$reply = 'реверс';
|
||||
if (irand (2) == 0) {
|
||||
$reply = 'решка';
|
||||
} else {
|
||||
$reply = 'реверс';
|
||||
}
|
||||
}
|
||||
}
|
||||
} elsif ($cmd =~ /^(roll|dice|кости)$/ui) {
|
||||
$reply = sprintf 'На первой кости выпало %d, а на второй — %d.', irand (6) + 1, irand (6) + 1;
|
||||
} elsif ($cmd =~ /^(ver|version|версия)$/ui) {
|
||||
$reply = 'Версия: Четыре.Технологическое_превью';
|
||||
} elsif ($cmd =~ /^(lat|лат)\s*$/ui) {
|
||||
$reply = Lat ();
|
||||
}
|
||||
} elsif ($m->{message} =~ /^\Q$csign\E(roll|dice|кости)$/ui) {
|
||||
$reply = sprintf 'На первой кости выпало %d, а на второй — %d.', irand (6) + 1, irand (6) + 1;
|
||||
} elsif ($m->{message} =~ /^\Q$csign\E(ver|version|версия)$/ui) {
|
||||
$reply = 'Версия: Четыре.Технологическое_превью';
|
||||
} elsif ($m->{message} =~ /^\Q$csign\E(lat|лат)\s*$/ui) {
|
||||
$reply = Lat ();
|
||||
}
|
||||
}
|
||||
|
||||
@@ -258,7 +288,7 @@ my $parse_message = sub {
|
||||
$answer->{message} = $reply;
|
||||
|
||||
$self->json ($send_to)->notify (
|
||||
$send_to => = $answer,
|
||||
$send_to => $answer,
|
||||
);
|
||||
}
|
||||
} else {
|
||||
@@ -329,10 +359,11 @@ my $parse_message = sub {
|
||||
|
||||
# Попадаем сюда только если входящая фраза не распознана ранее как ключевая.
|
||||
if ($m->{misc}->{answer}) {
|
||||
# Пытаемся что-то генерировать, если фраза длиннее 3-х букв
|
||||
# Пытаемся что-то генерировать, если фраза длиннее 3-х букв.
|
||||
if (length ($m->{message}) > 3) {
|
||||
my $telegram = 0;
|
||||
|
||||
# Костыль для совместимости со старым наименованием "мозгов".
|
||||
if ($m->{plugin} eq 'telegram') {
|
||||
$telegram = 1;
|
||||
}
|
||||
@@ -341,16 +372,16 @@ my $parse_message = sub {
|
||||
if (brains ($chatid, $telegram)) {
|
||||
$reply = $hailo->{$chatid}->learn_reply ($m->{message});
|
||||
|
||||
# Если из реактора вернулся undef выдаём "общую" фразу из словаря
|
||||
# Если из реактора вернулся undef выдаём "общую" фразу из словаря.
|
||||
unless (defined $reply) {
|
||||
$reply = RandomCommonPhrase ();
|
||||
} else {
|
||||
# Если из реактора вернулась пустота выдаём "общую" фразу из словаря
|
||||
# Если из реактора вернулась пустота выдаём "общую" фразу из словаря.
|
||||
if ($reply eq '') {
|
||||
$reply = RandomCommonPhrase ();
|
||||
}
|
||||
|
||||
# Если сгенерированная фраза слишком похожа на начальную - выдаём "общую" фразу из словаря
|
||||
# Если сгенерированная фраза слишком похожа на начальную - выдаём "общую" фразу из словаря.
|
||||
if (fmatch (lc ($m->{message}), lc ($reply))) {
|
||||
$reply = RandomCommonPhrase ();
|
||||
}
|
||||
@@ -364,7 +395,7 @@ my $parse_message = sub {
|
||||
}
|
||||
}
|
||||
} else {
|
||||
# пытаемся что-то запоминать, если фраза длиннее 3-х букв
|
||||
# Пытаемся что-то запоминать, если фраза длиннее 3-х букв
|
||||
if (length ($m->{message}) > 3) {
|
||||
my $telegram = 0;
|
||||
|
||||
|
||||
Reference in New Issue
Block a user