Implemented !proverb and !пословица commands
This commit is contained in:
1
.gitignore
vendored
1
.gitignore
vendored
@@ -8,6 +8,7 @@ data/friday/**
|
||||
data/image/**
|
||||
data/karma/**
|
||||
data/lat/**
|
||||
data/proverb/**
|
||||
TODO
|
||||
*.pid
|
||||
*.log
|
||||
|
||||
26
bin/proverb_seed.pl
Normal file
26
bin/proverb_seed.pl
Normal 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
1719
data/proverb_src/proverb.txt
Normal file
File diff suppressed because it is too large
Load Diff
@@ -46,6 +46,11 @@
|
||||
"srcdir" : "data/fortune_src"
|
||||
},
|
||||
|
||||
"proverb" : {
|
||||
"dir" : "data/proverb",
|
||||
"srcdir" : "data/proverb_src"
|
||||
},
|
||||
|
||||
"openweathermap" : {
|
||||
"appid": "get_it_on_openweathermap.org"
|
||||
},
|
||||
|
||||
@@ -158,6 +158,8 @@ sub init {
|
||||
dig => "$c->{csign}dig - заняться археологией",
|
||||
копать => "$c->{csign}копать - заняться археологией",
|
||||
drink => "$c->{csign}drink - какой сегодня праздник?",
|
||||
пословица => "$c->{csign}пословица - рандомная русская пословица",
|
||||
proverb => "$c->{csign}proverb - рандомная русская пословица",
|
||||
праздник => "$c->{csign}праздник - какой сегодня праздник?",
|
||||
fish => "$c->{csign}fish - порыбачить",
|
||||
fisher => "$c->{csign}fisher - порыбачить",
|
||||
|
||||
@@ -21,6 +21,7 @@ use BotLib::Karma qw (KarmaGet);
|
||||
use BotLib::Kitty qw (Kitty);
|
||||
use BotLib::Lat qw (Lat);
|
||||
use BotLib::Monkeyuser qw (Monkeyuser);
|
||||
use BotLib::Proverb qw (Proverb);
|
||||
use BotLib::Util qw (trim utf2sha1);
|
||||
use BotLib::Weather qw (Weather);
|
||||
use BotLib::Xkcd qw (Xkcd);
|
||||
@@ -126,6 +127,8 @@ sub Command {
|
||||
$reply = KarmaGet ($chatid, $mytext);
|
||||
} 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 'ф') {
|
||||
my $phrase = Fortune ();
|
||||
$reply = $phrase;
|
||||
|
||||
88
lib/BotLib/Proverb.pm
Normal file
88
lib/BotLib/Proverb.pm
Normal 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:
|
||||
Reference in New Issue
Block a user