Implement !friday and !пятница commands

2020-11-21 15:38:01 +03:00
parent 48c07b0073
commit e448225a7b
8 changed files with 200 additions and 9 deletions
--- a/.perlcriticrc
+++ b/.perlcriticrc
@@ -86,3 +86,6 @@ verbose     = 8
 # Considering this as "soft" requirement. For modules that is (or will be)
 # stand-alone libs well formed documentation is highly desired.
 lib_sections    = NAME | VERSION | DESCRIPTION | AUTHOR | LICENSE AND COPYRIGHT
+
+[-InputOutput::RequireBriefOpen]
+# Yes, i do!
--- a/bin/friday_seed.pl
+++ b/bin/friday_seed.pl
@@ -0,0 +1,28 @@
+#!/usr/bin/perl
+
+use 5.018;
+use strict;
+use warnings;
+use utf8;
+use open qw(:std :utf8);
+use English qw( -no_match_vars );
+use vars qw/$VERSION/;
+$VERSION = '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 friday qw(seed);
+
+seed ();
+
+exit 0;
--- a/1
+++ b/1
@@ -1,6 +1,7 @@
 requires 'Carp';
 requires 'Cwd::utf8';
 requires 'DB_File';
+requires 'SQLite_File';
 requires 'Digest::MD5';
 requires 'Data::Dumper';
 requires 'Digest::SHA';
--- a/data/friday.txt
+++ b/data/friday.txt
@@ -0,0 +1,65 @@
+А пятница-то не настоящая!!! || 34
+Спасибо, кэп! || 5
+А за пивом сегодня идет user || 5
+user, ты пиво купил? || 5
+Пятница хоть и небольшой праздник, НО ЗАТО ПОСТОЯННЫЙ! || 45
+Мечта о пятнице — самая распространенная среди работающего населения. Она начинается уже в понедельник и продолжается четыре дня в неделю || 123
+Господи дай мне сил не напиться! А если напьюсь, то сделай так чтобы я не плясала, если сил твоих не хватит и я все-таки запляшу, постарайся хотя бы сделать так, что бы не пела! А если и это не удастся, сломай к чертям сервер Ю-тюба! || 5
+К пятнице готова! Мобильный заряжен, баланс пополнен, в кармане записка с моим адресом || 5
+ПРЕДУПРЕЖДЕНИЕ: Чрезмерное употребление… Алкоголя. делает ВАШУ пятницу… ОФИГИТЕЛЬНОЙ || 5
+Сломай систему! Порви шаблоны! Начни новую жизнь с пятницы! || 5
+В пятницу совесть доживает только до обеда… || 5
+Сколько работнику не плати, всё равно пятницы ждёт || 1234
+Робинзооон!!! || 5
+А пятница всё ближе. Печень в ужасе, попа в предвкушении! || 5
+Люди, с кем я вчера пила? Объясните, откуда у меня кот и почему люди в магазине мне хлопают… Кстати… никому кот не нужен? || 6
+ПЯТНИЦА — это старинный народный праздник, который начинают праздновать в ПЯТНИЦУ, а заканчивают — в ПОНЕДЕЛЬНИК || 567
+Вчера была пятница, завтра суббота, а сегодня тогда что? || 1
+Сегодня… ПЯТНИЧКА !!! Из хороших новостей пока… ВСЁ… Всем ДОБРА!!! || 5
+Надену-ка я сегодня красное платье… Под цвет глаз… || 5
+Вчера был yesterday || 235
+Вчера была yesterday || 467
+Вчера было yesterday || 1
+Никогда еще ожидание пятницы не было столь актуальным… || 4
+Завтра будет tomorrow || 1234567
+Четверг - это "завтра пятница". И помнить об этом надо в среду || 34
+Понедельник - это не начало новой недели, это задница предыдущей( || 1
+Я, признаться, очень завидую Робинзону Крузо. Живет на острове, никто мозги не е@ет и ПЯТНИЦА, ПЯТНИЦА, ПЯТНИЦА!!! Каждый день ПЯТНИЦА!!! || 1234
+Наступила пятница — значит мечты начинают сбываться || 5
+Вечером в пятницу девчонки должны быть алкоголенькими… || 5
+Позвони мне в субботу рано утром, часов в пятнадцать || 5
+Ну, вот и пятница пришла… Граждане и гражданки! Следите за своей белкой, чтобы она не разгорячилась! || 5
+Ага, вчера был понедельник, а сегодня сразу ПЯТНИЦА! ЩАС! || 2
+Вот пятница пролетела, наступил понедельник, но не все, не все вернулись на свои рабочие места || 1
+Работа не волк… В лес не убежит?.. А вдруг убежит… Так, за раздумьями и мечтами, и проходит рабочий день… || 12345
+Какой бы долгой и увлекательной ни была вечеринка, сделайте все, чтобы завтра проснуться в собственной спальне || 5
+Тяжелое воскресное засыпание объясняется вполне объективной причиной — организм на подсознательном уровне пытается продлить выходной… || 7
+Воскресенье — день недели с привкусом разочарования. Вроде и выходной, но все равно что-то не то || 7
+У воскресного дня есть только один существенный недостаток — он почему-то кончается в два раза быстрее, чем любой понедельник или четверг. || 7
+Первое правило хороших выходных - не вставать рано с постели || 67
+Понедельник — это такой день, когда вместо бейджика хочется повесить табличку: "Осторожно, злая собака" || 1
+Нас тупило утро понедельника || 1
+Бедный понедельник. Его ж никто не любит! || 1
+Вот выйду на пенсию — буду каждый понедельник выходить на улицу в семь утра и смотреть, как люди идут на работу и страдают || 1
+Если бы понедельник имел лицо… я бы его… ударила... || 1
+Завтра во всех домах страны: психологическая драма "утро понедельника" || 7
+Надеюсь, когда-нибудь я проснусь утром, включу новости и услышу: "Понедельник отменен, продолжайте спать…" || 1
+Хороший день словом Моndау не назовут! || 1
+Люди, почему вы злитесь только на понедельник? Как будто в другие дни работать хочется || 1
+Лучше утро пятницы, чем вечер понедельника || 15
+Если вы проживете 70 лет, то проживете 10 лет понедельников… || 1
+Берите пример с понедельника: его никто не ждёт, а ему по)(уй, он все равно приходит… || 1
+Завтра будет лучше, чем вчера! А, нет, завтра ПОНЕДЕЛЬНИК || 7
+Три ужасные новости: 1. Сегодня не пятница. 2. И даже завтра не пятница. 3. И даже послезавтра не пятница || 12
+В понедельник утром, очень сильно завидуешь… безработным || 1
+Понедельник — удобный повод чего-нибудь понеделать... || 1
+Дамы и господа! Предлагаю почтить утро понедельника минутой ворчания || 1
+Вот и начались трудо выебудни || 5
+Каждый понедельник меня мучает вопрос: выходные, вы вообще были? || 1
+На улице вторник, а на душе — вечер пятницы… || 2
+Наступил долгожданный вторник — послезавтра предпоследний день рабочей недели… || 2
+Если второй день не охота идти на работу, значит сегодня вторник || 2
+Предлагаю переименовать четверг в "завтра пятница"! || 4
+Говорят, при Сталине все субботы были рабочие, должно быть он и вправду был садист и тиран! || 6
+Остановись, воскресенье! Ты прекрасно!!! || 7
+Воскресенье — день трагичный. Суббота маячит далеко позади, а до понедельника уже рукой подать || 7
--- a/data/sample_config.json
+++ b/data/sample_config.json
@@ -1,6 +1,10 @@
 {
    "user" : "nobody",
    "debug_log" : "/var/log/aleesa-telegram-bot/debug.log",
+    "friday" : {
+        "dir" : "data/friday",
+        "src" : "data/friday.txt"
+    },
    "telegrambot" : {
        "name" : "mybot",
        "tname" : "@my_bot",
--- a/lib/botlib.pm
+++ b/lib/botlib.pm
@@ -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;
--- a/lib/friday.pm
+++ b/lib/friday.pm
@@ -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:
--- a/lib/telegrambot.pm
+++ b/lib/telegrambot.pm
@@ -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 | !карма фраза     - посмотреть карму фразы
 фраза-- | фраза++         - убавить или добавить карму фразе
 ```