Fix fortune src filename check and another pack of style and natural language fixes

This commit is contained in:
eleksir
2021-02-09 00:57:08 +03:00
parent 5d0fe793fd
commit 041ab3efeb
13 changed files with 58 additions and 59 deletions

View File

@@ -72,7 +72,7 @@ if ($UID == 0) {
} }
if (defined $logfile) { if (defined $logfile) {
my $logdir = dirname ($logfile); my $logdir = dirname $logfile;
unless (-d $logdir) { unless (-d $logdir) {
make_path ( make_path (

View File

@@ -4,15 +4,15 @@ use 5.018;
use strict; use strict;
use warnings; use warnings;
use utf8; use utf8;
use open qw(:std :utf8); use open qw (:std :utf8);
use English qw( -no_match_vars ); use English qw ( -no_match_vars );
use version; our $VERSION = qw (1.0); use version; our $VERSION = qw (1.0);
my $workdir; my $workdir;
# before we run, change working dir # before we run, change working dir
BEGIN { BEGIN {
use Cwd qw(chdir abs_path); use Cwd qw (chdir abs_path);
my @CWD = split /\//xms, abs_path ($PROGRAM_NAME); my @CWD = split /\//xms, abs_path ($PROGRAM_NAME);
if ($#CWD > 1) { $#CWD = $#CWD - 2; } if ($#CWD > 1) { $#CWD = $#CWD - 2; }
$workdir = join '/', @CWD; $workdir = join '/', @CWD;
@@ -20,7 +20,7 @@ BEGIN {
} }
use lib ("$workdir/lib", "$workdir/vendor_perl", "$workdir/vendor_perl/lib/perl5"); use lib ("$workdir/lib", "$workdir/vendor_perl", "$workdir/vendor_perl/lib/perl5");
use fortune qw(seed fortune); use fortune qw (seed);
use Carp; use Carp;
local $SIG{__DIE__} = sub { Carp::confess @_ }; local $SIG{__DIE__} = sub { Carp::confess @_ };

View File

@@ -4,15 +4,15 @@ use 5.018;
use strict; use strict;
use warnings; use warnings;
use utf8; use utf8;
use open qw(:std :utf8); use open qw (:std :utf8);
use English qw( -no_match_vars ); use English qw ( -no_match_vars );
use version; our $VERSION = qw (1.0); use version; our $VERSION = qw (1.0);
my $workdir; my $workdir;
# before we run, change working dir # before we run, change working dir
BEGIN { BEGIN {
use Cwd qw(chdir abs_path); use Cwd qw (chdir abs_path);
my @CWD = split /\//xms, abs_path ($PROGRAM_NAME); my @CWD = split /\//xms, abs_path ($PROGRAM_NAME);
if ($#CWD > 1) { $#CWD = $#CWD - 2; } if ($#CWD > 1) { $#CWD = $#CWD - 2; }
$workdir = join '/', @CWD; $workdir = join '/', @CWD;
@@ -20,7 +20,7 @@ BEGIN {
} }
use lib ("$workdir/lib", "$workdir/vendor_perl", "$workdir/vendor_perl/lib/perl5"); use lib ("$workdir/lib", "$workdir/vendor_perl", "$workdir/vendor_perl/lib/perl5");
use friday qw(seed); use friday qw (seed);
seed (); seed ();
exit 0; exit 0;

View File

@@ -4,15 +4,15 @@ use 5.018;
use strict; use strict;
use warnings; use warnings;
use utf8; use utf8;
use open qw(:std :utf8); use open qw (:std :utf8);
use English qw( -no_match_vars ); use English qw ( -no_match_vars );
use version; our $VERSION = qw (1.0); use version; our $VERSION = qw (1.0);
my $workdir; my $workdir;
# before we run, change working dir # before we run, change working dir
BEGIN { BEGIN {
use Cwd qw(chdir abs_path); use Cwd qw (chdir abs_path);
my @CWD = split /\//xms, abs_path ($PROGRAM_NAME); my @CWD = split /\//xms, abs_path ($PROGRAM_NAME);
if ($#CWD > 1) { $#CWD = $#CWD - 2; } if ($#CWD > 1) { $#CWD = $#CWD - 2; }
$workdir = join '/', @CWD; $workdir = join '/', @CWD;
@@ -20,7 +20,7 @@ BEGIN {
} }
use lib ("$workdir/lib", "$workdir/vendor_perl", "$workdir/vendor_perl/lib/perl5"); use lib ("$workdir/lib", "$workdir/vendor_perl", "$workdir/vendor_perl/lib/perl5");
use lat qw(train); use lat qw (train);
train (); train ();
exit 0; exit 0;

View File

@@ -4,16 +4,16 @@ use 5.018;
use strict; use strict;
use warnings; use warnings;
use utf8; use utf8;
use open qw(:std :utf8); use open qw (:std :utf8);
use English qw( -no_match_vars ); use English qw ( -no_match_vars );
use lib qw(./lib ./vendor_perl ./vendor_perl/lib/perl5); use lib qw (./lib ./vendor_perl ./vendor_perl/lib/perl5);
use JSON::XS; use JSON::XS;
use version; our $VERSION = qw (1.0); use version; our $VERSION = qw (1.0);
my $c = 'data/config.json'; my $c = 'data/config.json';
open (my $C, '<', $c) or die "No conf at $c: $OS_ERROR\n"; open (my $C, '<', $c) or die "No conf at $c: $OS_ERROR\n";
my $len = (stat ($c)) [7]; my $len = (stat $c) [7];
my $json; my $json;
my $readlen = read ($C, $json, $len); my $readlen = read ($C, $json, $len);

View File

@@ -31,7 +31,7 @@ sub dig {
'ледяную глыбу', 'ледяную глыбу',
'лунный грунт', 'лунный грунт',
'мамонта', 'мамонта',
'мамонтенка', 'мамонтёнка',
'метеорит', 'метеорит',
'мумию фараона Тутанхамона', 'мумию фараона Тутанхамона',
'носки прапорщика (поставит в угол)', 'носки прапорщика (поставит в угол)',
@@ -115,7 +115,7 @@ sub dig {
$phrase .= sprintf '%s стал лучшим археологом, выкопав %s! возраст артефакта - %s лет!', $name, $artifact[irand ($#artifact + 1)], $artifact_age; $phrase .= sprintf '%s стал лучшим археологом, выкопав %s! возраст артефакта - %s лет!', $name, $artifact[irand ($#artifact + 1)], $artifact_age;
} else { } else {
$phrase .= sprintf "Поздравляю, %s! Вы только что выкопали %s, возраст - %s лет!\n", $name, $artifact[irand ($#artifact + 1)], $artifact_age; $phrase .= sprintf "Поздравляю, %s! Вы только что выкопали %s, возраст - %s лет!\n", $name, $artifact[irand ($#artifact + 1)], $artifact_age;
$phrase .= sprintf 'Извини %s, но на артефакт это не тянет! Однако, попытка хорошая!', $name; $phrase .= sprintf 'Извини, %s, но на артефакт это не тянет! Однако, попытка хорошая!', $name;
} }
return $phrase; return $phrase;

View File

@@ -52,7 +52,7 @@ sub command {
my $text = shift; my $text = shift;
my $chatid = shift; my $chatid = shift;
my $reply; my $reply;
my ($userid, $username, $fullname, $highlight, $visavi) = highlight ($msg); my ($userid, $username, $fullname, $highlight, $visavi) = highlight $msg;
if (substr ($text, 1) eq 'ping') { if (substr ($text, 1) eq 'ping') {
$reply = 'Pong.'; $reply = 'Pong.';
@@ -65,8 +65,8 @@ sub command {
} elsif (substr ($text, 1) eq 'ver' || substr ($text, 1) eq 'version' || substr ($text, 1) eq 'версия') { } elsif (substr ($text, 1) eq 'ver' || substr ($text, 1) eq 'version' || substr ($text, 1) eq 'версия') {
$reply = 'Версия: Нуль.Чего-то_там.Чего-то_там'; $reply = 'Версия: Нуль.Чего-то_там.Чего-то_там';
} elsif (length ($text) >= 2 && (substr ($text, 1, 2) eq 'w ' || substr ($text, 1, 2) eq 'п ')) { } elsif (length ($text) >= 2 && (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 (substr ($text, 1) eq 'cat' || substr ($text, 1) eq 'кис') { } elsif (substr ($text, 1) eq 'cat' || substr ($text, 1) eq 'кис') {
$reply = kitty (); $reply = kitty ();
$msg->typing (); $msg->typing ();
@@ -79,9 +79,9 @@ sub command {
my $mytext = ''; my $mytext = '';
if (length($text) > 6) { if (length($text) > 6) {
$mytext = substr ($text, 7); $mytext = substr $text, 7;
chomp ($mytext); chomp $mytext;
$mytext = trim ($mytext); $mytext = trim $mytext;
} else { } else {
$mytext = ''; $mytext = '';
} }
@@ -100,13 +100,13 @@ sub command {
} elsif (substr ($text, 1) eq 'f ?' || substr ($text, 1) eq 'fortune ?' || substr ($text, 1) eq 'фортунка ?' || substr ($text, 1) eq 'ф ?') { } elsif (substr ($text, 1) eq 'f ?' || substr ($text, 1) eq 'fortune ?' || substr ($text, 1) eq 'фортунка ?' || substr ($text, 1) eq 'ф ?') {
$reply = fortune_status ($chatid); $reply = fortune_status ($chatid);
} elsif (substr ($text, 1) eq 'dig' || substr ($text, 1) eq 'копать') { } elsif (substr ($text, 1) eq 'dig' || substr ($text, 1) eq 'копать') {
$reply = dig ($highlight); $reply = dig $highlight;
$msg->typing (); $msg->typing ();
sleep (irand (2) + 1); sleep (irand (2) + 1);
$msg->replyMd ($reply); $msg->replyMd ($reply);
return; return;
} elsif (substr ($text, 1) eq 'fish' || substr ($text, 1) eq 'fishing' || substr ($text, 1) eq 'рыба' || substr ($text, 1) eq 'рыбка' || substr ($text, 1) eq 'рыбалка' ) { } elsif (substr ($text, 1) eq 'fish' || substr ($text, 1) eq 'fishing' || substr ($text, 1) eq 'рыба' || substr ($text, 1) eq 'рыбка' || substr ($text, 1) eq 'рыбалка' ) {
$reply = fish ($highlight); $reply = fish $highlight;
$msg->typing (); $msg->typing ();
sleep (irand (2) + 1); sleep (irand (2) + 1);
$msg->replyMd ($reply); $msg->replyMd ($reply);
@@ -166,10 +166,10 @@ sub highlight {
$fullname .= $msg->from->last_name; $fullname .= $msg->from->last_name;
} }
if (defined ($username)) { if (defined $username) {
$visavi .= '@' . $username; $visavi .= '@' . $username;
if (defined ($fullname)) { if (defined $fullname) {
$highlight = "[$fullname](tg://user?id=$userid)"; $highlight = "[$fullname](tg://user?id=$userid)";
$visavi .= ', ' . $fullname; $visavi .= ', ' . $fullname;
} else { } else {

View File

@@ -32,7 +32,7 @@ sub fish {
'плотву', 'плотву',
'зубатку', 'зубатку',
'солнечную рыбу', 'солнечную рыбу',
'cтарую шину', 'старую шину',
'скользкую корягу', 'скользкую корягу',
'лампу джина', 'лампу джина',
'любовное послание в бутылке', 'любовное послание в бутылке',
@@ -70,7 +70,7 @@ sub fish {
'в поток', 'в поток',
'в озеро', 'в озеро',
'в реку', 'в реку',
'в северерный ледовитый океан', 'в северный ледовитый океан',
'в индийский океан', 'в индийский океан',
'в биде', 'в биде',
'в детский плавательный бассейн', 'в детский плавательный бассейн',
@@ -92,7 +92,7 @@ sub fish {
'в черную дыру', 'в черную дыру',
'дно Удомельского реактора', 'дно Удомельского реактора',
'на Марс', 'на Марс',
'в соседнюю галактуку', 'в соседнюю галактику',
'к соседу на балкон', 'к соседу на балкон',
'далеко-далеко', 'далеко-далеко',
'далеко и надолго', 'далеко и надолго',
@@ -101,7 +101,7 @@ sub fish {
my @material = ( my @material = (
'бамбуковую', 'бамбуковую',
'фиберглассовую', 'фибергласовую',
'карбоновую', 'карбоновую',
'композитную', 'композитную',
); );
@@ -110,7 +110,7 @@ sub fish {
my $success_probability = irand 100; my $success_probability = irand 100;
my $weight = irand 7000; my $weight = irand 7000;
my $phrase = sprintf "Вы забрасываете %s удочку %s.\nВы чувствуете поклевку и начинаете быстро тащить что-то.\n", $material[irand ($#material + 1)], $location[irand ($#location + 1)]; my $phrase = sprintf "Вы забрасываете %s удочку %s.\nВы чувствуете поклёвку и начинаете быстро тащить что-то.\n", $material[irand ($#material + 1)], $location[irand ($#location + 1)];
if ($find_probability <= 20) { if ($find_probability <= 20) {
$phrase .= sprintf 'Черт, твоя рыбка сорвалась, %s! Не беда, может потом повезет?', $name; $phrase .= sprintf 'Черт, твоя рыбка сорвалась, %s! Не беда, может потом повезет?', $name;
@@ -122,7 +122,7 @@ sub fish {
if ($success_probability <= 25) { if ($success_probability <= 25) {
$phrase .= sprintf 'Ё-мое!!! А это ведь новый рекорд! Продолжай в том же духе, %s!', $name; $phrase .= sprintf 'Ё-мое!!! А это ведь новый рекорд! Продолжай в том же духе, %s!', $name;
} else { } else {
$phrase .= sprintf 'Извини %s, но это не новый рекорд! Однако, хорошая попытка!', $name; $phrase .= sprintf 'Извини, %s, но это не новый рекорд! Однако, хорошая попытка!', $name;
} }
return $phrase; return $phrase;

View File

@@ -14,10 +14,10 @@ use SQLite_File;
use conf qw (loadConf); use conf qw (loadConf);
use version; our $VERSION = qw (1.0); use version; our $VERSION = qw (1.0);
use Exporter qw(import); use Exporter qw (import);
our @EXPORT_OK = qw(seed fortune fortune_toggle fortune_toggle_list fortune_status); our @EXPORT_OK = qw (seed fortune fortune_toggle fortune_toggle_list fortune_status);
my $c = loadConf(); my $c = loadConf ();
my $dir = $c->{fortune}->{dir}; my $dir = $c->{fortune}->{dir};
my $srcdir = $c->{fortune}->{srcdir}; my $srcdir = $c->{fortune}->{srcdir};
@@ -43,7 +43,7 @@ sub seed () {
next; next;
} }
if ($fortunefile =~ m/\./) { if ($fortunefile =~ m/^\.+$/) {
next; next;
} }

View File

@@ -14,9 +14,9 @@ use conf qw (loadConf);
use version; our $VERSION = qw (1.0); use version; our $VERSION = qw (1.0);
use Exporter qw (import); use Exporter qw (import);
our @EXPORT_OK = qw(karmaSet karmaGet); our @EXPORT_OK = qw (karmaSet karmaGet);
my $c = loadConf(); my $c = loadConf ();
my $karmadir = $c->{karma}->{dir}; my $karmadir = $c->{karma}->{dir};
my $max = 5; my $max = 5;

View File

@@ -39,7 +39,7 @@ sub train () {
$lat->train ($srcfile); $lat->train ($srcfile);
my ($tokens, $expressions) = ($lat->stats ())[0,1]; my ($tokens, $expressions) = ($lat->stats ())[0,1];
printf "Total tokens: %s\nTotal expressins: %s\n", $tokens, $expressions; printf "Total tokens: %s\nTotal expressions: %s\n", $tokens, $expressions;
$lat->save (); $lat->save ();
return; return;
} }

View File

@@ -64,7 +64,7 @@ sub __on_msg {
my $chatid; my $chatid;
my $chatname = 'Noname chat'; my $chatname = 'Noname chat';
# user sending message info # user sending message info
my ($userid, $username, $fullname, $highlight, $vis_a_vi) = highlight ($msg); my ($userid, $username, $fullname, $highlight, $vis_a_vi) = highlight $msg;
my $csign = $c->{telegrambot}->{csign}; my $csign = $c->{telegrambot}->{csign};
unless ($myid) { unless ($myid) {
@@ -93,7 +93,6 @@ sub __on_msg {
if ($msg->chat->can ('id') && defined ($msg->chat->id)) { if ($msg->chat->can ('id') && defined ($msg->chat->id)) {
$chatid = $msg->chat->id; $chatid = $msg->chat->id;
my $group_talk = 0;
if ($msg->chat->can ('username') && defined ($msg->chat->username)) { if ($msg->chat->can ('username') && defined ($msg->chat->username)) {
$chatname = $msg->chat->username ; $chatname = $msg->chat->username ;
@@ -142,14 +141,14 @@ sub __on_msg {
$phrase = sprintf 'Дратути, %s. Представьтес, пожалуйста, и расскажите, что вас сюда привело.', $members[0]; $phrase = sprintf 'Дратути, %s. Представьтес, пожалуйста, и расскажите, что вас сюда привело.', $members[0];
} }
botsleep ($msg); botsleep $msg;
$msg->replyMd ($phrase); $msg->replyMd ($phrase);
return; return;
} }
# lazy init chat-bot brains # lazy init chat-bot brains
unless (defined ($hailo->{$chatid})) { unless (defined $hailo->{$chatid}) {
my $brainname = sprintf ('%s/%s.brain.sqlite', $c->{telegrambot}->{braindir}, $chatid); my $brainname = sprintf '%s/%s.brain.sqlite', $c->{telegrambot}->{braindir}, $chatid;
$hailo->{$chatid} = Hailo->new ( $hailo->{$chatid} = Hailo->new (
# we'll got file like this: data/telegrambot-brains/-1001332512695.brain.sqlite # we'll got file like this: data/telegrambot-brains/-1001332512695.brain.sqlite
@@ -181,7 +180,7 @@ sub __on_msg {
# is it karma adjustment? # is it karma adjustment?
if (substr ($text, -2) eq '++' || substr ($text, -2) eq '--') { if (substr ($text, -2) eq '++' || substr ($text, -2) eq '--') {
my @arr = split(/\n/, $text); my @arr = split /\n/, $text;
if ($#arr < 1) { if ($#arr < 1) {
$reply = karmaSet ($chatid, trim (substr ($text, 0, -2)), substr ($text, -2)); $reply = karmaSet ($chatid, trim (substr ($text, 0, -2)), substr ($text, -2));
@@ -195,13 +194,13 @@ sub __on_msg {
if (defined ($str) && $str ne '') { if (defined ($str) && $str ne '') {
$reply = $str; $reply = $str;
$phrase = trim ($text); $phrase = trim $text;
while ($phrase =~ /[\.|\,|\?|\!]$/) { while ($phrase =~ /[\.|\,|\?|\!]$/) {
chop $phrase; chop $phrase;
} }
$phrase = lc ($phrase); $phrase = lc $phrase;
if (fmatch (lc ($reply), $phrase)) { if (fmatch (lc ($reply), $phrase)) {
$reply = randomCommonPhrase (); $reply = randomCommonPhrase ();
@@ -221,7 +220,7 @@ sub __on_msg {
my $reply; my $reply;
# detect and log messages without text, noop here # detect and log messages without text, noop here
unless (defined ($msg->text)) { unless (defined $msg->text) {
carp sprintf ('[INFO] No text in message from %s', $vis_a_vi); carp sprintf ('[INFO] No text in message from %s', $vis_a_vi);
return; return;
} }
@@ -238,7 +237,7 @@ sub __on_msg {
carp sprintf ('[DEBUG] In public chat %s (%s) %s quote us!', $chatname, $chatid, $vis_a_vi) if $c->{debug}; carp sprintf ('[DEBUG] In public chat %s (%s) %s quote us!', $chatname, $chatid, $vis_a_vi) if $c->{debug};
# remove our name from users reply, just in case # remove our name from users reply, just in case
my $pat1 = quotemeta ('@' . $myusername); my $pat1 = quotemeta ('@' . $myusername);
my $pat2 = quotemeta ($myfullname); my $pat2 = quotemeta $myfullname;
$phrase = $text; $phrase = $text;
$phrase =~ s/$pat1//g; $phrase =~ s/$pat1//g;
$phrase =~ s/$pat2//g; $phrase =~ s/$pat2//g;
@@ -274,7 +273,7 @@ sub __on_msg {
$reply = $hailo->{$msg->chat->id}->reply ($phrase); $reply = $hailo->{$msg->chat->id}->reply ($phrase);
# karma adjustment # karma adjustment
} elsif (substr ($text, -2) eq '++' || substr ($text, -2) eq '--') { } elsif (substr ($text, -2) eq '++' || substr ($text, -2) eq '--') {
my @arr = split(/\n/, $text); my @arr = split /\n/, $text;
if ($#arr < 1) { if ($#arr < 1) {
$reply = karmaSet ($chatid, trim (substr ($text, 0, -2)), substr ($text, -2)); $reply = karmaSet ($chatid, trim (substr ($text, 0, -2)), substr ($text, -2));
@@ -290,20 +289,20 @@ sub __on_msg {
if (defined ($reply) && $reply ne '') { if (defined ($reply) && $reply ne '') {
# work a bit more on input phrase # work a bit more on input phrase
$phrase = trim ($phrase); $phrase = trim $phrase;
while ($phrase =~ /[\.|\,|\?|\!]$/) { while ($phrase =~ /[\.|\,|\?|\!]$/) {
chop $phrase; chop $phrase;
} }
$phrase = lc ($phrase); $phrase = lc $phrase;
if (fmatch (lc ($reply), $phrase)) { if (fmatch (lc ($reply), $phrase)) {
$reply = randomCommonPhrase (); $reply = randomCommonPhrase ();
} }
$msg->typing (); $msg->typing ();
sleep (irand (2)); sleep (irand 2);
carp sprintf ('[DEBUG] In public chat %s (%s) bot reply to %s: %s', $chatname, $chatid, $vis_a_vi, $reply) if $c->{debug}; carp sprintf ('[DEBUG] In public chat %s (%s) bot reply to %s: %s', $chatname, $chatid, $vis_a_vi, $reply) if $c->{debug};
$msg->reply ($reply); $msg->reply ($reply);
} else { } else {

View File

@@ -37,7 +37,7 @@ sub weather {
$reply = sprintf ("Погода в городе %s, %s:\n%s, ветер %s %s м/c, температура %s°C, ощущается как %s°C, относительная влажность %s%%, давление %s мм.рт.с", $reply = sprintf ("Погода в городе %s, %s:\n%s, ветер %s %s м/c, температура %s°C, ощущается как %s°C, относительная влажность %s%%, давление %s мм.рт.с",
$w->{name}, $w->{name},
$w->{country}, $w->{country},
ucfirst ($w->{description}), ucfirst $w->{description},
$w->{wind_direction}, $w->{wind_direction},
$w->{wind_speed}, $w->{wind_speed},
$w->{temperature_min}, $w->{temperature_min},
@@ -49,7 +49,7 @@ sub weather {
$reply = sprintf ("Погода в городе %s, %s:\n%s, ветер %s %s м/c, температура %s-%s°C, ощущается как %s°C, относительная влажность %s%%, давление %s мм.рт.ст", $reply = sprintf ("Погода в городе %s, %s:\n%s, ветер %s %s м/c, температура %s-%s°C, ощущается как %s°C, относительная влажность %s%%, давление %s мм.рт.ст",
$w->{name}, $w->{name},
$w->{country}, $w->{country},
ucfirst ($w->{description}), ucfirst $w->{description},
$w->{wind_direction}, $w->{wind_direction},
$w->{wind_speed}, $w->{wind_speed},
$w->{temperature_min}, $w->{temperature_min},
@@ -140,7 +140,7 @@ sub __weather {
untie %cachetime; untie %cachetime;
untie %cachedata; untie %cachedata;
# TODO: check all of this for existance # TODO: check all of this for existence
$w->{'name'} = $fc->{name}; $w->{'name'} = $fc->{name};
$w->{'state'} = $fc->{state}; $w->{'state'} = $fc->{state};
$w->{'country'} = $fc->{sys}->{country}; $w->{'country'} = $fc->{sys}->{country};