Add famous latin prases module
This commit is contained in:
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 vars qw/$VERSION/;
|
||||||
|
$VERSION = '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;
|
||||||
1336
data/phrases.txt
Normal file
1336
data/phrases.txt
Normal file
File diff suppressed because it is too large
Load Diff
@@ -1,5 +1,6 @@
|
|||||||
{
|
{
|
||||||
"user" : "nobody",
|
"user" : "nobody",
|
||||||
|
"debug_log" : "/var/log/aleesa-telegram-bot/debug.log",
|
||||||
"telegrambot" : {
|
"telegrambot" : {
|
||||||
"name" : "mybot",
|
"name" : "mybot",
|
||||||
"tname" : "@my_bot",
|
"tname" : "@my_bot",
|
||||||
@@ -12,5 +13,7 @@
|
|||||||
"cachedata": "data/cache/openweathermap.Id-Data.db",
|
"cachedata": "data/cache/openweathermap.Id-Data.db",
|
||||||
"appid": "get_it_on_openweathermap.org"
|
"appid": "get_it_on_openweathermap.org"
|
||||||
},
|
},
|
||||||
"debug_log" : "/var/log/aleesa-telegram-bot/debug.log"
|
"lat" : {
|
||||||
|
"brain": "data/lat/lat.sqlite"
|
||||||
|
}
|
||||||
}
|
}
|
||||||
|
|||||||
76
lib/lat.pm
Normal file
76
lib/lat.pm
Normal file
@@ -0,0 +1,76 @@
|
|||||||
|
package lat;
|
||||||
|
# famous latin phases taken from 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 vars qw/$VERSION/;
|
||||||
|
use Exporter qw(import);
|
||||||
|
our @EXPORT_OK = qw(train latAnswer);
|
||||||
|
|
||||||
|
$VERSION = '1.0';
|
||||||
|
|
||||||
|
use Hailo;
|
||||||
|
use File::Basename qw(dirname);
|
||||||
|
use File::Path qw(mkpath);
|
||||||
|
use conf qw(loadConf);
|
||||||
|
use botlib qw(logger);
|
||||||
|
|
||||||
|
my $c = loadConf();
|
||||||
|
my $brain = $c->{lat}->{brain};
|
||||||
|
|
||||||
|
# swallow phrase and return answer
|
||||||
|
sub train () {
|
||||||
|
my $braindir = dirname ($brain);
|
||||||
|
|
||||||
|
unless (-d $braindir) {
|
||||||
|
mkpath ($braindir) or do {
|
||||||
|
logger "Unable to create $braindir: $OS_ERROR";
|
||||||
|
exit 1;
|
||||||
|
};
|
||||||
|
}
|
||||||
|
|
||||||
|
my $lat = Hailo->new (
|
||||||
|
brain => $brain,
|
||||||
|
# in our case mean amount of words in phase is 3
|
||||||
|
order => 2
|
||||||
|
);
|
||||||
|
|
||||||
|
$lat->train('data/phrases.txt');
|
||||||
|
my ($tokens, $expressions) = ($lat->stats())[0,1];
|
||||||
|
printf "Total tokens: %s\nTotal expressins: %s\n", $tokens, $expressions;
|
||||||
|
$lat->save();
|
||||||
|
return;
|
||||||
|
}
|
||||||
|
|
||||||
|
# just return answer
|
||||||
|
sub latAnswer () {
|
||||||
|
my $braindir = dirname ($brain);
|
||||||
|
|
||||||
|
unless (-d $braindir) {
|
||||||
|
logger ("No lat module data: $braindir is absent! Train lat first.");
|
||||||
|
return '';
|
||||||
|
}
|
||||||
|
|
||||||
|
unless (-f $brain) {
|
||||||
|
logger ("No lat module data: $brain is absent! Train lat first.");
|
||||||
|
return '';
|
||||||
|
}
|
||||||
|
|
||||||
|
my $lat = Hailo->new (
|
||||||
|
brain => $brain,
|
||||||
|
# in our case mean amount of words in phase is 3
|
||||||
|
order => 2,
|
||||||
|
save_on_exit => 0
|
||||||
|
);
|
||||||
|
|
||||||
|
return $lat->reply();
|
||||||
|
}
|
||||||
|
|
||||||
|
1;
|
||||||
|
|
||||||
|
# vim: ft=perl noet ai ts=4 sw=4 sts=4:
|
||||||
@@ -16,6 +16,7 @@ use Mojo::Base 'Telegram::Bot::Brain';
|
|||||||
use conf qw(loadConf);
|
use conf qw(loadConf);
|
||||||
use botlib qw(weather logger trim randomCommonPhrase);
|
use botlib qw(weather logger trim randomCommonPhrase);
|
||||||
use telegramlib qw(getChat getChatMember sendChatAction visavi);
|
use telegramlib qw(getChat getChatMember sendChatAction visavi);
|
||||||
|
use lat qw(latAnswer);
|
||||||
|
|
||||||
use Exporter qw(import);
|
use Exporter qw(import);
|
||||||
our @EXPORT_OK = qw(run_telegrambot);
|
our @EXPORT_OK = qw(run_telegrambot);
|
||||||
@@ -211,6 +212,8 @@ sub __on_msg {
|
|||||||
} elsif (substr ($text, 1, 2) eq 'w ' || substr ($text, 1, 2) eq 'п ') {
|
} elsif (substr ($text, 1, 2) eq 'w ' || substr ($text, 1, 2) eq 'п ') {
|
||||||
my $city = substr ($text, 2);
|
my $city = substr ($text, 2);
|
||||||
$reply = weather ($city);
|
$reply = weather ($city);
|
||||||
|
} elsif ((length ($text) == 4) && (substr ($text, 1, 3) eq 'lat' || substr ($text, 1, 2) eq 'лат')) {
|
||||||
|
$reply = latAnswer();
|
||||||
} else {
|
} else {
|
||||||
$reply = 'Чего?';
|
$reply = 'Чего?';
|
||||||
}
|
}
|
||||||
@@ -312,6 +315,7 @@ sub __on_msg {
|
|||||||
!help | !помощь - список команд
|
!help | !помощь - список команд
|
||||||
!w город | !п город - погода в указанном городе
|
!w город | !п город - погода в указанном городе
|
||||||
!ping | !пинг - попинговать бота
|
!ping | !пинг - попинговать бота
|
||||||
|
!lat | !лат - сгенерировать фразу из крылатых латинских выражений
|
||||||
```
|
```
|
||||||
Но на самом деле я бот больше для общения, чем для исполнения команд.
|
Но на самом деле я бот больше для общения, чем для исполнения команд.
|
||||||
Поговоришь со мной?
|
Поговоришь со мной?
|
||||||
@@ -331,6 +335,8 @@ MYHELP
|
|||||||
} elsif (substr ($text, 1, 2) eq 'w ' || substr ($text, 1, 2) eq 'п ') {
|
} elsif (substr ($text, 1, 2) eq 'w ' || substr ($text, 1, 2) eq 'п ') {
|
||||||
my $city = substr ($text, 3);
|
my $city = substr ($text, 3);
|
||||||
$reply = weather ($city);
|
$reply = weather ($city);
|
||||||
|
} elsif (length ($text) == 4 && (substr ($text, 1, 3) eq 'lat' || substr ($text, 1, 3) eq 'лат')) {
|
||||||
|
$reply = latAnswer();
|
||||||
}
|
}
|
||||||
} elsif (
|
} elsif (
|
||||||
($text eq $qname) or
|
($text eq $qname) or
|
||||||
|
|||||||
Reference in New Issue
Block a user