Move Lat module to aleesa-carniac
This commit is contained in:
1
README
1
README
@@ -1,7 +1,6 @@
|
|||||||
aleesa-phrases
|
aleesa-phrases
|
||||||
-----------------------------------------------------------------------------------------------------------------------
|
-----------------------------------------------------------------------------------------------------------------------
|
||||||
Отвечалка готовыми словарными фразами.
|
Отвечалка готовыми словарными фразами.
|
||||||
* Фразы основанные на цепях маркова из крылатых латинских изречений
|
|
||||||
* Фортунки (на основе фраз из fortune_mod)
|
* Фортунки (на основе фраз из fortune_mod)
|
||||||
* Пятница
|
* Пятница
|
||||||
* Пословицы и поговорки
|
* Пословицы и поговорки
|
||||||
|
|||||||
@@ -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;
|
|
||||||
3
cpanfile
3
cpanfile
@@ -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';
|
||||||
|
|||||||
@@ -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"
|
||||||
|
|||||||
1336
data/lat.txt
1336
data/lat.txt
File diff suppressed because it is too large
Load Diff
75
lib/Lat.pm
75
lib/Lat.pm
@@ -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:
|
|
||||||
@@ -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 ());
|
||||||
}
|
}
|
||||||
|
|||||||
Reference in New Issue
Block a user