Move Lat module to aleesa-carniac

This commit is contained in:
eleksir
2022-01-04 17:55:14 +03:00
parent 40b9bb03c3
commit ae6b226c7c
7 changed files with 16 additions and 1450 deletions

1
README
View File

@@ -1,7 +1,6 @@
aleesa-phrases aleesa-phrases
----------------------------------------------------------------------------------------------------------------------- -----------------------------------------------------------------------------------------------------------------------
Отвечалка готовыми словарными фразами. Отвечалка готовыми словарными фразами.
* Фразы основанные на цепях маркова из крылатых латинских изречений
* Фортунки (на основе фраз из fortune_mod) * Фортунки (на основе фраз из fortune_mod)
* Пятница * Пятница
* Пословицы и поговорки * Пословицы и поговорки

View File

@@ -1,26 +0,0 @@
#!/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;
# before we run, change working dir
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 Lat qw (Train);
Train ();
exit 0;

View File

@@ -1,4 +1,4 @@
requires 'Carp', '0'; requires 'Carp', '==1.50';
requires 'Cwd::utf8', '==0.011'; requires 'Cwd::utf8', '==0.011';
requires 'Data::Dumper', '==2.183'; requires 'Data::Dumper', '==2.183';
requires 'Encode', '==3.16'; requires 'Encode', '==3.16';
@@ -6,7 +6,6 @@ requires 'English', '==1.11';
requires 'EV', '==4.33'; requires 'EV', '==4.33';
requires 'File::Basename', '0'; requires 'File::Basename', '0';
requires 'File::Path', '==2.18'; requires 'File::Path', '==2.18';
requires 'Hailo', '==0.75';
requires 'JSON', '==4.03'; requires 'JSON', '==4.03';
requires 'JSON::XS', '==4.03'; requires 'JSON::XS', '==4.03';
requires 'local::lib', '==2.000028'; requires 'local::lib', '==2.000028';

View File

@@ -22,11 +22,6 @@
# maximal amount of message forwardings, to avoid endless loops # maximal amount of message forwardings, to avoid endless loops
"forwards_max" : 5, "forwards_max" : 5,
"lat" : {
"brain": "data/lat/brain.sqlite",
"src": "data/lat.txt"
},
"fortune" : { "fortune" : {
"dir" : "data/fortune", "dir" : "data/fortune",
"srcdir" : "data/fortune_src" "srcdir" : "data/fortune_src"

File diff suppressed because it is too large Load Diff

View File

@@ -1,75 +0,0 @@
package 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 Log::Any qw ($log);
use Conf qw (LoadConf);
use version; our $VERSION = qw (1.0);
use Exporter qw (import);
our @EXPORT_OK = qw (Train Lat);
my $c = LoadConf ();
my $brain = $c->{lat}->{brain};
my $srcfile = $c->{lat}->{src};
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,
# В нашем случае среднее количество слов в фразе равно 3
order => 2
);
$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,
# В нашем случае среднее количество слов в фразе равно 3
order => 2,
save_on_exit => 0
);
return $lat->reply ();
}
1;
# vim: ft=perl noet ai ts=4 sw=4 sts=4:

View File

@@ -19,7 +19,6 @@ use Data::Dumper;
use Conf qw (LoadConf); use Conf qw (LoadConf);
use Fortune qw (Fortune); use Fortune qw (Fortune);
use Friday qw (Friday); use Friday qw (Friday);
use Lat qw (Lat);
use Proverb qw (Proverb); use Proverb qw (Proverb);
use version; our $VERSION = qw (1.0); use version; our $VERSION = qw (1.0);
@@ -34,6 +33,7 @@ my $parse_message = sub {
my $self = shift; my $self = shift;
my $m = shift; my $m = shift;
my $answer = $m; my $answer = $m;
$answer->{from} = 'phrases';
my $send_to = $m->{plugin}; my $send_to = $m->{plugin};
my $reply; my $reply;
@@ -60,21 +60,31 @@ my $parse_message = sub {
} else { } else {
$answer->{misc}->{answer} = 1; $answer->{misc}->{answer} = 1;
$answer->{misc}->{csign} = '!'; $answer->{misc}->{csign} = '!';
$answer->{misc}->{msg_format} = 0;
} }
$log->debug ('[DEBUG] Incoming message ' . Dumper ($m)); $log->debug ('[DEBUG] Incoming message ' . Dumper ($m));
if (substr ($m->{message}, 0, 1) eq $answer->{misc}->{csign}) { if (substr ($m->{message}, 0, 1) eq $answer->{misc}->{csign}) {
if ((substr ($m->{message}, 1) eq 'lat' || substr ($m->{message}, 1) eq 'лат')) { if (substr ($m->{message}, 1) eq 'friday' || substr ($m->{message}, 1) eq 'пятница') {
$reply = Lat ();
} elsif (substr ($m->{message}, 1) eq 'friday' || substr ($m->{message}, 1) eq 'пятница') {
$reply = Friday (); $reply = Friday ();
} elsif (substr ($m->{message}, 1) eq 'proverb' || substr ($m->{message}, 1) eq 'пословица') { } elsif (substr ($m->{message}, 1) eq 'proverb' || substr ($m->{message}, 1) eq 'пословица') {
$reply = Proverb (); $reply = Proverb ();
} elsif (substr ($m->{message}, 1) eq 'fortune' || substr ($m->{message}, 1) eq 'фортунка' || } elsif (substr ($m->{message}, 1) eq 'fortune' || substr ($m->{message}, 1) eq 'фортунка' ||
substr ($m->{message}, 1) eq 'f' || substr ($m->{message}, 1) eq 'ф') { substr ($m->{message}, 1) eq 'f' || substr ($m->{message}, 1) eq 'ф') {
if ($m->{plugin} eq 'telegram') { if ($m->{plugin} eq 'telegram') {
$reply = sprintf "```\n%s\n```\n", trim (Fortune ()); 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 { } else {
$reply = trim (Fortune ()); $reply = trim (Fortune ());
} }