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

.perlcriticrc

@@ -89,3 +89,6 @@ lib_sections    = NAME | VERSION | DESCRIPTION | AUTHOR | LICENSE AND COPYRIGHT
 
 [-ErrorHandling::RequireCheckingReturnValueOfEval]
 # In this app eval is not critical to error, so there is no need to check for it
+
+[-InputOutput::RequireBriefOpen]
+# Yes, i do!

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;

cpanfile

@@ -1,5 +1,6 @@
 requires 'Cwd::utf8';
 requires 'DB_File';
+requires 'SQLite_File';
 requires 'Digest::MD5';
 requires 'Digest::SHA';
 requires 'File::Basename';

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

data/sample_config.json

@@ -27,5 +27,9 @@
     },
     "karma" : {
         "dir" : "data/karma"
+    },
+    "friday" : {
+        "dir" : "data/friday",
+        "src" : "data/friday.txt"
     }
 }

lib/friday.pm

@@ -0,0 +1,85 @@
+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);
+use botlib qw(logger);
+
+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:

lib/jabberbot.pm

@@ -16,6 +16,7 @@ use conf qw(loadConf);
 use botlib qw(weather logger trim randomCommonPhrase);
 use lat qw(latAnswer);
 use karma qw(karmaSet karmaGet);
+use friday qw(friday);
 
 use Exporter qw(import);
 use vars qw/$VERSION/;
@@ -112,11 +113,12 @@ sub __new_bot_message {
 			} elsif (substr($text, 1) eq 'help'  ||  substr($text, 1) eq 'помощь') {
 				$bot->SendGroupMessage($hash{'reply_to'}, <<"EOL" );
 !help | !помощь - это сообщение
-!w город | !п город - погода в городе
+!friday | !пятница - а не пятница ли сегодня?
 !lat | !лат - сгенерировать фразу из крылатого латинского выражения
 !ping | !пинг - попинговать бота
 !some_brew - выдать соответсвующий напиток, бармен может налить rum, vodka, beer, tequila, whisky, absinthe
 !ver | !version | !версия - написать что-то про версию ПО
+!w город | !п город - погода в городе
 !karma фраза | !карма фраза - посмотреть карму фразы
 фраза++ | фраза-- - повысить или понизить карму фразы
 EOL
@@ -132,6 +134,8 @@ 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());
 			} else {
 				$hailo->learn($text);
 				return;