diff --git a/.perlcriticrc b/.perlcriticrc index f26fd85..42b44e6 100644 --- a/.perlcriticrc +++ b/.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! diff --git a/bin/friday_seed.pl b/bin/friday_seed.pl new file mode 100644 index 0000000..5c6acfe --- /dev/null +++ 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; diff --git a/cpanfile b/cpanfile index 3daecb9..3695604 100644 --- a/cpanfile +++ b/cpanfile @@ -1,5 +1,6 @@ requires 'Cwd::utf8'; requires 'DB_File'; +requires 'SQLite_File'; requires 'Digest::MD5'; requires 'Digest::SHA'; requires 'File::Basename'; diff --git a/data/friday.txt b/data/friday.txt new file mode 100644 index 0000000..b0c52c1 --- /dev/null +++ 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 \ No newline at end of file diff --git a/data/sample_config.json b/data/sample_config.json index 3ede92a..f88c491 100644 --- a/data/sample_config.json +++ b/data/sample_config.json @@ -27,5 +27,9 @@ }, "karma" : { "dir" : "data/karma" + }, + "friday" : { + "dir" : "data/friday", + "src" : "data/friday.txt" } } diff --git a/lib/friday.pm b/lib/friday.pm new file mode 100644 index 0000000..6e95599 --- /dev/null +++ b/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: diff --git a/lib/jabberbot.pm b/lib/jabberbot.pm index 129d6bb..fd009ca 100644 --- a/lib/jabberbot.pm +++ b/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;