1

Implemented !proverb and !пословица commands

This commit is contained in:
eleksir
2021-08-11 16:54:21 +03:00
parent 3dd565c658
commit 2134edd841
6 changed files with 1843 additions and 0 deletions

1
.gitignore vendored
View File

@@ -11,5 +11,6 @@ data/gamestat/**
data/image/**
data/karma/**
data/lat/**
data/proverb/**
data/telegrambot-brains/**
vendor_perl/**

26
bin/proverb_seed.pl Normal file
View File

@@ -0,0 +1,26 @@
#!/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 BotLib::Proverb qw (Seed);
Seed ();
exit 0;

1719
data/proverb_src/proverb.txt Normal file

File diff suppressed because it is too large Load Diff

View File

@@ -12,6 +12,11 @@
"srcdir" : "data/fortune_src"
},
"proverb" : {
"dir" : "data/proverb",
"srcdir" : "data/proverb_src"
},
"friday" : {
"dir" : "data/friday",
"src" : "data/friday.txt"

View File

@@ -25,6 +25,7 @@ use BotLib::Image qw (Kitty Fox Oboobs Obutts Rabbit Owl Frog Horse Snail);
use BotLib::Karma qw (KarmaSet KarmaGet);
use BotLib::Lat qw (Lat);
use BotLib::Monkeyuser qw (Monkeyuser);
use BotLib::Proverb qw (Proverb);
use BotLib::Util qw (trim);
use BotLib::Weather qw (Weather);
use BotLib::Xkcd qw (Xkcd);
@@ -209,6 +210,8 @@ sub Command {
return;
} elsif (substr ($text, 1) eq 'friday' || substr ($text, 1) eq 'пятница') {
$reply = Friday ();
} elsif (substr ($text, 1) eq 'proverb' || substr ($text, 1) eq 'пословица') {
$reply = Proverb ();
} elsif (substr ($text, 1) eq 'fortune' || substr ($text, 1) eq 'фортунка' || substr ($text, 1) eq 'f' || substr ($text, 1) eq 'ф') {
$reply = sprintf "```\n%s\n```\n", trim (Fortune ());
$msg->replyMd ($reply);
@@ -253,6 +256,7 @@ ${csign}horse | ${csign}лошадка - лошадка
${csign}lat | ${csign}лат - сгенерить фразу из крылатых латинских выражений
${csign}monkeyuser - рандомный стрип MonkeyUser
${csign}owl | ${csign}сова - сова
${csign}proverb | ${csign}пословица - рандомная русская пословица
${csign}ping | ${csign}пинг - попинговать бота
${csign}roll | ${csign}dice | ${csign}кости - бросить кости
${csign}snail | ${csign}улитка - улитка

88
lib/BotLib/Proverb.pm Normal file
View File

@@ -0,0 +1,88 @@
package BotLib::Proverb;
# Any fortune_mod sources are suitable. Text file with "\n%\n" sentence delimeter.
use 5.018;
use strict;
use warnings;
use utf8;
use open qw (:std :utf8);
use English qw ( -no_match_vars );
use Carp qw (cluck croak);
use File::Path qw (make_path);
use Log::Any qw ($log);
use Math::Random::Secure qw (irand);
use SQLite_File;
use BotLib::Conf qw (LoadConf);
use BotLib::Util qw (trim);
use version; our $VERSION = qw (1.0);
use Exporter qw (import);
our @EXPORT_OK = qw (Seed Proverb);
my $c = LoadConf ();
my $dir = $c->{proverb}->{dir};
my $srcdir = $c->{proverb}->{srcdir};
sub Seed () {
unless (-d $dir) {
make_path ($dir) || croak "Unable to create $dir: $OS_ERROR";
}
my $backingfile = sprintf '%s/proverb.sqlite', $dir;
if (-f $backingfile) {
unlink $backingfile || croak "Unable to remove $backingfile: $OS_ERROR";
}
tie my @proverb, 'SQLite_File', $backingfile || croak "Unable to tie to $backingfile: $OS_ERROR";
opendir (my $srcdirhandle, $srcdir) || croak "Unable to open $srcdir: $OS_ERROR";
while (my $proverbfile = readdir ($srcdirhandle)) {
my $srcfile = sprintf '%s/%s', $srcdir, $proverbfile;
unless (-f $srcfile) {
next;
}
if ($proverbfile =~ m/^\.+$/) {
next;
}
open (my $fh, '<', $srcfile) || croak "Unable to open $srcfile, $OS_ERROR";
while (readline $fh) {
chomp;
my $str = trim ($_);
if ($str ne '') {
push @proverb, $str;
}
}
close $fh; ## no critic (InputOutput::RequireCheckedSyscalls, InputOutput::RequireCheckedOpen)
}
closedir $srcdirhandle;
untie @proverb;
return;
}
# just return answer
sub Proverb () {
my $backingfile = sprintf '%s/proverb.sqlite', $dir;
tie my @array, 'SQLite_File', $backingfile || do {
$log->error ("[ERROR] Unable to tie to $backingfile: $OS_ERROR");
return '';
};
my $phrase = $array[irand ($#array + 1)];
# decode?
utf8::decode $phrase;
untie @array;
return $phrase;
}
1;
# vim: ft=perl noet ai ts=4 sw=4 sts=4: