Implement fortune commands set
+ !f, !ф, !fortune, !фортунка - show random phrase from fortune_mod db + !f 1, !ф 1, !fortune 1, !фортунка 1 - show fortune in chat at ~8 am + !f 0, !ф 0, !fortune 0, !фортунка 0 - do not show fortune in the morning + !f ?, !ф ?, !fortune ?, !фортунка ? - query morning fortune status
This commit is contained in:
eleksir
@@ -18,6 +18,7 @@ use conf qw(loadConf);
|
||||
use lat qw(latAnswer);
|
||||
use karma qw(karmaSet karmaGet);
|
||||
use friday qw(friday);
|
||||
use fortune qw(fortune fortune_toggle fortune_status);
|
||||
|
||||
use vars qw/$VERSION/;
|
||||
|
||||
@@ -265,7 +266,7 @@ sub command {
|
||||
my $city = substr ($text, 3);
|
||||
$reply = weather ($city);
|
||||
} elsif (substr ($text, 1) eq 'lat' || substr ($text, 1) eq 'лат') {
|
||||
$reply = latAnswer();
|
||||
$reply = latAnswer ();
|
||||
} elsif (substr ($text, 1, 6) eq 'karma ' || substr ($text, 1, 6) eq 'карма ' || substr($text, 1) eq 'karma' || substr($text, $1) eq 'карма') {
|
||||
my $mytext = '';
|
||||
|
||||
@@ -279,7 +280,15 @@ sub command {
|
||||
|
||||
$reply = karmaGet ($chatid, $mytext);
|
||||
} elsif (substr ($text, 1) eq 'friday' || substr ($text, 1) eq 'пятница') {
|
||||
$reply = friday();
|
||||
$reply = friday ();
|
||||
} elsif (substr ($text, 1) eq 'fortune' || substr ($text, 1) eq 'фортунка' || substr ($text, 1) eq 'f' || substr ($text, 1) eq 'ф') {
|
||||
$reply = fortune ();
|
||||
} elsif (substr ($text, 1) eq 'f 1' || substr ($text, 1) eq 'fortune 1' || substr ($text, 1) eq 'фортунка 1' || substr ($text, 1) eq 'ф 1') {
|
||||
$reply = fortune_toggle ($chatid, 1);
|
||||
} elsif (substr ($text, 1) eq 'f 0' || substr ($text, 1) eq 'fortune 0' || substr ($text, 1) eq 'фортунка 0' || substr ($text, 1) eq 'ф 0') {
|
||||
$reply = fortune_toggle ($chatid, 0);
|
||||
} elsif (substr ($text, 1) eq 'f ?' || substr ($text, 1) eq 'fortune ?' || substr ($text, 1) eq 'фортунка ?' || substr ($text, 1) eq 'ф ?') {
|
||||
$reply = fortune_status ($chatid);
|
||||
}
|
||||
|
||||
return $reply;
|
||||
|
||||
175
lib/fortune.pm
Normal file
175
lib/fortune.pm
Normal file
@@ -0,0 +1,175 @@
|
||||
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 fortune_toggle fortune_toggle_list fortune_status);
|
||||
|
||||
$VERSION = '1.0';
|
||||
|
||||
use SQLite_File;
|
||||
use MIME::Base64;
|
||||
use File::Path qw(mkpath);
|
||||
use conf qw(loadConf);
|
||||
|
||||
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 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;
|
||||
}
|
||||
|
||||
sub fortune_toggle (@) {
|
||||
my $chatid = shift;
|
||||
my $action = shift // undef;
|
||||
my $phrase = 'Фортунка с утра ';
|
||||
|
||||
unless (-d $dir) {
|
||||
mkpath ($dir) || do {
|
||||
cluck "Unable to create $dir: $OS_ERROR";
|
||||
return;
|
||||
};
|
||||
}
|
||||
|
||||
my $backingfile = sprintf '%s/chats.sqlite', $dir;
|
||||
|
||||
tie my %toggle, 'SQLite_File', $backingfile || do {
|
||||
cluck "Unable to tie to $backingfile: $OS_ERROR\n";
|
||||
return;
|
||||
};
|
||||
|
||||
my $state = $toggle{$chatid};
|
||||
|
||||
if (defined $action) {
|
||||
if ($action) {
|
||||
$toggle{$chatid} = 1;
|
||||
$phrase .= 'будет показываться.';
|
||||
} else {
|
||||
if (defined $state) {
|
||||
delete $toggle{$chatid};
|
||||
}
|
||||
|
||||
$phrase .= 'не будет показываться.';
|
||||
}
|
||||
} else {
|
||||
if (defined $state && $state) {
|
||||
delete $toggle{$chatid};
|
||||
$phrase .= 'не будет показываться.';
|
||||
} else {
|
||||
$toggle{$chatid} = 1;
|
||||
$phrase .= 'будет показываться.';
|
||||
}
|
||||
}
|
||||
|
||||
untie %toggle;
|
||||
return $phrase;
|
||||
}
|
||||
|
||||
sub fortune_status ($) {
|
||||
my $chatid = shift;
|
||||
my $phrase = 'Фортунка с утра ';
|
||||
|
||||
unless (-d $dir) {
|
||||
mkpath ($dir) || do {
|
||||
cluck "Unable to create $dir: $OS_ERROR";
|
||||
return;
|
||||
};
|
||||
}
|
||||
|
||||
my $backingfile = sprintf '%s/chats.sqlite', $dir;
|
||||
|
||||
tie my %toggle, 'SQLite_File', $backingfile || do {
|
||||
cluck "Unable to tie to $backingfile: $OS_ERROR\n";
|
||||
return;
|
||||
};
|
||||
|
||||
my $state = $toggle{$chatid};
|
||||
|
||||
if (defined $state && $state) {
|
||||
$phrase .= 'показываtтся.';
|
||||
} else {
|
||||
$phrase .= 'yt показываtтся.';
|
||||
}
|
||||
|
||||
untie %toggle;
|
||||
return $phrase;
|
||||
}
|
||||
|
||||
sub fortune_toggle_list () {
|
||||
unless (-d $dir) {
|
||||
mkpath ($dir) || croak "Unable to create $dir: $OS_ERROR";
|
||||
}
|
||||
|
||||
my $backingfile = sprintf '%s/chats.sqlite', $dir;
|
||||
|
||||
tie my %toggle, 'SQLite_File', $backingfile || do {
|
||||
cluck "Unable to tie to $backingfile: $OS_ERROR\n";
|
||||
my @empty = ();
|
||||
return @empty;
|
||||
};
|
||||
|
||||
my @list = keys %toggle;
|
||||
untie %toggle;
|
||||
return @list;
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
# vim: ft=perl noet ai ts=4 sw=4 sts=4:
|
||||
@@ -16,6 +16,7 @@ use conf qw(loadConf);
|
||||
use botlib qw(weather logger trim randomCommonPhrase command);
|
||||
use telegramlib qw(visavi);
|
||||
use karma qw(karmaSet);
|
||||
use fortune qw(fortune fortune_toggle_list);
|
||||
|
||||
use Exporter qw(import);
|
||||
our @EXPORT_OK = qw(run_telegrambot);
|
||||
@@ -34,10 +35,21 @@ my $can_talk = 0;
|
||||
|
||||
has token => $c->{telegrambot}->{token};
|
||||
|
||||
# i promise, i'll make use of this sub
|
||||
sub __cron { ## no critic (Subroutines::ProhibitUnusedPrivateSubroutines)
|
||||
sub __cron {
|
||||
my $self = shift;
|
||||
# noop
|
||||
|
||||
# fortune mod
|
||||
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime (time);
|
||||
|
||||
if ($hour = 8 && ($min >= 0 && $min <= 14)) {
|
||||
foreach my $enabledfortunechat (fortune_toggle_list()) {
|
||||
my $send_args;
|
||||
$send_args->{text} = sptintf "Сегодняшний день пройдёт под эгидой фразы:\n%s", fortune();
|
||||
$send_args->{chat_id} = $enabledfortunechat;
|
||||
Teapot::Bot::Brain::sendMessage ($self, $send_args);
|
||||
}
|
||||
}
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
@@ -225,6 +237,12 @@ sub __on_msg {
|
||||
$send_args->{text} = << 'MYHELP';
|
||||
```
|
||||
!help | !помощь - список команд
|
||||
!f | !ф - рандомная фраза из сборника цитат fortune_mod
|
||||
!fortune | !фортунка - рандомная фраза из сборника цитат fortune_mod
|
||||
!f # | !ф # - где 1 - вкл, 0 - выкл фортунку с утра
|
||||
!fortune # | !фортунка # - где 1 - вкл, 0 - выкл фортунку с утра
|
||||
!f ? | !ф ? - показываем ли с утра фортунку для чата
|
||||
!fortune ? | !фортунка ? - показываем ли с утра фортунку для чата
|
||||
!friday | пятница - а не пятница ли сегодня?
|
||||
!lat | !лат - сгенерировать фразу из крылатых латинских выражений
|
||||
!ping | !пинг - попинговать бота
|
||||
@@ -352,6 +370,12 @@ MYHELP
|
||||
$send_args->{text} = << 'MYHELP';
|
||||
```
|
||||
!help | !помощь - список команд
|
||||
!f | !ф - рандомная фраза из сборника цитат fortune_mod
|
||||
!fortune | !фортунка - рандомная фраза из сборника цитат fortune_mod
|
||||
!f # | !ф # - где 1 - вкл, 0 - выкл фортунку с утра
|
||||
!fortune # | !фортунка # - где 1 - вкл, 0 - выкл фортунку с утра
|
||||
!f ? | !ф ? - показываем ли с утра фортунку для чата
|
||||
!fortune ? | !фортунка ? - показываем ли с утра фортунку для чата
|
||||
!friday | пятница - а не пятница ли сегодня?
|
||||
!lat | !лат - сгенерировать фразу из крылатых латинских выражений
|
||||
!ping | !пинг - попинговать бота
|
||||
@@ -452,7 +476,7 @@ sub init {
|
||||
|
||||
my $self = shift;
|
||||
$self->add_listener (\&__on_msg);
|
||||
# $self->add_repeating_task(900, \&__cron);
|
||||
$self->add_repeating_task(900, \&__cron);
|
||||
return;
|
||||
}
|
||||
|
||||
|
||||
Reference in New Issue
Block a user