Implement !f, !ф, !fortune, !фортунка commands
This commit is contained in:
83
lib/fortune.pm
Normal file
83
lib/fortune.pm
Normal file
@@ -0,0 +1,83 @@
|
||||
package fortune;
|
||||
# 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 vars qw/$VERSION/;
|
||||
use Exporter qw(import);
|
||||
our @EXPORT_OK = qw(seed fortune);
|
||||
|
||||
$VERSION = '1.0';
|
||||
|
||||
use SQLite_File;
|
||||
use MIME::Base64;
|
||||
use File::Path qw(mkpath);
|
||||
use conf qw(loadConf);
|
||||
use botlib qw(logger);
|
||||
|
||||
my $c = loadConf();
|
||||
my $dir = $c->{fortune}->{dir};
|
||||
my $srcdir = $c->{fortune}->{srcdir};
|
||||
|
||||
sub seed () {
|
||||
unless (-d $dir) {
|
||||
mkpath ($dir) || croak "Unable to create $dir: $OS_ERROR";
|
||||
}
|
||||
|
||||
my $backingfile = sprintf '%s/fortune.sqlite', $dir;
|
||||
|
||||
if (-f $backingfile) {
|
||||
unlink $backingfile || croak "Unable to remove $backingfile: $OS_ERROR\n";
|
||||
}
|
||||
|
||||
tie my @fortune, 'SQLite_File', $backingfile || croak "Unable to tie to $backingfile: $OS_ERROR\n";
|
||||
|
||||
opendir (my $srcdirhandle, $srcdir) || croak "Unable to open $srcdir: $OS_ERROR";
|
||||
|
||||
while (my $fortunefile = readdir ($srcdirhandle)) {
|
||||
my $srcfile = sprintf '%s/%s', $srcdir, $fortunefile;
|
||||
# next;
|
||||
next unless (-f $srcfile);
|
||||
# next if (m/[\.|\$|\@]/);
|
||||
open (my $fh, '<', $srcfile) || croak "Unable to open $srcfile, $OS_ERROR\n";
|
||||
# set correct phrase delimiter
|
||||
local $INPUT_RECORD_SEPARATOR = "\n%\n";
|
||||
|
||||
while (readline $fh) {
|
||||
my $phrase = substr($_, 0, -3);
|
||||
push @fortune, $phrase;
|
||||
}
|
||||
|
||||
close $fh; ## no critic (InputOutput::RequireCheckedSyscalls, InputOutput::RequireCheckedOpen)
|
||||
}
|
||||
|
||||
closedir $srcdirhandle;
|
||||
untie @fortune;
|
||||
return;
|
||||
}
|
||||
|
||||
# just return answer
|
||||
sub fortune () {
|
||||
my $backingfile = sprintf '%s/fortune.sqlite', $dir;
|
||||
|
||||
tie my @array, 'SQLite_File', $backingfile || do {
|
||||
cluck "Unable to tie to $backingfile: $OS_ERROR\n";
|
||||
return '';
|
||||
};
|
||||
|
||||
my $phrase = $array[int (rand ($#array - 1))];
|
||||
# decode?
|
||||
utf8::decode $phrase;
|
||||
untie @array;
|
||||
return $phrase;
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
# vim: ft=perl noet ai ts=4 sw=4 sts=4:
|
||||
@@ -17,6 +17,7 @@ use botlib qw(weather logger trim randomCommonPhrase);
|
||||
use lat qw(latAnswer);
|
||||
use karma qw(karmaSet karmaGet);
|
||||
use friday qw(friday);
|
||||
use fortune qw(fortune);
|
||||
|
||||
use Exporter qw(import);
|
||||
use vars qw/$VERSION/;
|
||||
@@ -113,6 +114,7 @@ sub __new_bot_message {
|
||||
} elsif (substr($text, 1) eq 'help' || substr($text, 1) eq 'помощь') {
|
||||
$bot->SendGroupMessage($hash{'reply_to'}, <<"EOL" );
|
||||
!help | !помощь - это сообщение
|
||||
!f | !ф | !fortune | !фортунка - рандомная фраза из сборника цитат fortune_mod
|
||||
!friday | !пятница - а не пятница ли сегодня?
|
||||
!lat | !лат - сгенерировать фразу из крылатого латинского выражения
|
||||
!ping | !пинг - попинговать бота
|
||||
@@ -136,6 +138,11 @@ EOL
|
||||
$bot->SendGroupMessage($hash{'reply_to'}, karmaGet($hash{'reply_to'}, $mytext));
|
||||
} elsif (substr($text, 1) eq 'friday' || substr($text, 1) eq 'пятница') {
|
||||
$bot->SendGroupMessage($hash{'reply_to'}, friday());
|
||||
} elsif (substr($text, 1) eq 'fortune' || substr($text, 1) eq 'фортунка' || substr($text, 1) eq 'f' || substr($text, 1) eq 'ф') {
|
||||
my $phrase = fortune();
|
||||
# workaround Net::Jabber::Bot outgoing message ![:print:] replacement
|
||||
$phrase =~ s/\s\s+\-\-/\n \-\-/xmsg;
|
||||
$bot->SendGroupMessage($hash{'reply_to'}, $phrase);
|
||||
} else {
|
||||
$hailo->learn($text);
|
||||
return;
|
||||
|
||||
Reference in New Issue
Block a user