Implement !friday and !пятница commands
This commit is contained in:
@@ -17,6 +17,7 @@ use DB_File;
|
||||
use conf qw(loadConf);
|
||||
use lat qw(latAnswer);
|
||||
use karma qw(karmaSet karmaGet);
|
||||
use friday qw(friday);
|
||||
|
||||
use vars qw/$VERSION/;
|
||||
|
||||
@@ -277,6 +278,8 @@ sub command {
|
||||
}
|
||||
|
||||
$reply = karmaGet ($chatid, $mytext);
|
||||
} elsif (substr ($text, 1) eq 'friday' || substr ($text, 1) eq 'пятница') {
|
||||
$reply = friday();
|
||||
}
|
||||
|
||||
return $reply;
|
||||
|
||||
84
lib/friday.pm
Normal file
84
lib/friday.pm
Normal file
@@ -0,0 +1,84 @@
|
||||
package friday;
|
||||
# for friday data stolen from https://raw.githubusercontent.com/isida/vi/master/data/friday.txt
|
||||
|
||||
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 friday);
|
||||
|
||||
$VERSION = '1.0';
|
||||
|
||||
use SQLite_File;
|
||||
use MIME::Base64;
|
||||
use File::Path qw(mkpath);
|
||||
use conf qw(loadConf);
|
||||
|
||||
my $c = loadConf();
|
||||
my $dir = $c->{friday}->{dir};
|
||||
my $srcfile = $c->{friday}->{src};
|
||||
my @dow = qw (monday tuesday wednesday thursday friday saturday sunday);
|
||||
|
||||
sub seed () {
|
||||
unless (-d $dir) {
|
||||
mkpath ($dir) || croak "Unable to create $dir: $OS_ERROR";
|
||||
}
|
||||
|
||||
my $friday;
|
||||
|
||||
for (0..$#dow) {
|
||||
my $backingfile = sprintf '%s/%s.sqlite', $dir, $dow[$_];
|
||||
|
||||
if (-f $backingfile) {
|
||||
unlink $backingfile || croak "Unable to remove $backingfile: $OS_ERROR\n";
|
||||
}
|
||||
|
||||
tie @{$friday->[$_]}, 'SQLite_File', $backingfile || croak "Unable to tie to $backingfile: $OS_ERROR\n";
|
||||
}
|
||||
|
||||
open (my $fh, '<', $srcfile) || croak "Unable to open $srcfile, $OS_ERROR\n";
|
||||
|
||||
while (readline $fh) {
|
||||
next unless m/ \|\| /xmsg;
|
||||
chomp();
|
||||
my ($phrase, $days) = split(/ \|\| /);
|
||||
my @daylist = split(//, $days);
|
||||
|
||||
foreach my $day (@daylist) {
|
||||
next unless ($day =~ /^\d$/);
|
||||
push @{$friday->[$day - 1]}, $phrase;
|
||||
}
|
||||
}
|
||||
|
||||
close $fh; ## no critic (InputOutput::RequireCheckedSyscalls, InputOutput::RequireCheckedOpen)
|
||||
for (0..$#dow) { untie $friday->[$_]; }
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
# just return answer
|
||||
sub friday () {
|
||||
my $today = (localtime(time))[6] - 1;
|
||||
my $backingfile = sprintf '%s/%s.sqlite', $dir, $dow[$today];
|
||||
|
||||
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:
|
||||
@@ -224,12 +224,14 @@ sub __on_msg {
|
||||
my $send_args;
|
||||
$send_args->{text} = << 'MYHELP';
|
||||
```
|
||||
!help | !помощь - список команд
|
||||
!w город | !п город - погода в указанном городе
|
||||
!ping | !пинг - попинговать бота
|
||||
!lat | !лат - сгенерировать фразу из крылатых латинских выражений
|
||||
!karma | !карма фраза - посмотреть карму фразы
|
||||
фраза-- | фраза++ - убавить или добавить карму фразе
|
||||
!help | !помощь - список команд
|
||||
!friday | пятница - а не пятница ли сегодня?
|
||||
!lat | !лат - сгенерировать фразу из крылатых латинских выражений
|
||||
!ping | !пинг - попинговать бота
|
||||
!ver | !version | !версия - что-то про версию ПО
|
||||
!w город | !п город - погода в указанном городе
|
||||
!karma | !карма фраза - посмотреть карму фразы
|
||||
фраза-- | фраза++ - убавить или добавить карму фразе
|
||||
```
|
||||
Но на самом деле я бот больше для общения, чем для исполнения команд.
|
||||
Поговоришь со мной?
|
||||
@@ -350,10 +352,11 @@ MYHELP
|
||||
$send_args->{text} = << 'MYHELP';
|
||||
```
|
||||
!help | !помощь - список команд
|
||||
!friday | пятница - а не пятница ли сегодня?
|
||||
!lat | !лат - сгенерировать фразу из крылатых латинских выражений
|
||||
!ping | !пинг - попинговать бота
|
||||
!ver | !version | !версия - что-то про версию ПО
|
||||
!w город | !п город - погода в указанном городе
|
||||
!ping | !пинг - попинговать бота
|
||||
!lat | !лат - сгенерировать фразу из крылатых латинских выражений
|
||||
!karma | !карма фраза - посмотреть карму фразы
|
||||
фраза-- | фраза++ - убавить или добавить карму фразе
|
||||
```
|
||||
|
||||
Reference in New Issue
Block a user