Merge branch 'master' into update_teapot_bot_lib_to_api_v5.1

* Untie %secret explicitly to prevent possible data corruption
* Handle case when verifier is in config but request token absent in db

.gitignore

@@ -1,7 +1,13 @@
-vendor_perl
-data/config.json
-data/cache
-data/telegrambot-brains
-data/lat
+_Deparsed_XSubs.pm
+.idea/**
+.vscode/**
 aleesa-telegram-bot.pid
-TODO
+data/cache/**
+data/config.json
+data/fortune/**
+data/friday/**
+data/karma/**
+data/telegrambot-brains/**
+data/lat/**
+data/image/**
+vendor_perl/**

.perlcriticrc

@@ -85,4 +85,11 @@ verbose     = 8
 [Documentation::RequirePodSections]
 # 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
+lib_sections    = NAME | VERSION | DESCRIPTION | AUTHOR | LICENSE AND COPYRIGHT
+
+[-InputOutput::RequireBriefOpen]
+# Yes, i do!
+
+[-ControlStructures::ProhibitDeepNests]
+# Have to use it, so fuckoff
+

README.md

@@ -1,37 +1,103 @@
-# Aleesa-Telegram-bot - Simple Telegram chatty bot
+# Aleesa-Telegram-bot - Telegram chatty bot
 
 ## About
 
 It is based on Perl modules [Telegram::Bot][1] and [Hailo][2] as conversation
 generator.
 
-I have to fork [Telegram::Bot][1] and add some of new methods that are already
-appear in [Telegram API][3], but author seems to abandon lib. Also i decide to
-rename it to avoid collision in future, now it is Teapot::Bot and is bundled
-with bot. When lib become mature enough, maybe i release it separately.
+I have to fork [Telegram::Bot][1] and update it according to features appeared
+in [Telegram Bot API v5][3]. Also, I decide to rename it to avoid collision in
+the future, now it is Teapot::Bot and is bundled with bot. When lib becomes
+mature enough, maybe I release it separately.
 
 Bot config located in **data/config.json**, sample config provided as
 **data/sample_config.json**.
 
-Bot can be run via **bin/aleesa-telegam-bot** and acts as daemon.
+Bot can be run via **bin/aleesa-telegram-bot** and acts as daemon (double fork()
+and detaches stdio).
 
 ## Installation
 
 In order to run this application, you need to "bootstrap" it - download and build
 all required dependencies and libraries.
 
-You'll need "Development Tools" or similar group of packages, perl, perl-devel,
-perl-local-lib, perl-app-cpanm, sqlite-devel, zlib-devel, openssl-devel,
-libdb4-devel (Berkeley DB devel), make.
+You'll need perl-5.18 or newer, "Development Tools" or similar group of
+packages, perl, perl-devel, perl-local-lib, perl-app-cpanm, sqlite-devel,
+zlib-devel, openssl-devel, libdb4-devel (Berkeley DB devel), make.
 
-After installng required dependencies it is possible to run:
+After installing required dependencies it is possible to run:
 
 ```bash
+
 bash bootstrap.sh
+
 ```
 
 and all libraries should be downloaded, built, tested and installed.
 
+## Running
+
+This bot does not [ultilize][4] webhooks, so in order to run it only well
+internet connection is requied, no public-available ip address is needed.
+
+### Additional Settings to be performed in order to run bot as it designed
+
+There are some "plugins" that requires registration on thrird party services
+and API keys and secrets in order to work.
+
+#### OpenWeatherMap
+
+You should [register][5], [login][6] and [create][7] api key. Free plan have
+all required features to run this "plugin".
+
+Once key is created you should put it in **config.json** under openweathermap
+section as appid. Thats it.
+
+It is still impossible to disable this plugin, but "I'm working on it".
+
+#### Imgur
+
+This plugin "just exists" and is actually used nowhere around the code.
+Anyway, to make use of it besides registering apropriate handler in code, you
+should sign in imgur and get access token.
+
+Actually at this time this "plugin" can be stub-ed with default config values.
+
+Anyway, to fetch access token you should [login][8] and perform [registration][9]
+of your app. Then you should authorise your app according to [this][10] manual. Or
+[this][11] one.
+
+#### Flickr
+
+This "plugin" is really used to implement random picture link retrival plugins.
+
+There is helper script in **bin/flickr_init.pl** that helps to get all required keys
+and secrets from flickr api.
+
+Before using it bot must be bootstrapped via **`bootstrap.sh`**.
+
+[Login][11] and create an [app][12] in your flickr account. Then *logout* flickr account.
+(It is required in order to properly get "verfier" parameter later).
+
+Put your [app key and secret][13] to **config.json**. Ensure that "verifier" parameter
+in Flickr-related part of config either absent or commented out.
+
+Run **bin/flickr_init.pl** first time and follow on screen instuctions - copy and
+paste given link to browser login to flickr account adn yo'll be redirected to
+example.com. Check address bar in browser to get so-called "verifier", put it in
+**config.json**. Then run **bin/flickr_init.pl** again to store API access token in db
+under data/image directory (in default config). You're done.
+
 [1]: https://metacpan.org/pod/Telegram::Bot
 [2]: https://metacpan.org/pod/Hailo
-[3]: https://core.telegram.org/bots/api
+[3]: https://core.telegram.org/bots/api
+[4]: https://core.telegram.org/bots/api#getting-updates
+[5]: https://home.openweathermap.org/users/sign_up
+[6]: https://home.openweathermap.org/users/sign_in
+[7]: https://home.openweathermap.org/api_keys
+[8]: https://imgur.com/signin
+[9]: https://api.imgur.com/oauth2/addclient
+[10]: https://apidocs.imgur.com/#authorization-and-oauth
+[11]: https://identity.flickr.com/login
+[12]: https://www.flickr.com/services/apps/create/apply/
+[13]: https://www.flickr.com/services/api/keys/

README_RU.md

@@ -0,0 +1,103 @@
+# Aleesa-Telegram-bot - Болтливый бот для Telegram
+
+## Что это такое
+
+Это бот основанный на перловых модулях [Telegram::Bot][1] для работы в
+мессенджере Telegram и [Hailo][2] для генерации "умной" беседы.
+
+Для корректной работы пришлось форкнуть [Telegram::Bot][1] чтобы обновить
+интерфейс API до [Telegram Bot API v5][3]. Для избежания неоднозначностей модуль
+пришлось переименовать и теперь он идёт в составе бота. Возможно, когда модуль
+отлежится и будет похож на стабильный, он стнет самостоятельным и поселится на
+metacpan.org
+
+Конфиг бота должен лежать в **data/config.json**, пример конфига расположен в
+**data/sample_config.json**.
+
+Бота можно запустить через **bin/aleesa-telegram-bot** и он взлетит как юниксовый
+демон (сделает двойной fork() и отцепится от stdio).
+
+## Установка
+
+Чтобы запустить приложение, его надо "забурстрапить" - загрузить и собрать все
+необходимые зависимости.
+
+Понадобится perl-5.18 а желательно новее, "Development Tools" или подобная
+группа пакетов , perl, perl-devel, perl-local-lib, perl-app-cpanm, sqlite-devel,
+zlib-devel, openssl-devel, libdb4-devel (Berkeley DB devel), make.
+
+После установки этих пакетов можно будет запустить:
+
+```bash
+
+bash bootstrap.sh
+
+```
+
+и по идее всё что нужно будет выкачено, собрано и разложено куда надо.
+
+## Запуск и работа
+
+Бот не использует [вебхуки][4], поэтому ничего дополнительного, кроме хорошего
+подключения к интернету ему не нужно.
+
+### Дополнительные настройки
+
+Некоторые "плагины" требуют регистрации в сторонних сервисах (API keys, secrets
+итд), чтобы бот не сыпал ошибками в логи (возможно, в дальнейшем возможно будет
+отключить эти плагины).
+
+#### OpenWeatherMap
+
+Для работы погодного плагина надо [заргистрироваться][5], [залогиниться][6] и
+[создать][7] api key. Free plan предлагает всё необхдимое для работы "плагина".
+
+Когда api key будет создан, его нужно вписать в **config.json** "секцию"
+openweathermap в качестве appid. На этом всё.
+
+#### Imgur
+
+Этот плагин "просто есть" и его на самом деле ничто и никто не использует. И в
+этой связи все настройки плагина можно оставить "как есть" в примере конфига.
+
+Тем не менее, если есть большое желание, то можно [залогиниться][8] и
+[зарегистрировать][9] бота как приложение, а потом разрешить приложению
+пользоваться API-шкой, как описано в [этом][10] или [этом][11] мануале.
+
+#### Flickr
+
+Этот "плагин" действительно используется для добычи ссылок на картинки в разных
+"картиночных" командах бота.
+
+Есть скрипт, который поможет с регистрацией приложения в api Flickr -
+**bin/flickr_init.pl** он достанет все нужные ключи и секреты к ним.
+
+До запуска этого скрипта, бот должен быть забутстраплен через **`bootstrap.sh`**.
+
+[Залогиньтесь][11] и создайте [app][12] in своём Flicker-овском аккаунте. Далее,
+*разлогиньтесь*, это нужно, чтобы потом проще было достать параметр verifier.
+
+Запишите [app key и secret][13] в **config.json**. Удостоверьтесь, что параметр
+"verifier" в конфиге либо закоменчен либо отсутствует.
+
+Запустите **bin/flickr_init.pl** и следуте предлагаемым инструкциям - в итоге
+будет дана ссылка, которую надо скопипастить в браузер и через один-два
+редиректа вы попадёте на example.com. Из адресной строки браузера надо
+скопировать параметр "verifier" и вписать его в **config.json**.
+
+Чтобы сохранить в бд плагина API access token для нормальной работы "плагина",
+второй раз запустите **bin/flickr_init.pl**. На этом всё.
+
+[1]: https://metacpan.org/pod/Telegram::Bot
+[2]: https://metacpan.org/pod/Hailo
+[3]: https://core.telegram.org/bots/api
+[4]: https://core.telegram.org/bots/api#getting-updates
+[5]: https://home.openweathermap.org/users/sign_up
+[6]: https://home.openweathermap.org/users/sign_in
+[7]: https://home.openweathermap.org/api_keys
+[8]: https://imgur.com/signin
+[9]: https://api.imgur.com/oauth2/addclient
+[10]: https://apidocs.imgur.com/#authorization-and-oauth
+[11]: https://identity.flickr.com/login
+[12]: https://www.flickr.com/services/apps/create/apply/
+[13]: https://www.flickr.com/services/api/keys/

bin/aleesa-telegram-bot

@@ -4,40 +4,53 @@ use 5.018;
 use strict;
 use warnings;
 use utf8;
-use open qw(:std :utf8);
-use English qw( -no_match_vars );
+use open qw (:std :utf8);
+use English qw ( -no_match_vars );
 
-use version; our $VERSION = qw(1.0);
+use version; our $VERSION = qw (1.0);
 
 my $workdir;
 
 # before we run, change working dir
 BEGIN {
-	use Cwd qw(chdir abs_path);
+	use Cwd qw (chdir abs_path);
 	my @CWD = split /\//xms, abs_path ($PROGRAM_NAME);
-	if ($#CWD > 1) { $#CWD = $#CWD - 2; }
+
+	if ($#CWD > 1) {
+		$#CWD = $#CWD - 2;
+	}
+
 	$workdir = join '/', @CWD;
 	chdir $workdir;
 }
 
 use lib ("$workdir/lib", "$workdir/vendor_perl", "$workdir/vendor_perl/lib/perl5");
 no Cwd;
-use Cwd::utf8 qw(chdir abs_path);
-use POSIX qw(setgid setuid setsid);
-use File::Path qw(make_path);
-use File::Basename qw(basename dirname);
-use conf qw(loadConf);
-use botlib qw(logger);
-use telegrambot qw(run_telegrambot);
+use Cwd::utf8 qw (chdir abs_path);
+use File::Basename qw (basename dirname);
+use File::Path qw (make_path);
+use Log::Any::Adapter;
+use Log::Any::For::Std;
+use POSIX qw (setgid setuid setsid);
+use conf qw (loadConf);
+use telegrambot qw (run_telegrambot);
 
 sub daemonize;
 sub __fork;
+sub __signal_handler;
 
 local $OUTPUT_AUTOFLUSH = 1;
 my $runAsUid = $UID;
 
 my $piddir = '/var/run/' . basename (abs_path ($PROGRAM_NAME));
 my $C = loadConf ();
+my $logfile;
+
+if (defined $C->{'log'}) {
+	$logfile = $C->{'log'};
+} elsif (defined $C->{'debug_log'}) {
+	$logfile = $C->{'debug_log'};
+}
 
 # if we run under root, create pid dir and set correct owner for it, same for debug log if it is defined
 if ($UID == 0) {
@@ -58,14 +71,16 @@ if ($UID == 0) {
 		);
 	}
 
-	if ($C->{'debug_log'}) {
-		unless (-d dirname ($C->{'debug_log'})) {
+	if (defined $logfile) {
+		my $logdir = dirname $logfile;
+
+		unless (-d $logdir) {
 			make_path (
-				dirname ($C->{'debug_log'}), {
-					uid   => $uid,
-					group => $gid
-				}
-			);
+					$logdir, {
+							uid   => $uid,
+							group => $gid
+					}
+			) or die "Unable to create $logdir: $OS_ERROR\n";
 		}
 	}
 
@@ -76,6 +91,12 @@ if ($UID == 0) {
 	$piddir = $workdir;
 }
 
+if (defined $logfile) {
+	Log::Any::Adapter->set ('File', $logfile);
+} else {
+	Log::Any::Adapter->set ('File', '/dev/null');
+}
+
 # double fork attach to /dev/null all stdio and go background
 daemonize ();
 
@@ -83,17 +104,19 @@ daemonize ();
 my $apath = abs_path $PROGRAM_NAME;
 
 unless (defined $apath) {
-	logger "Unable to get abs_path: $OS_ERROR";
-	die "Unable to get abs_path: $OS_ERROR\n";
+	die "[FATAL] Unable to get abs_path: $OS_ERROR\n";
 };
 
 # write pidfile
 my $pidfile = sprintf '%s/%s.pid', $piddir, basename $apath;
-logger "Creating pidfile at $pidfile";
-open my $MYPID, '>', $pidfile or die "Error opening $pidfile: $OS_ERROR\n";
-print {$MYPID} $PID or die "Error writing to $pidfile: $OS_ERROR\n";
+warn "[INFO] Creating pidfile at $pidfile\n";
+open my $MYPID, '>', $pidfile or die "[FATAL] Error opening $pidfile: $OS_ERROR\n";
+print {$MYPID} $PID or die "[FATAL] Error writing to $pidfile: $OS_ERROR\n";
 close $MYPID;                                        ## no critic (InputOutput::RequireCheckedSyscalls
 
+local $SIG{INT}  = \&__signal_handler;
+local $SIG{TERM} = \&__signal_handler;
+
 # set correct proctitle
 $PROGRAM_NAME = abs_path $PROGRAM_NAME;              ## no critic (Variables::RequireLocalizedPunctuationVars)
 
@@ -110,8 +133,9 @@ sub daemonize {
 	__fork ();
 	POSIX::setsid ();
 	open STDIN, '<', '/dev/null';                    ## no critic (InputOutput::RequireCheckedSyscalls, InputOutput::RequireCheckedOpen)
-	open STDOUT, '>', '/dev/null';                   ## no critic (InputOutput::RequireCheckedSyscalls, InputOutput::RequireCheckedOpen)
-	open STDERR, '>', '/dev/null';                   ## no critic (InputOutput::RequireCheckedSyscalls, InputOutput::RequireCheckedOpen)
+	# we handle STDOUT && STDERR via Log::Any::For::Std, so do not close them explicitly
+	#open STDOUT, '>', '/dev/null';                   ## no critic (InputOutput::RequireCheckedSyscalls, InputOutput::RequireCheckedOpen)
+	#open STDERR, '>', '/dev/null';                   ## no critic (InputOutput::RequireCheckedSyscalls, InputOutput::RequireCheckedOpen)
 	__fork ();
 	umask 0;
 	return;
@@ -119,10 +143,27 @@ sub daemonize {
 
 sub __fork {
 	my $pid = fork;
-	unless (defined $pid) { die "Can't fork: $OS_ERROR\n"; }
-	exit if ($pid != 0);
+
+	unless (defined $pid) {
+		die "[FATAL] Can't fork: $OS_ERROR\n";
+	}
+
+	if ($pid != 0) {
+		exit;
+	}
+
 	return;
 }
 
+sub __signal_handler {
+	warn "[INFO] Caught a signal $OS_ERROR\n";
+
+	if (-f $pidfile) {
+		unlink $pidfile;
+	}
+
+	exit 0;
+}
+
 __END__
 # vim: set ft=perl noet ai ts=4 sw=4 sts=4:

bin/flickr.pl

@@ -0,0 +1,32 @@
+#!/usr/bin/perl
+
+use 5.018;
+use strict;
+use warnings;
+use utf8;
+use open qw (:std :utf8);
+use English qw ( -no_match_vars );
+use version; our $VERSION = qw (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 flickr qw (flickr_by_tags);
+
+my $url = flickr_by_tags ('bird,owl');
+
+if ($url) {
+	say $url; ## no critic (InputOutput::RequireCheckedSyscalls)
+	exit 0;
+} else {
+	exit 1;
+}

bin/flickr_init.pl

@@ -0,0 +1,29 @@
+#!/usr/bin/perl
+
+use 5.018;
+use strict;
+use warnings;
+use utf8;
+use open qw (:std :utf8);
+use English qw ( -no_match_vars );
+use version; our $VERSION = qw (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 flickr qw (flickr_init);
+
+if (flickr_init ()) {
+	exit 0;
+} else {
+	exit 1;
+}

bin/flickr_test.pl

@@ -0,0 +1,29 @@
+#!/usr/bin/perl
+
+use 5.018;
+use strict;
+use warnings;
+use utf8;
+use open qw (:std :utf8);
+use English qw ( -no_match_vars );
+use version; our $VERSION = qw (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 flickr qw (flickr_test_login);
+
+if (flickr_test_login ()) {
+	exit 0;
+} else {
+	exit 1;
+}

bin/fortune_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 version; our $VERSION = qw (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 fortune qw (seed);
+use Carp;
+local $SIG{__DIE__} = sub { Carp::confess @_ };
+
+seed ();
+exit 0;

bin/friday_seed.pl

@@ -0,0 +1,26 @@
+#!/usr/bin/perl
+
+use 5.018;
+use strict;
+use warnings;
+use utf8;
+use open qw (:std :utf8);
+use English qw ( -no_match_vars );
+use version; our $VERSION = qw (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;

bin/train_lat.pl

@@ -4,16 +4,15 @@ 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';
+use open qw (:std :utf8);
+use English qw ( -no_match_vars );
+use version; our $VERSION = qw (1.0);
 
 my $workdir;
 
 # before we run, change working dir
 BEGIN {
-	use Cwd qw(chdir abs_path);
+	use Cwd qw (chdir abs_path);
 	my @CWD = split /\//xms, abs_path ($PROGRAM_NAME);
 	if ($#CWD > 1) { $#CWD = $#CWD - 2; }
 	$workdir = join '/', @CWD;
@@ -21,7 +20,7 @@ BEGIN {
 }
 
 use lib ("$workdir/lib", "$workdir/vendor_perl", "$workdir/vendor_perl/lib/perl5");
-use lat qw(train);
+use lat qw (train);
 
 train ();
 exit 0;

confcheck.pl

@@ -4,16 +4,16 @@ use 5.018;
 use strict;
 use warnings;
 use utf8;
-use open qw(:std :utf8);
-use English qw( -no_match_vars );
-use lib qw(./lib ./vendor_perl ./vendor_perl/lib/perl5);
-use JSON::PP;
+use open qw (:std :utf8);
+use English qw ( -no_match_vars );
+use lib qw (./lib ./vendor_perl ./vendor_perl/lib/perl5);
+use JSON::XS;
 
-use version; our $VERSION = qv(1.0);
+use version; our $VERSION = qw (1.0);
 
 my $c = 'data/config.json';
-open (my $C, '<', $c) or die "No conf at $c: $OS_ERROR\n"; ## no critic (InputOutput::RequireBriefOpen)
-my $len = (stat ($c)) [7];
+open (my $C, '<', $c) or die "No conf at $c: $OS_ERROR\n";
+my $len = (stat $c) [7];
 my $json;
 my $readlen = read ($C, $json, $len);
 
@@ -28,9 +28,10 @@ if ($readlen != $len) {
 }
 
 close C;                                             ## no critic (InputOutput::RequireCheckedSyscalls)
-$c = decode_json ($json);
+$c = JSON::XS->new->utf8->relaxed;
+my $data = $c->decode ($json);
 
-my $j = JSON::PP->new->pretty->canonical->indent_length (4); ## no critic (ValuesAndExpressions::ProhibitLongChainsOfMethodCalls)
-print $j->encode ($c);                               ## no critic (InputOutput::RequireCheckedSyscalls)
+my $j = JSON::XS->new->pretty();
+print $j->encode ($data);                            ## no critic (InputOutput::RequireCheckedSyscalls)
 
 # vim: set ft=perl noet ai ts=4 sw=4 sts=4:

cpanfile

@@ -1,23 +1,31 @@
 requires 'Carp';
+requires 'CHI';
+requires 'CHI::Driver::BerkeleyDB';
 requires 'Cwd::utf8';
+requires 'DateTime';
 requires 'DB_File';
+requires 'SQLite_File';
+requires 'Digest::HMAC_SHA1';
 requires 'Digest::MD5';
 requires 'Data::Dumper';
-requires 'Digest::SHA1';
+requires 'Digest::SHA';
 requires 'File::Basename';
 requires 'File::Path';
 requires 'Hailo';
-requires 'HTTP::Tiny';
+requires 'HTML::TokeParser';
 requires 'IO::Socket::SSL';
 requires 'JSON';
-requires 'JSON::PP';
 requires 'JSON::XS';
 requires 'List::Util';
 requires 'local::lib';
 requires 'Log::Any';
+requires 'Log::Any::Adapter';
+requires 'Log::Any::For::Std';
+requires 'Math::Random::Secure';
 requires 'Mojo::Base';
 requires 'Mojo::IOLoop';
 requires 'Mojo::UserAgent';
-#requires 'Telegram::Bot';
-#requires 'Test::Exception';
+requires 'Mojo::UserAgent::Cached';
+requires 'Text::Fuzzy';
+requires 'URI::Encode::XS';
 requires 'URI::URL';

data/fortune_src/citates

@@ -0,0 +1,521 @@
+Что сказал Берлиоз своей музыкой? - ничего; но как потрясающе он это
+сказал.
+		-- Джеймс Гиббонз Хьюнекер
+%
+Музыка будет по-немецки, вы не поймете.
+		-- Оскар Уайльд
+%
+Четвертый раз смотрю этот фильм и должна вам сказать, что сегодня актеры
+играли как никогда.
+		-- Фаина Раневская
+%
+Продолжительность фильма определяется выносливостью мочевого пузыря
+обычного зрителя.
+		-- Альфред Хичкок
+%
+А что, если наша Земля - ад какой-нибудь другой планеты?
+		-- Олдос Хаксли
+%
+Если видишь женщину голой достаточно долго, опять начинаешь обращать
+внимание на ее лицо.
+		-- Генри Миллер
+%
+Самое главное - выглядеть совершенно естественно; но для этого нужно очень
+много косметики.
+		-- Кельвин Кляйн
+%
+Любовь - лучшая косметика. Но косметику купить легче.
+		-- Ив Сен-Лоран
+%
+Людей без лишнего веса больше всего на кладбище.
+		-- Биверли Силлз
+%
+Лучше быть молодым навозным жуков, чем старой райской птицей.
+		-- Марк Твен
+%
+К старости недостатки ума становятся все заметнее, как и недостатки
+внешности.
+		-- Франсуа Ларошфуко
+%
+Лучше быть старой, чем мертвой.
+		-- Бриджит Бардо
+%
+Вечеринка с коктейлями: место, где можно встретить людей, которые пьют так
+много, что вы не можете вспомнить их имена.
+		-- Космо Сардо
+%
+Средство от похмелья: выжать сок из двух бутылок виски...
+		-- Эдди Кондон
+%
+Дважды два уже четыре, а будет еще лучше.
+		-- Хенрик Ягодзинский
+%
+Я сидел на диете 14 дней и потерял всего две недели.
+		-- Тоти Филдс
+%
+В жизни можно полагаться только на себя самого. Да и то не советую!
+		-- Тристан Бернар
+%
+Источник нашей мудрости - наш опыт. Источник нашего опыта - наша глупость.
+		-- Саша Гитри
+%
+Уходя на тот свет, не забудь выключить этот.
+		-- Виктор Коваль
+%
+Я не верю ни единому слову из того, что вы говорите... или я вам.
+		-- Оскар Уайльд
+%
+Я думаю, мы должны говорить правду или хотя бы говорить то, что мы думаем.
+		-- Юрий Лужков
+%
+Нельзя иметь все. Куда вы это положите?
+		-- Стивен Райт
+%
+Сначала забываешь имена, потом забываешь лица, потом забываешь застегивать
+ширинку, потом забываешь расстегивать ширинку.
+		-- Лео Розенберг
+%
+Время - лучший учитель, но, к сожалению, оно убивает своих учеников.
+		-- Гектор Берлиоз
+%
+Прошлое - чужая страна, там все по-другому.
+		-- Лесли Хартли
+%
+Помните о бедняках - это не требует никаких расходов.
+		-- Генри Уиллер Шоу
+%
+Я люблю своих детей, но некоторые мне не нравятся.
+		-- Лилиан Картер, мать президента США Д.Картера
+%
+Дружба - это когда можно ни с того ни с сего приехать к человеку
+и поселиться у него.
+		-- Давид Самойлов
+%
+Врагов я забрасываю цветами - в гробу!
+		-- Сальвадор Дали
+%
+Я не боюсь умереть. Я просто не хочу при этом присутствовать.
+		-- Вуди Аллен
+%
+Какой замечательный некролог! С таким бы жить и жить!
+		-- М.Генин
+%
+Твои шансы выиграть в лотерею возрастут, если ты купишь билет.
+		-- Уинстон Грум из "Правил Фореста Гампа"
+%
+Пока вы ищете, кого бы стоило полюбить, вам нужен кто-то, кто любит вас.
+		-- Шейла Делейни
+%
+Если двое любят друг друга, это не может счастливо кончиться.
+		-- Э.Хемингуэй
+%
+Я порвала с ним через три года. Это была типичная любовь-ненависть. Мы оба
+любили его и ненавидели меня.
+		-- Кэрол Зискинд
+%
+В тех кругах, в которых я вращаюсь, переспать с женщиной - недостаточный
+повод для того, чтобы быть ей представленным.
+		-- Вирджиния Маклауд
+%
+Она говорила на восемнадцати языках и ни на одном из них не умела сказать
+"нет".
+		-- Дороти Паркер
+%
+Помни: в пяти случаях из шести свет в конце туннеля - это свет
+надвигающегося поезда.
+		-- Пол Диксон
+%
+Все соседи плохи, но верхние хуже нижних.
+		-- Константин Мелихан
+%
+Америка - единственный матриархат, под сенью которого женщины ведут борьбу
+за равные права.
+		-- А. Рот
+%
+Брак - это лотерея, но в случае проигрыша вы не можете порвать свой билет.
+		-- Ф. Ноулз
+%
+Британский солдат устоит против кого угодно, только не против Британского
+министерства обороны.
+		-- Бернард Шоу
+%
+Век наш таков, что он гордится машинами, умеющими думать, и побаивается
+людей, которые пытаются проявить ту же способность.
+		-- Г.Мамфорд Джонс
+%
+Военная мудрость есть понятие, заключающее противоречие в самом себе.
+Война - слишком серьезное дело, чтобы доверять его военным.
+		-- Талейран
+%
+Выход из беды найти не столь просто, как попасть в нее.
+		-- Эд Хау
+%
+Граница в политической географии - воображаемая линия между двумя
+государствами, отделяющая воображаемые права одного от воображаемых прав
+другого.
+		-- А.Бирс
+%
+Да не устрашит тебя величие: одни рождаются великими, другие достигают
+величия, третьим его навязывают.
+		-- Уильям Шекспир
+%
+Две тысячи лет нам поставляли примеры для подражания, и теперь ничто нас
+не извиняет, если мы, воюя, воем плохо.
+		-- Т.Э. Лоуренс
+%
+Дипломная работа среднего выпускника университета есть не что иное, как
+кости, перенесенные из одной могилы в другую.
+		-- Дж. Фрэнк Доуби
+%
+Для любой волнующей человека проблемы всегда легко найти решение -
+простое, достижимое и ошибочное.
+		-- Г.Л. Менкен
+%
+Добрым словом и револьвером вы можете добиться гораздо большего, чем одним
+только добрым словом.
+		-- Аль Капоне
+%
+Если вы не восходящий, значит, вы ниспадающий.
+		-- Стивен Поттер
+%
+Если честолюбивая мечта не заставляет вас страдать, значит, ее у вас нет.
+		-- К. Норрис
+%
+Идеалист тот, кто, заметив, что роза пахнет лучше капусты, заключает, что
+и суп из нее будет лучше.
+		-- Г. Менкен
+%
+Жизнь что луковица - вы чистите ее, снимая слой за слоем, и иногда
+плачете.
+		-- С. Сандберг
+%
+Когда люди вольны поступать как угодно, они обычно подражают друг другу.
+		-- Э. Хоффер
+%
+Коли все думают одинаково, значит, никто особенно и не думает.
+		-- У.Липпман
+%
+Компьютеры бесподобны: за несколько минут они могут совершить такую
+грандиозную ошибку, какую не в состоянии сделать множество людей за многие
+месяцы.
+		-- М. Мичэм
+%
+Логика - это искусство ошибаться с уверенностью в своей правоте.
+		-- Дж. У. Крач
+%
+Любовь - вещь идеальная, супружество - реальная; смешение реального с
+идеальным никогда не проходит безнаказанно.
+		-- И. Гете
+%
+Любое ваше решение - это ошибка.
+		-- Эдуард Далберг
+%
+Мой способ шутить - это говорить правду. На свете нет ничего
+смешнее.
+		-- Бернард Шоу
+%
+На моем веку было очень много прогресса, но, боюсь, не в том направлении.
+		-- О. Нэш
+%
+Нам мало добиться успеха. Надо еще, чтобы друзья наши потерпели крах.
+		-- Ларошфуко
+%
+Невеста - женщина, у которой виды на счастье остались позади.
+		-- А. Бирс
+%
+Нужно учредить Нобелевскую премию за остроумие. Без физиков, химиков,
+экономистов мы, если прижмет, как-нибудь обойдемся. Без мира обычно тоже
+обходимся. Без остроумия - пропадем.
+		-- Джордж Ф. Уилл
+%
+О несчастном случае мой подзащитный впервые узнал лишь тогда, когда этот
+случай произошел.
+		-- Из речи адвоката
+%
+Первый и наихудший из всех подвохов - обмануть самого себя. Потом уже
+легко впасть в любой грех.
+		-- Дж. Бэйли
+%
+По самой своей природе человек, чем старше он становится, тем больше
+противится переменам, особенно переменам к лучшему.
+		-- Дж. Стейнбек
+%
+Поиск истины способен изрядно позабавить.
+		-- Вернон Говард
+%
+Полицейский находится на своем месте не для того, чтобы создавать
+беспорядок; полицейский находится там, чтобы поддерживать беспорядок.
+		-- Ричард Дж. Дейли, мэр Чикаго
+%
+Посредственность - добродетель в глазах посредственных людей.
+		-- Ж. Жобер
+%
+Посредственный учитель излагает. Хороший учитель объясняет. Выдающийся
+учитель показывает. Великий учитель вдохновляет.
+		-- Уильям Артур Уорд
+%
+Президенту в его окружении не нужны мужчины и женщины, умеющие только
+поддакивать. Если он говорит "нет", мы все говорим "нет".
+		-- Элизабет Доул, помощница президента Рейгана
+%
+"Радость моя, мы живем в переходную эпоху", говорил Адам Еве по дороге из
+рая.
+		-- У. Инге
+%
+"С нами такого случиться не может" - это фраза номер один в списке
+знаменитых последних слов.
+		-- Дэвид Кросби
+%
+Самая большая ложь - это неверно понятая правда.
+		-- Уильям Джеймс
+%
+Скрипка - инструмент для щекотания человеческих ушей при помощи трения
+лошадиного хвоста о внутренности кошки.
+		-- Амброз Бирс
+%
+Среди преподавателей большинство составляют те, кто не прервет чтение
+своих лекций по навигации, даже если корабль уже тонет. Следствие:
+путешествие длиною в тысячу миль завершается одним-единственным шагом.
+		-- Джеймс Г. Борен
+%
+Творческое мышление, возможно, означает всего-навсего понимание, что нет
+никакой особой добродетели в том, чтобы вести дела так, как их всегда вели до
+нас.
+		-- Рудольф Флеш
+%
+Технический прогресс лишь снабдил нас действенными средствами для движения
+назад.
+		-- О. Хаксли
+%
+То, что мы называем прогрессом, представляет собой замену одной
+неприятности другою.
+		-- Г. Эллис
+%
+Учитель прикасается к вечности: никто не может сказать, где кончается его
+влияние.
+		-- Генри Адамс
+%
+Человеку надлежит жить с самим собой и постоянно заботиться, чтобы это
+была хорошая кампания.
+		-- С.И. Хьюз
+%
+Эксперт - это человек, знающий все больше и больше о все меньшем и
+меньшем. Следствие: колледж не может обеспечить компетентность; он может
+обеспечить диплом.
+		-- Николас Батлер
+%
+Эксперт - это человек, который больше уже не думает; он знает.
+		-- К. Хаббард
+%
+Я не верю в коллективную мудрость невежественных индивидуумов.
+		-- Т. Карлейль
+%
+Я не против полиции, я просто боюсь ее.
+		-- Альфред Хичкок
+%
+Я никогда не мог взять в толк, почему из-за того только, что я выражаюсь
+невразумительно, никто меня не понимает.
+		-- Милтон Мейер
+%
+Пожилые люди думают, что с тех пор, как они постарели, мир только теряет,
+но ничего не приобретает.
+		-- Жеремена Сталь
+%
+Меня интересует мнение не тех людей, которые разбираются в данном вопросе,
+а тех, которые сами кое-что сделали в одной из областей знания.
+		-- Hорберт Винер
+%
+Случайные открытия совершают только подготовленные умы.
+		-- Паскаль
+%
+Бывают услуги настолько большие, что рассчитаться за них можно только
+неблагодарностью.
+		-- Дюма-отец
+%
+"Тоже неплохо!" - сказал зять, бросив камнем в собаку, а попав в тещу.
+		-- Плутарх. "Пир семи мудрецов".
+%
+Не ковыряй в носу перочинным ножиком. Лезвие легко ржавеет.
+		-- Из книги "Пи"
+%
+Очень много - иногда вполне достаточно для женщины.
+		-- Из книги "Ву"
+%
+В жизни можно рассчитывать только на самих себя. И то не всегда.
+		-- Тристан Бернар
+%
+Все было бы очень хорошо, если бы все наши поступки можно было бы совершать
+дважды.
+		-- Гете
+%
+E = mC
+		-- Альберт Эйнштейн
+%
+Человек бывает таким, каким его создал бог, но преимущественно немного хуже.
+		-- Сервантес
+%
+Две параллельных линии полюбили друг друга. Трагедия!
+		-- Из книги "Пи"
+%
+Я знаток всех "и т. д., и т. п." и я знаю, когда за ними ничего больше
+не скрывается.
+		-- Гомес де ля Серна
+%
+Одна туча может погрузить в темноту весь парк, одно слово может затемнить
+самое большое счастье.
+		-- Гомес де ля Серна
+%
+Тот факт, что будильник не прозвенел, изменило уже много человеческих судеб.
+		-- Агата Кристи
+%
+Заполнять жизнь - это еще не значит обогащать ее.
+		-- Из книги "Пи"
+%
+Самым серьезным достоинством современного искусства является то, что, когда
+эти произведения смотрят дети, они не задают таких вопросов, на которые
+обычно бывает трудно отвечать.
+		-- Лорд Галлюкс
+%
+Замужних женщин значительно больше, чем женатых мужчин.
+		-- По данным американской статистики
+%
+Совесть - это тот голос, который говорит тебе, что не надо делать именно то,
+что ты только что сделал.
+		-- Из книги "Пи"
+%
+И мелкие неприятности могут отравить жизнь, если нет крупных.
+		-- Р. Гомес де ля Серна
+%
+Счастлив тот, кто ни о чем не думает.
+		-- Софокл
+%
+Я не читаю газет. Все, о чем там стоит знать, всегда кто-нибудь расскажет.
+		-- Лорд Галлюкс
+%
+Недостаточно встать рано, надо еще и проснуться.
+		-- Из книги "Ву"
+%
+Высохшую реку не благодарят за ее прошлое.
+		-- Рабиндранат Тагор
+%
+Давать советы всегда плохо, но хорошего совета тебе никто не простит.
+		-- Оскар Уайльд
+%
+Устарели не только ответы, но даже сами вопросы.
+		-- Хемингуэй
+%
+Друзья, как арбузы: случается, что из десяти ни одного хорошего не выбрать.
+		-- Из книги "Пи"
+%
+Пока слушатели во время лекции поглядывают на часы, все в порядке. Страшно,
+когда они начинают удивленно подносить часы к уху.
+		-- Из книги "Пи"
+%
+Нет правила, которого нельзя было бы нарушить ради более прекрасного.
+		-- Л. Бетховен
+%
+Прекрасна молодость, когда она в движении и знает, куда приложить свои силы.
+		-- Менандр
+%
+Простим горячке юных лет
+И юный жар, и юный бред.
+		-- А. С. Пушкин
+%
+Грустно думать, что напрасно
+Была нам молодость дана.
+		-- А. С. Пушкин
+%
+Всего больнее знать, что счастье было так близко - и ты сам его отверг.
+		-- Софокл
+%
+Настоящий художник настолько владеет искусством, насколько оно владеет им.
+		-- Г. Флобер
+%
+Великие люди сами сооружают себе пьедестал; статую воздвигнет будущее.
+		-- В. Гюго
+%
+...заслуги отца на сына не распространяются.
+		-- М. Сервантес
+%
+Давайте жить так, чтобы даже гробовщику стало жалко, когда мы умрем.
+		-- Марк Твен
+%
+ - Обладаешь ли ты разумом?
+ - Обладаю.
+ - Почему же ты не пользуешься им?
+ 		-- Марк Авелий
+%
+Нет такой глупости, которой нельзя было бы исправить при помощи ума,
+и нет такой мудрости, которой нельзя было бы испортить при помощи глупости.
+		-- В. Гёте
+%
+Оптимист верит, что мы живем в лучшем из миров.
+Пессимист боится, что так оно и есть.
+%
+Пессимист видит темный туннель.
+Оптимист видит свет в конце туннеля.
+Реалист видит, что это на них мчится поезд.
+И только машинист видит трех мудаков, тупящих на рельсах.
+%
+Мы познаем человека не по тому, что он знает, а по тому, чему он радуется.
+		-- Р.Тагор
+%
+Если вы уверены в победе вашей национальной сборной на Евро 2004, то вы либо
+дурак, либо немец.
+		-- М.Задорнов
+%
+Нет некрасивых женщин - есть только женщины, не знающие, что они красивы.
+		-- Вивьен Ли
+%
+Любая сложная технология неотличима от волшебства.
+		-- Артур Кларк
+%
+Я люблю тебя не за то, кто ты, а за то, кто я, когда я с тобой.
+		-- Габриэль Гарсиа
+%
+Ни один человек не заслуживает твоих слез, а те, кто заслуживают,
+не заставят тебя плакать.
+		-- Габриэль Гарсиа
+%
+Только потому что кто-то не любит тебя так, как тебе хочется, не значит,
+что он не любит тебя всей душой.
+		-- Габриэль Гарсиа
+%
+Настоящий друг – это тот, кто будет держать тебя за руку
+и чувствовать твоё сердце.
+		-- Габриэль Гарсиа
+%
+Худший способ скучать по человеку – это быть с ним и понимать,
+что он никогда не будет твоим.
+		-- Габриэль Гарсиа
+%
+Никогда не переставай улыбаться, даже когда тебе грустно: кто-то может влюбиться
+в твою улыбку.
+		-- Габриэль Гарсиа
+%
+Возможно, в этом мире ты всего лишь человек, но для кого-то ты – весь мир.
+		-- Габриэль Гарсиа
+%
+Не трать время на человека, который не стремится провести его с тобой.
+		-- Габриэль Гарсиа
+%
+Возможно, Бог хочет, чтобы мы встречали не тех людей до того, как встретим того
+единственного человека. Чтобы, когда это случится, мы были благодарны.
+		-- Габриэль Гарсиа
+%
+Не плачь, потому что это закончилось. Улыбнись, потому что это было.
+		-- Габриэль Гарсиа
+%
+Всегда найдутся люди, которые причинят тебе боль. Нужно продолжать верить людям,
+просто быть чуть осторожнее.
+		-- Габриэль Гарсиа
+%
+Стань лучше и сам пойми, кто ты, прежде чем встретишь нового человека и будешь
+надеяться, что он тебя поймет.
+		-- Габриэль Гарсиа
+%
+Не прилагай столько усилий, все самое лучшее случается неожиданно.
+		-- Габриэль Гарсиа
+%
+Всё, что случаеется, имеет причину.
+		-- Габриэль Гарсиа

data/friday.txt

@@ -0,0 +1,106 @@
+А пятница-то не настоящая!!! || 34
+Спасибо, кэп! || 5
+А за пивом сегодня идет user || 5
+user, ты пиво купил? || 5
+Пятница хоть и небольшой праздник, НО ЗАТО ПОСТОЯННЫЙ! || 45
+Мечта о пятнице — самая распространенная среди работающего населения. Она начинается уже в понедельник и продолжается четыре дня в неделю || 123
+Господи дай мне сил не напиться! А если напьюсь, то сделай так чтобы я не плясала, если сил твоих не хватит и я все-таки запляшу, постарайся хотя бы сделать так, что бы не пела! А если и это не удастся, сломай к чертям сервер Ю-тюба! || 5
+К пятнице готова! Мобильный заряжен, баланс пополнен, в кармане записка с моим адресом || 5
+ПРЕДУПРЕЖДЕНИЕ: Чрезмерное употребление… Алкоголя. делает ВАШУ пятницу… ОФИГИТЕЛЬНОЙ || 5
+Сломай систему! Порви шаблоны! Начни новую жизнь с пятницы! || 5
+В пятницу совесть доживает только до обеда… || 5
+Сколько работнику не плати, всё равно пятницы ждёт || 1234
+Робинзооон!!! || 5
+В пятницу чаще всего хочется выпить. В понедельник чаще всего хочется пятницу. || 15
+Здравствуй Пятница, здравствуй, любимая, наконец-то ты пришла! || 5
+Зарплата в пятницу — удар по печени. || 5
+Вот и пятница пришла, счастье, радость принесла! || 5
+Все мы — пятницофилы и понедельникофобы. || 15
+Люблю понедельник — всего три дня до пятницы. || 1
+Ну здравствуй, пятница. Я дополз к тебе. || 5
+Пятница. Улыбните Улыбальник. || 5
+Чувствуете? Выходными пахнет! || 5
+До пятницы осталось…. пережить четверг! || 4
+Если пятый день подряд опаздываешь на работу, значит сегодня пятница. || 5
+От понедельника до пятницы очень далеко, а от пятницы до понедельника рукой подать. || 123467
+Жизнь начинается в пятницу вечером… В остальное время — выживание. || 5
+Пятница… белочки следят за тобой. || 5
+Примета: Если утром жена с вами не разговаривает, значит, вчера была пятница. || 6
+Чем ближе пятница, тем добрее утро! || 1234
+Пятница — лучший день недели, особенно её вечер, так как выходные еще не начались, а работа уже закончилась. || 5
+Отличной была пятница! Особенно запомнились русские народные катания на полицейских бобиках! || 1
+Четверг это маленькая пятница, а пятницу можно считать выходным. || 4
+Пятница традиционно начиналась легким ужином в четверг и заканчивалась плотным завтраком в понедельник. || 4
+Уже с пятницы начинаешь бояться, что скоро понедельник! || 67
+Каждую пятницу жизнь начинается сначала. || 5
+С пятницами надо быть осторожней. Они обещают слишком уж многое. Они словно рецензия на кинофильм: лишь в редких случаях предсказанное ими сбывается. || 5
+Русские в понедельник не работают — у них тяжелый день. || 1
+Все мы просто дети, изображающие на работе профессионалов, а на самом деле ждущие пятницы, чтобы быть сами собой! || 5
+Почему-то в пятницу хочется ничего не делать. Хотя в другие дни тоже хочется, но в пятницу ничего не делать хочется особенно сильно. || 5
+Хочешь жить завтрашним днем — устрой себе семь пятниц на неделе. || 5
+Что мне снег, что мне зной, что мне вермут разливной, когда мои друзья со мной! || 5
+Каждую пятницу количество довольных жизнью людей увеличивается на пару миллиардов. Этот эффект длится вплоть до понедельника. || 123467
+Так, Понедельник, Вторник, Среда, Четверг, проходим, проходим, не задерживаем Пятницу! || 1234
+Четверг. Смотрю на часы — 16.00. Еле сдерживаюсь, чтобы не закричать — Ура! Во Владивостоке Пятница! || 4
+Пятница — друг человека! || 5
+В пятницу вечером понимаешь, что в принципе — жить можно. || 5
+Ничто так не портит пятницу, как новость о том, что сегодня четверг. || 4
+Жить нужно так, как будто каждый день пятница. || 123467
+Только настроился на работу ― и вдруг снова пятница, снова отдых… Вот так всегда! || 5
+Хорошо, что пятница! Плохо, что еще только утро… || 5
+Уходя вечером с работы, он был рад, что сегодня пятница и можно спрятаться в уикенде. Он накроется субботой и воскресеньем как двумя толстыми одеялами. Ему ничего не хотелось делать; у него даже не хватало мужества читать. || 5
+Понедельник ― отходим от выходных, вторник ― готовимся к работе, среда ― работаем, четверг ― отдыхаем от работы, пятница ― готовимся к выходным. Вывод: может, хватит уже работать по средам! || 3
+Неделя тянется со скоростью улитки. Но в пятницу вечером улитка превращается в Феррари. || 5
+Прогноз погоды на пятницу: облачно, вечером осадки в виде алкоголя, возможен секс. || 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

@@ -1,19 +1,65 @@
 {
-    "user" : "nobody",
-    "debug_log" : "/var/log/aleesa-telegram-bot/debug.log",
-    "telegrambot" : {
-        "name" : "mybot",
-        "tname" : "@my_bot",
-        "csign" : "!",
-        "token" : "get_it_from_botfather",
-        "braindir": "data/telegrambot-brains"
+    "admin" : {
+# store per-channel (per-conversation) settings
+        "dir" : "data/admin"
     },
-    "openweathermap" : {
-        "cachetime": "data/cache/openweathermap.Id-Timestamp.db",
-        "cachedata": "data/cache/openweathermap.Id-Data.db",
-        "appid": "get_it_on_openweathermap.org"
+
+    "fortune" : {
+        "dir" : "data/fortune",
+        "srcdir" : "data/fortune_src"
     },
+
+    "friday" : {
+        "dir" : "data/friday",
+        "src" : "data/friday.txt"
+    },
+
+    "image": {
+        "dir" : "data/image",
+        "imgur" : {
+# see README.md about these settings - auth'ed search settings
+            "client-id" : "imgur api client id",
+            "secret" : "secret for client id",
+            "access_token" : "access token for querying imgur api",
+            "refresh_token" : "token for refreshing access token"
+        },
+        "flickr" : {
+# see README.md about these settings - auth'ed search settings
+            "consumer_key" : "md5-like_hash",
+            "consumer_secret" : "some_hash-like_string",
+            "verifier": "some_hash-like_string"
+        }
+    },
+
+    "karma": {
+        "dir": "data/karma"
+    },
+
     "lat" : {
-        "brain": "data/lat/lat.sqlite"
-    }
+        "brain": "data/lat/brain.sqlite",
+        "src": "data/lat.txt"
+    },
+
+# required for debugging reasons, if commented out or not exist, no debug logging appears at all
+    "log" : "/var/log/aleesa-telegram-bot/debug.log",
+
+# openwatermap plugin
+    "openweathermap" : {
+        "appid" : "md5sum-like_string",
+# result cache, stores data for 4 hours
+        "cachedir" : "data/cache",
+    },
+
+# stuff for telegram itself
+    "telegrambot" : {
+# directory with per-conversation "brains"
+        "braindir" : "data/telegrambot-brains",
+# prefix-sign for all commands. in many irc-bots (eggdrop/windrop) it is "." (dot), in sulci it was "!"
+# in telegram commands begin with "/" on the start of first (and only) line.
+        "csign" : "!",
+        "token" : "Long_string_given_by_@BotFather"
+    },
+
+# unprivileged user to run this bot from
+    "user" : "unit",
 }

lib/Teapot/Bot/Brain.pm

@@ -6,6 +6,7 @@ use Mojo::Base -base;
 
 use strict;
 use warnings;
+use English qw ( -no_match_vars );
 
 use Mojo::IOLoop;
 use Mojo::UserAgent;
@@ -76,7 +77,7 @@ sub think {
   $self->init();
 
   $self->_add_getUpdates_handler;
-  Mojo::IOLoop->start unless Mojo::IOLoop->is_running;
+  do { Mojo::IOLoop->start } until Mojo::IOLoop->is_running;
   return;
 }
 
@@ -131,6 +132,61 @@ sub getChatMember {
   }
 }
 
+sub kickChatMember {
+  my $self = shift;
+  my $args = shift || {};
+
+  my $token = $self->token || croak 'No token supplied to kickChatMember?';
+  my $send_args = {};
+
+  unless ($args->{chat_id}) {
+    cluck 'No chat_id supplied to kickChatMember()';
+    return {'error' => 1};
+  }
+
+  unless ($args->{user_id}) {
+    cluck 'No user_id supplied to kickChatMember()';
+    return {'error' => 1};
+  }
+
+  $send_args->{chat_id} = $args->{chat_id};
+  $send_args->{user_id} = $args->{user_id};
+  $send_args->{until_date} = $args->{until_date} if exists $args->{until_date};
+  $send_args->{revoke_messages} = $args->{revoke_messages} if exists $args->{revoke_messages};
+
+  my $url = "https://api.telegram.org/bot${token}/kickChatMember";
+  my $api_response = $self->_post_request($url, $send_args);
+
+  return;
+}
+
+sub unbanChatMember {
+  my $self = shift;
+  my $args = shift || {};
+
+  my $token = $self->token || croak 'No token supplied to unbanChatMember?';
+  my $send_args = {};
+
+  unless ($args->{chat_id}) {
+    cluck 'No chat_id supplied to unbanChatMember()';
+    return {'error' => 1};
+  }
+
+  unless ($args->{user_id}) {
+    cluck 'No user_id supplied to unbanChatMember()';
+    return {'error' => 1};
+  }
+
+  $send_args->{chat_id} = $args->{chat_id};
+  $send_args->{user_id} = $args->{user_id};
+  $send_args->{only_if_banned} = $args->{only_if_banned} if exists $args->{only_if_banned};
+
+  my $url = "https://api.telegram.org/bot${token}/unbanChatMember";
+  my $api_response = $self->_post_request($url, $send_args);
+
+  return;
+}
+
 
 sub getChat {
   my $self = shift;
@@ -159,6 +215,28 @@ sub getChat {
 }
 
 
+sub leaveChat {
+  my $self = shift;
+  my $args = shift || {};
+
+  my $send_args = {};
+
+  unless ($args->{chat_id}) {
+    cluck 'No chat_id supplied to getChat()';
+    return {'error' => 1};
+  }
+
+  $send_args->{chat_id} = $args->{chat_id};
+
+  my $token = $self->token || croak 'No token supplied to getChat()?';
+
+  my $url = "https://api.telegram.org/bot${token}/leaveChat";
+  my $api_response = $self->_post_request($url, $send_args);
+
+  return;
+}
+
+
 sub sendMessage {
   my $self = shift;
   my $args = shift || {};
@@ -254,6 +332,39 @@ sub forwardMessage {
   }
 }
 
+# TODO: Check that message is no older than 48 hrs
+sub deleteMessage {
+  my $self = shift;
+  my $args = shift || {};
+  my $send_args = {};
+
+  unless ($args->{chat_id}) {
+    cluck 'No chat_id supplied in deleteMessage()';
+    return {'error' => 1};
+  }
+
+  $send_args->{chat_id} = $args->{chat_id};
+
+  unless ($args->{message_id}) {
+    cluck 'No message_id supplied in deleteMessage()';
+    return {'error' => 1};
+  }
+
+  $send_args->{message_id} = $args->{message_id};
+
+  my $token = $self->token || croak 'No token supplied to deleteMessage()?';
+
+  if (Teapot::Bot::Object::ChatMember::canDeleteMessage($self, $args->{chat_id})) {
+    my $url = "https://api.telegram.org/bot${token}/deleteMessage";
+    $self->_post_request($url, $send_args);
+  }
+  else {
+    return {'error' => 1};
+  }
+
+  return;
+}
+
 
 sub sendPhoto {
   my $self = shift;
@@ -351,6 +462,121 @@ sub sendChatAction {
   return;
 }
 
+sub exportChatInviteLink {
+  my $self = shift;
+  my $args = shift || {};
+  my $send_args = {};
+
+  my $token = $self->token || croak 'No token supplied to createChatInviteLink()?';
+
+  unless ($args->{chat_id}) {
+    cluck 'No chat_id supplied in createChatInviteLink()';
+    return {'error' => 1};
+  }
+
+  $send_args->{chat_id} = $args->{chat_id};
+
+  my $url = "https://api.telegram.org/bot${token}/exportChatInviteLink";
+  my $api_response = $self->_post_request($url);
+
+  if ($api_response) {
+    return $api_response;
+  }
+  else {
+    return {'error' => 1};
+  }
+}
+
+sub createChatInviteLink {
+  my $self = shift;
+  my $args = shift || {};
+  my $send_args = {};
+
+  my $token = $self->token || croak 'No token supplied to createChatInviteLink()?';
+
+  unless ($args->{chat_id}) {
+    cluck 'No chat_id supplied in createChatInviteLink()';
+    return {'error' => 1};
+  }
+
+  $send_args->{chat_id} = $args->{chat_id};
+  $send_args->{expire_date} = $args->{expire_date} if exists $args->{expire_date};
+  $send_args->{member_limit} = $args->{member_limit} if exists $args->{member_limit};
+
+  my $url = "https://api.telegram.org/bot${token}/createChatInviteLink";
+  my $api_response = $self->_post_request($url);
+
+  if ($api_response) {
+    return Teapot::Bot::Object::ChatInviteLink->create_from_hash($api_response, $self);
+  }
+  else {
+    return {'error' => 1};
+  }
+}
+
+sub editChatInviteLink {
+  my $self = shift;
+  my $args = shift || {};
+  my $send_args = {};
+
+  my $token = $self->token || croak 'No token supplied to editChatInviteLink()?';
+
+  unless ($args->{chat_id}) {
+    cluck 'No chat_id supplied in editChatInviteLink()';
+    return {'error' => 1};
+  }
+
+  unless ($args->{invite_link}) {
+    cluck 'No invite_link supplied in editChatInviteLink()';
+    return {'error' => 1};
+  }
+
+  $send_args->{chat_id} = $args->{chat_id};
+  $send_args->{invite_link} = $args->{invite_link};
+  $send_args->{expire_date} = $args->{expire_date} if exists $args->{expire_date};
+  $send_args->{member_limit} = $args->{member_limit} if exists $args->{member_limit};
+
+  my $url = "https://api.telegram.org/bot${token}/editChatInviteLink";
+  my $api_response = $self->_post_request($url);
+
+  if ($api_response) {
+    return Teapot::Bot::Object::ChatInviteLink->create_from_hash($api_response, $self);
+  }
+  else {
+    return {'error' => 1};
+  }
+}
+
+sub revokeChatInviteLink {
+  my $self = shift;
+  my $args = shift || {};
+  my $send_args = {};
+
+  my $token = $self->token || croak 'No token supplied to revokeChatInviteLink()?';
+
+  unless ($args->{chat_id}) {
+    cluck 'No chat_id supplied in revokeChatInviteLink()';
+    return {'error' => 1};
+  }
+
+  unless ($args->{invite_link}) {
+    cluck 'No invite_link supplied in revokeChatInviteLink()';
+    return {'error' => 1};
+  }
+
+  $send_args->{chat_id} = $args->{chat_id};
+  $send_args->{invite_link} = $args->{invite_link};
+
+  my $url = "https://api.telegram.org/bot${token}/revokeChatInviteLink";
+  my $api_response = $self->_post_request($url);
+
+  if ($api_response) {
+    return Teapot::Bot::Object::ChatInviteLink->create_from_hash($api_response, $self);
+  }
+  else {
+    return {'error' => 1};
+  }
+}
 
 sub _add_getUpdates_handler {
   my $self = shift;
@@ -369,11 +595,18 @@ sub _add_getUpdates_handler {
 
     $self->ua->get($updateURL => sub {
       my ($ua, $tx) = @_;
-      my $res = $tx->res->json;
-      my $items = $res->{result};
-      foreach my $item (@{$items}) {
-        $last_update_id = $item->{update_id};
-        $self->_process_message($item);
+      my $res = eval { $tx->res->json; };
+
+      # it looks like we can catch an error here if timeout or something bad occurs,
+      # try not to die in this case or we risk to stuck with $http_active=1 forever
+      if ((defined $res) && $res ne '') {
+        my $items = $res->{result};
+        foreach my $item (@{$items}) {
+          $last_update_id = $item->{update_id};
+          $self->_process_message($item);
+        }
+      } else {
+        cluck "Unable to get update from API: $EVAL_ERROR";
       }
 
       $http_active = 0;
@@ -392,11 +625,24 @@ sub _process_message {
     # There can be several types of responses. But only one response.
     # https://core.telegram.org/bots/api#update
     my $update;
-    $update = Teapot::Bot::Object::Message->create_from_hash($item->{message}, $self)             if $item->{message};
-    $update = Teapot::Bot::Object::Message->create_from_hash($item->{edited_message}, $self)      if $item->{edited_message};
-    $update = Teapot::Bot::Object::Message->create_from_hash($item->{channel_post}, $self)        if $item->{channel_post};
-    $update = Teapot::Bot::Object::Message->create_from_hash($item->{edited_channel_post}, $self) if $item->{edited_channel_post};
-    $update = Teapot::Bot::Object::Message->create_from_hash($item->{poll}, $self)                if $item->{poll};
+    $update = Teapot::Bot::Object::Message->create_from_hash($item->{message}, $self)                         if $item->{message};
+    $update = Teapot::Bot::Object::Message->create_from_hash($item->{edited_message}, $self)                  if $item->{edited_message};
+    $update = Teapot::Bot::Object::Message->create_from_hash($item->{channel_post}, $self)                    if $item->{channel_post};
+    $update = Teapot::Bot::Object::Message->create_from_hash($item->{edited_channel_post}, $self)             if $item->{edited_channel_post};
+    # Not yet implemented, we have no InlineQuery object yet
+    #$update = Teapot::Bot::Object::InlineQuery->create_from_hash($tem->{inline_query}, $self)                if $item->{inline_query};
+    # Not yet implemented, we have no ChosenInlineResult object yet
+    #$update = Teapot::Bot::Object::ChosenInlineResult->create_from_hash($tem->{chosen_inline_result}, $self) if $item->{chosen_inline_result};
+    # Not yet implemented, we have no callback_query object yet, because we do not use this mechanism, s API should not gi us that shit
+    #$update = Teapot::Bot::Object::CallbackQuery->create_from_hash($tem->{callback_query}, $self)            if $item->{callback_query};
+    # Not yet implemented, we have no ShippingQuery object yet
+    #$update = Teapot::Bot::Object::ShippingQuery->create_from_hash($tem->{shipping_query}, $self)            if $item->{shipping_query};
+    # Not yet implemented, we have no PreCheckoutQuery object yet
+    #$update = Teapot::Bot::Object::PreCheckoutQuery->create_from_hash($tem->{pre_checkout_query}, $self)     if $item->{pre_checkout_query};
+    $update = Teapot::Bot::Object::Poll->create_from_hash($item->{poll}, $self)                               if $item->{poll};
+    $update = Teapot::Bot::Object::PollAnswer->create_from_hash($item->{poll_answer}, $self)                  if $item->{poll_answer};
+    $update = Teapot::Bot::Object::ChatMemberUpdated->create_from_hash($item->{my_chat_member}, $self)        if $item->{my_chat_member};
+    $update = Teapot::Bot::Object::ChatMemberUpdated->create_from_hash($item->{chat_member}, $self)           if $item->{chat_member};
 
     # if we got to this point without creating a response, it must be a type we
     # don't handle yet
@@ -407,7 +653,15 @@ sub _process_message {
 
     foreach my $listener (@{ $self->listeners }) {
       # call the listener code, supplying ourself and the update
-      $listener->($self, $update);
+      my $evalRet = eval {
+        $listener->($self, $update);
+        return 1;
+      };
+
+      unless ($evalRet) {
+        cluck "An error occured during update processing: $EVAL_ERROR";
+        return;
+      }
     }
 
     return;
@@ -544,6 +798,25 @@ of Chat User.
 
 On error returns hash reference with error set to 1
 
+=head2 kickChatMember
+
+This is the wrapper around the C<kickChatMember> API method. See
+L<https://core.telegram.org/bots/api#kickchatmember>.
+
+Takes chat_id, and user_id as arguments. And optionally until_date and
+revoke_messages.
+
+Returns nothing, it's send-only method (Telegram API returns true on success)
+
+=head2 unbanChatMember
+
+This is the wrapper around the C<unbanChatMember> API method. See
+L<https://core.telegram.org/bots/api#unbanchatmember>.
+
+Takes chat_id, and user_id as arguments. And optionally only_if_banned.
+
+Returns nothing, it's send-only method (Telegram API returns true on success)
+
 =head2 getChat
 
 This is the wrapper around the C<getChat> API method. See
@@ -555,6 +828,15 @@ Returns the L<Teapot::Bot::Object::Chat> that represents properties of Chat.
 
 On error returns hash reference with error set to 1
 
+=head2 leaveChat
+
+This is the wrapper around the C<leaveChat> API method. See
+L<https://core.telegram.org/bots/api#leavechat>.
+
+Takes chat_id as argument.
+
+Returns nothing, it's send-only method (Telegram API returns true on success)
+
 =head2 sendMessage
 
 See L<https://core.telegram.org/bots/api#sendmessage>.
@@ -571,6 +853,14 @@ Returns a L<Teapot::Bot::Object::Message> object.
 
 On error returns hash reference with error set to 1
 
+=head2 deleteMessage
+
+See L<https://core.telegram.org/bots/api#deletemessage>.
+
+Returns a L<Teapot::Bot::Object::Message> object.
+
+On error returns hash reference with error set to 1
+
 =head2 sendPhoto
 
 See L<https://core.telegram.org/bots/api#sendphoto>.
@@ -584,6 +874,47 @@ See L<https://core.telegram.org/bots/api#sendchataction>.
 
 Returns nothing, it's send-only method (Telegram API returns true on success)
 
+=head2 exportChatInviteLink
+
+See L<https://core.telegram.org/bots/api#exportchatinvitelink>
+
+Takes chat_id as argument.
+
+Returns a raw api answer.
+
+On error returns hash reference with error set to 1
+
+=head2 createChatInviteLink
+
+See L<https://core.telegram.org/bots/api#createchatinvitelink>
+
+Takes chat_id as argument. And optionally expire_date and member_limit.
+
+Returns a L<Teapot::Bot::Object::ChatInviteLink> object.
+
+On error returns hash reference with error set to 1
+
+=head2 editChatInviteLink
+
+See L<https://core.telegram.org/bots/api#editchatinvitelink>
+
+Takes chat_id and invite_link as arguments. And optionally expire_date
+and member_limit.
+
+Returns a L<Teapot::Bot::Object::ChatInviteLink> object.
+
+On error returns hash reference with error set to 1
+
+=head2 revokeChatInviteLink
+
+See L<https://core.telegram.org/bots/api#revokechatinvitelink>
+
+Takes chat_id and invite_link as arguments.
+
+Returns a L<Teapot::Bot::Object::ChatInviteLink> object.
+
+On error returns hash reference with error set to 1
+
 =head1 SEE ALSO
 
 =over 4

lib/Teapot/Bot/Object/Audio.pm

@@ -6,15 +6,18 @@ use Mojo::Base 'Teapot::Bot::Object::Base';
 $Teapot::Bot::Object::Audio::VERSION = '0.022';
 
 has 'file_id';
+has 'file_unique_id';
 has 'duration';
-has 'performer';
-has 'title';
-has 'mime_type';
-has 'file_size';
-has 'thumb'; #PhotoSize
+has 'performer'; # Optional. Performer of the audio as defined by sender or by audio tags
+has 'title';     # Optional. Title of the audio as defined by sender or by audio tags
+has 'file_name'; # Optional. Original filename as defined by sender
+has 'mime_type'; # Optional. MIME type of the file as defined by sender
+has 'file_size'; # Optional. File size
+has 'thumb';     # Optional. Thumbnail of the album cover to which the music file belongs
 
 sub fields {
-  return { scalar                           => [qw/file_id duration performer title mime_type file_size/],
+  return { scalar                           => [qw/file_id file_unique_id duration performer title file_name mime_type
+                                                   file_size/],
            'Teapot::Bot::Object::PhotoSize' => [qw/thumb/],
          };
 }

lib/Teapot/Bot/Object/Base.pm

@@ -3,7 +3,8 @@ package Teapot::Bot::Object::Base;
 
 use Mojo::Base -base;
 use List::Util qw/any/;
-use Carp qw/croak/;
+use Carp qw/croak cluck/;
+use Data::Dumper;
 
 $Teapot::Bot::Object::Base::VERSION = '0.022';
 
@@ -14,6 +15,11 @@ sub arrays { return qw// }  # override if needed
 sub _field_is_array {
   my $self = shift;
   my $field = shift;
+
+  unless (defined $field) {
+    return;
+  }
+
   if (any { /^$field$/ } $self->arrays) {
     return 1;
   }
@@ -25,12 +31,140 @@ sub array_of_arrays {  return qw// } #override if needed
 sub _field_is_array_of_arrays {
   my $self = shift;
   my $field = shift;
+
+  unless (defined $field) {
+    return;
+  }
+
   if (any { /^$field$/ } $self->array_of_arrays) {
     return 1;
   }
   return;
 }
 
+sub create_from_array {
+  my $class = shift;
+  my $array = shift;
+  my $brain = shift || croak 'No brain supplied to create_from_array()';
+  my $obj   = shift || $class->new(_brain => $brain);
+
+  unless (defined $array) {
+    cluck 'Array is undef';
+    return $obj;
+  }
+
+  unless (ref ($array) eq 'ARRAY') {
+    cluck 'Not array ' . Dumper ($hash);
+    return $obj;
+  }
+
+  cluck "Dumping class: " . Dumper ($class);
+  cluck "Dumping array: " . Dumper ($array);
+ Dumping array: $VAR1 = [
+          [
+            {
+              'text' => 'Spotify',
+              'url' => 'https://open.spotify.com/track/44MxUoeZg6FXDlHMrSbVjX'
+            },
+            {
+              'text' => 'Tidal',
+              'url' => 'https://listen.tidal.com/track/159119367'
+            },
+            {
+              'url' => 'https://music.apple.com/us/album/_/1534782030?i=1534782031',
+              'text' => 'Apple'
+            }
+          ],
+          [
+            {
+              'text' => 'Deezer',
+              'url' => 'https://www.deezer.com/track/1112603372'
+            },
+            {
+              'text' => 'YouTube',
+              'url' => 'https://music.youtube.com/watch?v=KT1jJDh7ir0'
+            },
+            {
+              'url' => 'https://song.link/s/44MxUoeZg6FXDlHMrSbVjX',
+              'text' => 'eXtra'
+            }
+          ]
+        ];
+
+ Dumping array: $VAR1 = [
+          [
+            {
+              'callback_data' => 'l85882326|open.spotify.com/track/44MxUoeZg6FXDlHMrSbVjX',
+              'text' => 'Get links'
+            }
+          ]
+        ];
+
+# https://core.telegram.org/bots/api#inlinekeyboardmarkup
+# который содержит в себе тупо массив
+# Array of Array of Teapot::Bot::Object::InlineKeyboardButton
+
+# https://core.telegram.org/bots/api#userprofilephotos
+# аналогично предыдущему содержит
+# Array of Array of Teapot::Bot::Object::PhotoSize
+
+  # deal with each type of field
+  foreach my $type (keys %{ $class->fields }) {
+    my @fields_of_this_type = @{ $class->fields->{$type} };
+
+    foreach my $field (@fields_of_this_type) {
+      # ignore undefined fields (sic!)
+      next if (! defined $field);
+
+      # ignore fields for which we have no value in the hash
+      next if (! defined $hash->{$field} );
+
+      # warn "type: $type field $field\n";
+      if ($type eq 'scalar') {
+        if ($obj->_field_is_array($field)) {
+          # simple scalar array ref, so just copy it
+          my $val = $hash->{$field};
+          # deal with boolean stuff so we don't pollute our object
+          # with JSON
+          if (ref($val) eq 'JSON::PP::Boolean') {
+            $val = !!$val;
+          }
+          $obj->$field($val);
+        }
+        elsif ($obj->_field_is_array_of_arrays) {
+          croak 'Not yet implemented for scalars';
+        }
+        else {
+          my $val = $hash->{$field};
+          if (ref($val) eq 'JSON::PP::Boolean') {
+            $val = 0+$val;
+
+          }
+          $obj->$field($val);
+        }
+      }
+
+      else {
+        if ($obj->_field_is_array($field)) {
+          my @sub_array;
+          foreach my $data ( @{ $hash->{$field} } ) {
+            push @sub_array, $type->create_from_hash($data, $brain);
+          }
+          $obj->$field(\@sub_array);
+        }
+        elsif ($obj->_field_is_array_of_arrays) {
+          croak 'Not yet implemented for scalars';
+        }
+        else {
+          $obj->$field($type->create_from_hash($hash->{$field}, $brain));
+        }
+
+      }
+    }
+  }
+
+  return $obj;
+}
 
 # create an object from a hash. Needs to deal with the nested types, and
 # arrays
@@ -40,11 +174,27 @@ sub create_from_hash {
   my $brain = shift || croak 'No brain supplied to create_from_hash()';
   my $obj   = $class->new(_brain => $brain);
 
+  unless (defined $hash) {
+    cluck 'Hash is undef';
+    return $obj;
+  }
+
+  unless (ref ($hash) eq 'HASH') {
+    if (ref ($array) eq 'ARRAY') {
+      return create_from_array($class, $hash, $brain);
+    }
+
+    cluck 'Not a hash ' . Dumper ($hash);
+    return $obj;
+  }
+
   # deal with each type of field
   foreach my $type (keys %{ $class->fields }) {
     my @fields_of_this_type = @{ $class->fields->{$type} };
 
     foreach my $field (@fields_of_this_type) {
+      # ignore undefined fields (sic!)
+      next if (! defined $field);
 
       # ignore fields for which we have no value in the hash
       next if (! defined $hash->{$field} );

lib/Teapot/Bot/Object/Chat.pm

@@ -5,6 +5,7 @@ use Mojo::Base 'Teapot::Bot::Object::Base';
 use Teapot::Bot::Object::ChatPhoto;
 use Teapot::Bot::Object::Message;
 use Teapot::Bot::Object::ChatPermissions;
+use Teapot::Bot::Object::ChatLocation;
 
 $Teapot::Bot::Object::Chat::VERSION = '0.022';
 
@@ -23,15 +24,18 @@ has 'permissions';         # Teapot::Bot::Object::ChatPermissions. Optional. Def
 has 'slow_mode_delay';     # Optional. Returned only in getChat.
 has 'sticker_set_name';    # Optional. Returned only in getChat.
 has 'can_set_sticker_set'; # Optional. Returned only in getChat.
+has 'linked_chat_id';      # Optional. greater than 32 bits, smaller than 52 bits
+has 'location';            # Optional. Returned only in getChat.
 
 sub fields {
   return {
           'scalar'                               => [qw/id type title username first_name last_name description 
                                                         invite_link slow_mode_delay sticker_set_name 
-                                                        can_set_sticker_set /],
+                                                        can_set_sticker_set linked_chat_id/],
           'Teapot::Bot::Object::ChatPhoto'       => [qw/photo/],
           'Teapot::Bot::Object::Message'         => [qw/pinned_message/],
           'Teapot::Bot::Object::ChatPermissions' => [qw/permissions/],
+          'Teapot::Bot::Object::ChatLocation'    => [qw/location/],
         };
 }
 

lib/Teapot/Bot/Object/ChatInviteLink.pm

@@ -0,0 +1,57 @@
+package Teapot::Bot::Object::ChatInviteLink;
+# ABSTRACT: The base class for Telegram message 'ChatInviteLink' type.
+
+use Mojo::Base 'Teapot::Bot::Object::Base';
+use Teapot::Bot::Object::User;
+
+$Teapot::Bot::Object::ChatInviteLink::VERSION = '0.022';
+
+has 'invite_link';
+has 'creator';
+has 'is_primary';
+has 'is_revoked';
+has 'expire_date';  # Optional. Point in time (Unix timestamp) when the link will expire or has been expired
+has 'member_limit'; # Optional. Maximum number of users that can be members of the chat simultaneously after joining
+                    # the chat via this invite link; 1-99999
+
+sub fields {
+  return {
+    'scalar'                    => [qw/invite_link is_primary is_revoked expire_date expire_date member_limit/],
+    'Teapot::Bot::Object::User' => [qw/creator/],
+  };
+}
+
+1;
+
+__END__
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+Teapot::Bot::Object::ChatInviteLink - The base class for Telegram message 'ChatInviteLink' type
+
+=head1 VERSION
+
+version 0.022
+
+=head1 DESCRIPTION
+The base class for Telegram message 'ChatInviteLink' type.
+
+See L<https://core.telegram.org/bots/api#chatinvitelink> for details of the
+attributes available for L<Teapot::Bot::Object::ChatInviteLink> objects.
+
+=head1 AUTHOR
+
+Sergei Fedosov <eleksir@gmail.com>
+
+=head1 LICENSE AND COPYRIGHT
+
+This software is copyright (c) 2021 by Sergei Fedosov <eleksir@gmail.com>.
+
+This is free software; you can redistribute it and/or modify it under
+the same terms as the Perl 5 programming language system itself.
+
+=cut

lib/Teapot/Bot/Object/ChatLocation.pm

@@ -0,0 +1,51 @@
+package Teapot::Bot::Object::ChatLocation;
+# ABSTRACT: The base class for Telegram message 'ChatLocation' type.
+
+use Mojo::Base 'Teapot::Bot::Object::Base';
+
+$Teapot::Bot::Object::ChatLocation::VERSION = '0.022';
+
+has 'location';
+has 'address';
+
+sub fields {
+  return {
+    'Teapot::Bot::Object::Location' => [qw/location/],
+    'scalar'                        => [qw/address/],
+  };
+}
+
+1;
+
+__END__
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+Teapot::Bot::Object::ChatLocation - The base class for Telegram message 'ChatLocation' type
+
+=head1 VERSION
+
+version 0.022
+
+=head1 DESCRIPTION
+The base class for Telegram message 'ChatLocation' type.
+
+See L<https://core.telegram.org/bots/api#chatlocation> for details of the
+attributes available for L<Teapot::Bot::Object::ChatLocation> objects.
+
+=head1 AUTHOR
+
+Sergei Fedosov <eleksir@gmail.com>
+
+=head1 LICENSE AND COPYRIGHT
+
+This software is copyright (c) 2019 by Sergei Fedosov <eleksir@gmail.com>.
+
+This is free software; you can redistribute it and/or modify it under
+the same terms as the Perl 5 programming language system itself.
+
+=cut

lib/Teapot/Bot/Object/ChatMember.pm

@@ -3,17 +3,24 @@ package Teapot::Bot::Object::ChatMember;
 
 use Mojo::Base 'Teapot::Bot::Object::Base';
 use Teapot::Bot::Object::User;
+use Carp qw(cluck);
 
 $Teapot::Bot::Object::ChatMember::VERSION = '0.022';
 
 has 'user';
 has 'status';
 has 'custom_title';              # optional. Owner and administrators only.
-has 'until';                     # optional. Restricted and kicked only.
+has 'is_anonymous';              # Optional. Owner and administrators only.
+
 has 'can_be_edited';             # optional. Administrators only.
+has 'can_manage_chat'            # Optional. Administrators only. True, if the administrator can access the chat event
+                                 # log, chat statistics, message statistics in channels, see channel members, see
+                                 # anonymous administrators in supergroups and ignore slow mode. Implied by any other
+                                 # administrator privilege
 has 'can_post_messages';         # optional. Administrators only.
 has 'can_edit_messages';         # optional. Administrators only.
 has 'can_delete_messages';       # optional. Administrators only.
+has 'can_manage_voice_chats'     # Optional. Administrators only. True, if the administrator can manage voice chats
 has 'can_restrict_members';      # optional. Administrators only.
 has 'can_promote_members';       # optional. Administrators only.
 has 'can_change_info';           # optional. Administrators and restricted only.
@@ -25,17 +32,72 @@ has 'can_send_media_messages';   # optional. Restricted only.
 has 'can_send_polls';            # optional. Restricted only.
 has 'can_send_other_messages';   # optional. Restricted only.
 has 'can_add_web_page_previews'; # optional. Restricted only.
+has 'until_date';                # optional. Restricted and kicked only.
 
 sub fields {
   return {
-          'scalar'                    => [qw/status custom_title until can_be_edited can_post_messages can_edit_messages
-                                             can_delete_messages can_restrict_members can_promote_members can_change_info
-                                             can_invite_users can_pin_messages is_member can_send_messages
-                                             can_send_media_messages can_send_polls can_send_other_messages can_add_web_page_previews/],
+          'scalar'                    => [qw/status custom_title is_anonymous can_be_edited can_manage_chat can_post_messages
+                                             can_edit_messages can_delete_messages can_manage_voice_chats can_restrict_members
+                                             can_promote_members can_change_info can_invite_users can_pin_messages is_member
+                                             can_send_messages can_send_media_messages can_send_polls can_send_other_messages
+                                             can_add_web_page_previews until_date/],
           'Teapot::Bot::Object::User' => [qw/user/],
         };
 }
 
+
+sub canDeleteMessage {
+  my $self = shift;
+  my $chatid = shift;
+
+  my $can_delete = 0;
+
+  if ($chatid < 0) {
+    # group chat
+    my $chatobj = $self->getChat ({ 'chat_id' => $chatid });
+
+    # on api error, keep silence
+    unless ($chatobj) {
+      cluck "Unable to get chat info for $chatid from telegram API";
+      return 0;
+    }
+
+    my $myObj = $self->getMe ();
+
+    # on api error, keep silence
+    unless ($chatobj) {
+      cluck "Unable to get chat info for $chatid from telegram API";
+      return 0;
+    }
+
+    my $myid = $myObj->id;
+    my $me = $self->getChatMember ({ 'chat_id' => $chatid, 'user_id' => $myid });
+
+    # on api error, keep silence
+    unless ($me) {
+      cluck 'Unable to get chat info for bot itself from telegram API';
+      return 0;
+    }
+
+    # bot can delete msg if it is group and it is admin there.
+    if ($chatobj->{'type'} eq 'group') {
+      if ($me->{'status'} eq 'administrator') {
+        $can_delete = 1;
+      }
+    # in supergroup bot must be granted with can_delete_messages
+    } elsif (($chatobj->{'type'} eq 'supergroup') || ($chatobj->{'type'} eq 'channel')) {
+      if ($me->{'can_delete_messages'}) {
+        $can_delete = 1;
+      }
+    }
+  } else {
+    # 1 on 1 chat with user
+    $can_delete = 1;
+  }
+
+  return $can_delete;
+}
+
 1;
 
 __END__
@@ -58,6 +120,14 @@ The base class for Telegram 'ChatMember' type objects.
 See L<https://core.telegram.org/bots/api#chatmember> for details of the
 attributes available for L<Teapot::Bot::Object::ChatMember> objects.
 
+=head1 METHODS
+
+=head2 canDeleteMessage
+
+A convenience method to check if bot can delete message in given conversation.
+
+Returns true if the bot can delete the message in given conversation, otherwise false.
+
 =head1 AUTHOR
 
 Sergei Fedosov <eleksir@gmail.com>

lib/Teapot/Bot/Object/ChatMemberUpdated.pm

@@ -0,0 +1,63 @@
+package Teapot::Bot::Object::ChatMemberUpdated;
+# ABSTRACT: The base class for Telegram 'ChatMemberUpdated' type objects
+
+use Mojo::Base 'Teapot::Bot::Object::Base';
+use Teapot::Bot::Object::Chat;
+use Teapot::Bot::Object::User;
+use Teapot::Bot::Object::ChatMember;
+use Teapot::Bot::Object::ChatInviteLink;
+
+$Teapot::Bot::Object::ChatMemberUpdated::VERSION = '0.022';
+
+has 'chat';
+has 'from';
+has 'date';
+has 'old_chat_member';
+has 'new_chat_member';
+has 'invite_link';     # Optional. Chat invite link, which was used by the user to join the chat; for joining by
+                       # invite link events only.
+
+sub fields {
+  return {
+          'Teapot::Bot::Object::Chat'           => [qw/chat/],
+          'Teapot::Bot::Object::User'           => [qw/from/],
+          'scalar'                              => [qw/date/],
+          'Teapot::Bot::Object::ChatMember'     => [qw/old_chat_member new_chat_member/],
+          'Teapot::Bot::Object::ChatInviteLink' => [qw/invite_link/]
+        };
+}
+
+1;
+
+__END__
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+Teapot::Bot::Object::ChatMemberUpdated - The base class for Telegram 'ChatMemberUpdated' type objects
+
+=head1 VERSION
+
+version 0.022
+
+=head1 DESCRIPTION
+The base class for Telegram 'ChatMemberUpdated' type objects.
+
+See L<https://core.telegram.org/bots/api#chatmemberupdated> for details of the
+attributes available for L<Teapot::Bot::Object::ChatMemberUpdated> objects.
+
+=head1 AUTHOR
+
+Sergei Fedosov <eleksir@gmail.com>
+
+=head1 LICENSE AND COPYRIGHT
+
+This software is copyright (c) 2021 by Sergei Fedosov <eleksir@gmail.com>
+
+This is free software; you can redistribute it and/or modify it under
+the same terms as the Perl 5 programming language system itself.
+
+=cut

lib/Teapot/Bot/Object/ChatPermissions.pm

@@ -1,6 +1,6 @@
 package Teapot::Bot::Object::ChatPermissions;
 # ABSTRACT: The base class for Telegram 'ChatPermissions' type objects
-
+use Carp qw(carp);
 use Mojo::Base 'Teapot::Bot::Object::Base';
 
 $Teapot::Bot::Object::ChatPermissions::VERSION = '0.022';
@@ -28,6 +28,53 @@ sub fields {
          };
 }
 
+sub canTalk {
+  my $self = shift;
+  my $chatid = shift;
+
+  my $can_talk = 0;
+
+  if ($chatid < 0) {
+    # group chat
+    my $chatobj = $self->_brain->getChat ({ 'chat_id' => $chatid });
+
+    # on api error, keep silence
+    unless ($chatobj) {
+      carp "Unable to get chat info for $chatid from telegram API";
+      return 0;
+    }
+
+    my $myObj = $self->_brain->getMe ();
+
+    # on api error, keep silence
+    unless ($chatobj) {
+      carp "Unable to get chat info for $chatid from telegram API";
+      return 0;
+    }
+
+    my $myid = $myObj->id;
+    my $me = $self->_brain->getChatMember ({ 'chat_id' => $chatid, 'user_id' => $myid });
+
+    # on api error, keep silence
+    unless ($me) {
+      carp 'Unable to get chat info for bot itself from telegram API';
+      return 0;
+    }
+
+    if ($me->{'status'} eq 'administrator') {
+      $can_talk = 1;
+    } else {
+      my $group_talk = int ($chatobj->{permissions}->{can_send_messages});
+      $can_talk = $group_talk;
+    }
+  } else {
+    # 1 on 1 chat with user
+    $can_talk = 1;
+  }
+
+  return $can_talk;
+}
+
 1;
 
 __END__
@@ -50,6 +97,14 @@ The base class for Telegram 'ChatPermissions' type objects.
 See L<https://core.telegram.org/bots/api#chatpermissions> for details of the
 attributes available for L<Teapot::Bot::Object::ChatPermissions> objects.
 
+=head1 METHODS
+
+=head2 canTalk
+
+A convenience method to check if bot can talk in given conversation.
+
+Returns true if the bot can talk in given conversation, otherwise false.
+
 =head1 AUTHOR
 
 Sergei Fedosov <eleksir@gmail.com>

lib/Teapot/Bot/Object/ChatPhoto.pm

@@ -6,11 +6,13 @@ use Mojo::Base 'Teapot::Bot::Object::Base';
 $Teapot::Bot::Object::ChatPhoto::VERSION = '0.022';
 
 has 'small_file_id';
+has 'small_file_unique_id';
 has 'big_file_id';
+has 'big_file_unique_id';
 
 sub fields {
   return {
-           'scalar' => [qw/small_file_id big_file_id/],
+           'scalar' => [qw/small_file_id small_file_unique_id big_file_id big_file_unique_id/],
          };
 }
 

lib/Teapot/Bot/Object/Dice.pm

@@ -0,0 +1,48 @@
+package Teapot::Bot::Object::Dice;
+# ABSTRACT: The base class for Telegram message 'Dice' type.
+
+use Mojo::Base 'Teapot::Bot::Object::Base';
+
+$Teapot::Bot::Object::Dice::VERSION = '0.022';
+
+has 'emoji';
+has 'value';
+
+sub fields {
+  return { scalar => [qw/emoji value/] };
+}
+
+1;
+
+__END__
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+Teapot::Bot::Object::Dice - The base class for Telegram message 'Dice' type
+
+=head1 VERSION
+
+version 0.022
+
+=head1 DESCRIPTION
+The base class for Telegram message 'Dice' type.
+
+See L<https://core.telegram.org/bots/api#dice> for details of the
+attributes available for L<Teapot::Bot::Object::dice> objects.
+
+=head1 AUTHOR
+
+Sergei Fedosov <eleksir@gmail.com>
+
+=head1 LICENSE AND COPYRIGHT
+
+This software is copyright (c) 2019 by Sergei Fedosov <eleksir@gmail.com>.
+
+This is free software; you can redistribute it and/or modify it under
+the same terms as the Perl 5 programming language system itself.
+
+=cut

lib/Teapot/Bot/Object/InlineKeyboardButton.pm

@@ -18,8 +18,7 @@ has 'pay';
 
 sub fields {
   return { 'scalar'                            => [qw/text url callback_data switch_inline_query
-                                                      switch_inline_query_current_chat switch_inline_query_current_chat
-                                                      pay/],
+                                                      switch_inline_query_current_chat pay/],
            'Teapot::Bot::Object::LoginUrl'     => [qw/login_url/],
            'Teapot::Bot::Object::CallbackGame' => [qw/callback_game/],
          };

lib/Teapot/Bot/Object/Location.pm

@@ -7,9 +7,13 @@ $Teapot::Bot::Object::Location::VERSION = '0.022';
 
 has 'longitude';
 has 'latitude';
+has 'horizontal_accuracy';
+has 'live_period';
+has 'heading';
+has 'proximity_alert_radius';
 
 sub fields {
-  return { scalar => [qw/longitude latitude/] };
+  return { scalar => [qw/longitude latitude horizontal_accuracy live_period heading proximity_alert_radius/] };
 }
 
 1;

lib/Teapot/Bot/Object/Message.pm

@@ -27,24 +27,30 @@ use Teapot::Bot::Object::Venue;
 use Teapot::Bot::Object::SuccessfulPayment;
 use Teapot::Bot::Object::PassportData;
 use Teapot::Bot::Object::InlineKeyboardMarkup;
+use Teapot::Bot::Object::ProximityAlertTriggered;
+use Teapot::Bot::Object::Dice;
+use Teapot::Bot::Object::MessageAutoDeleteTimerChanged;
+use Teapot::Bot::Object::VoiceChatStarted;
+use Teapot::Bot::Object::VoiceChatEnded;
+use Teapot::Bot::Object::VoiceChatParticipantsInvited;
 
 use Data::Dumper;
+use Carp qw(cluck);
 
 $Teapot::Bot::Object::Message::VERSION = '0.022';
 
 # basic message stuff
 has 'message_id';
 has 'from';  # User
+has 'sender_chat';  # Chat
 has 'date';
 has 'chat';  # Chat
-
 has 'forward_from'; # User
 has 'forward_from_chat'; # Chat
 has 'forward_from_message_id';
 has 'forward_signature';
 has 'forward_sender_name';
 has 'forward_date';
-
 has 'reply_to_message'; # Message
 has 'via_bot'; # User
 has 'edit_date';
@@ -52,23 +58,22 @@ has 'media_group_id';
 has 'author_signature';
 has 'text';
 has 'entities'; # Array of MessageEntity
-
-has 'caption_entities'; # Array of MessageEntity
-
+has 'animation'; # Animation
 has 'audio'; # Audio
 has 'document'; # Document
-has 'animation'; # Animation
-has 'game'; # Game
 has 'photo'; # Array of PhotoSize
 has 'sticker';  # Sticker
 has 'video'; # Video
-has 'voice'; # Voice
 has 'video_note'; # VideoNote
+has 'voice'; # Voice
 has 'caption';
+has 'caption_entities'; # Array of MessageEntity
 has 'contact'; # Contact
-has 'location'; # Location
-has 'venue'; # Venue
+has 'dice';
+has 'game';
 has 'poll'; # Poll
+has 'venue'; # Venue
+has 'location'; # Location
 has 'new_chat_members'; # Array of User
 has 'left_chat_member'; # User
 has 'new_chat_title';
@@ -77,6 +82,7 @@ has 'delete_chat_photo';
 has 'group_chat_created';
 has 'supergroup_chat_created';
 has 'channel_chat_created';
+has 'message_auto_delete_timer_changed'; # Optional. Service message: auto-delete timer settings changed in the chat
 has 'migrate_to_chat_id';
 has 'migrate_from_chat_id';
 has 'pinned_message'; # Message
@@ -84,6 +90,10 @@ has 'invoice'; # Invoice
 has 'successful_payment'; # SuccessfulPayment
 has 'connected_website';
 has 'passport_data'; # PassportData
+has 'proximity_alert_triggered';
+has 'voice_chat_started'; # Optional. Service message: voice chat started
+has 'voice_chat_ended'; # Optional. Service message: voice chat ended
+has 'voice_chat_participants_invited'; # Optional. Service message: new participants invited to a voice chat
 has 'reply_markup'; # Array of InlineKeyboardMarkup
 
 sub fields {
@@ -98,7 +108,7 @@ sub fields {
                                                             migrate_from_chat_id connected_website/],
           'Teapot::Bot::Object::User'                 => [qw/from forward_from via_bot new_chat_members left_chat_member /],
 
-          'Teapot::Bot::Object::Chat'                 => [qw/chat forward_from_chat/],
+          'Teapot::Bot::Object::Chat'                 => [qw/sender_chat chat forward_from_chat/],
           'Teapot::Bot::Object::Message'              => [qw/reply_to_message pinned_message/],
           'Teapot::Bot::Object::MessageEntity'        => [qw/entities caption_entities /],
 
@@ -122,7 +132,12 @@ sub fields {
           'Teapot::Bot::Object::SuccessfulPayment'    => [qw/successful_payment/],
           'Teapot::Bot::Object::PassportData'         => [qw/passport_data/],
           'Teapot::Bot::Object::InlineKeyboardMarkup' => [qw/reply_markup/],
-
+          'Teapot::Bot::Object::ProximityAlertTriggered' => [qw/proximity_alert_triggered/],
+          'Teapot::Bot::Object::Dice'                 => [qw/dice/],
+          'Teapot::Bot::Object::MessageAutoDeleteTimerChanged' => [qw/message_auto_delete_timer_changed/],
+          'Teapot::Bot::Object::VoiceChatStarted'     => [qw/voice_chat_started/],
+          'Teapot::Bot::Object::VoiceChatEnded'       => [qw/voice_chat_ended/],
+          'Teapot::Bot::Object::VoiceChatParticipantsInvited' => [qw/voice_chat_participants_invited/],
   };
 }
 
@@ -134,12 +149,44 @@ sub arrays {
 sub reply {
   my $self = shift;
   my $text = shift;
-  return $self->_brain->sendMessage({chat_id => $self->chat->id, text => $text});
+
+  my $chatid = $self->chat->id;
+
+  if (Teapot::Bot::Object::ChatPermissions::canTalk($self, $chatid)) {
+    return $self->_brain->sendMessage({chat_id => $chatid, text => $text});
+  }
+
+  return {'error' => 1};
+}
+
+sub replyMd {
+  my $self = shift;
+  my $text = shift;
+
+  my $chatid = $self->chat->id;
+
+  if (Teapot::Bot::Object::ChatPermissions::canTalk ($self, $chatid)) {
+    my $send_args;
+    $send_args->{text} = $text;
+    $send_args->{parse_mode} = 'Markdown';
+    $send_args->{chat_id} = $chatid;
+
+    return $self->_brain->sendMessage($send_args);
+  }
+
+  return {'error' => 1};
 }
 
 sub typing {
   my $self = shift;
-  return $self->_brain->sendChatAction({chat_id => $self->chat->id});
+
+  my $chatid = $self->chat->id;
+
+  if (Teapot::Bot::Object::ChatPermissions::canTalk ($self, $chatid)) {
+    return $self->_brain->sendChatAction({chat_id => $chatid});
+  }
+
+  return {'error' => 1};
 }
 
 1;

lib/Teapot/Bot/Object/MessageAutoDeleteTimerChanged.pm

@@ -0,0 +1,49 @@
+package Teapot::Bot::Object::MessageAutoDeleteTimerChanged;
+# ABSTRACT: The base class for Telegram 'MessageAutoDeleteTimerChanged' type objects
+
+use Mojo::Base 'Teapot::Bot::Object::Base';
+
+$Teapot::Bot::Object::MessageAutoDeleteTimerChanged::VERSION = '0.022';
+
+has 'message_auto_delete_time';
+
+sub fields {
+  return {
+           'scalar'                    => [qw/message_auto_delete_time/],
+         };
+}
+
+1;
+
+__END__
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+Teapot::Bot::Object::MessageAutoDeleteTimerChanged - The base class for Telegram 'MessageAutoDeleteTimerChanged' type objects
+
+=head1 VERSION
+
+version 0.022
+
+=head1 DESCRIPTION
+The base class for Telegram 'MessageAutoDeleteTimerChanged' type objects.
+
+See L<https://core.telegram.org/bots/api#messageautodeletetimerchanged> for details of the
+attributes available for L<Teapot::Bot::Object::MessageAutoDeleteTimerChanged> objects.
+
+=head1 AUTHOR
+
+Sergei Fedosov <eleksir@gmail.com>
+
+=head1 LICENSE AND COPYRIGHT
+
+This software is copyright (c) 2021 by Sergei Fedosov <eleksir@gmail.com>
+
+This is free software; you can redistribute it and/or modify it under
+the same terms as the Perl 5 programming language system itself.
+
+=cut

lib/Teapot/Bot/Object/Poll.pm

@@ -9,17 +9,28 @@ $Teapot::Bot::Object::Poll::VERSION = '0.022';
 has 'id';
 has 'question';
 has 'options'; # Array of PollOption
+has 'total_voter_count';
 has 'is_closed';
+has 'is_anonymous';
+has 'type';
+has 'allows_multiple_answers';
+has 'correct_option_id';
+has 'explanation';
+has 'explanation_entities';
+has 'open_period';
+has 'close_date';
 
 sub fields {
   return {
-           scalar                            => [qw/id question is_closed/],
+           scalar                            => [qw/id question total_voter_count is_closed is_anonymous type
+                                                    allows_multiple_answers correct_option_id explanation
+                                                    explanation_entities open_period close_date/],
            'Teapot::Bot::Object::PollOption' => [qw/options/],
          };
 }
 
 sub arrays {
-  return qw/options/;
+  return qw/options explanation_entities/;
 }
 
 1;

lib/Teapot/Bot/Object/PollAnswer.pm

@@ -0,0 +1,56 @@
+package Teapot::Bot::Object::PollOption;
+# ABSTRACT: The base class for Telegram 'PollOption' type objects
+
+use Mojo::Base 'Teapot::Bot::Object::Base';
+
+$Teapot::Bot::Object::PollOption::VERSION = '0.022';
+
+has 'poll_id';
+has 'user';
+has 'option_ids';
+
+sub fields {
+  return {
+    'scalar'                    => [qw/poll_id option_ids/],
+    'Teapot::Bot::Object::User' => [qw/user/],
+  };
+}
+
+sub arrays {
+  return qw/option_ids/;
+}
+
+1;
+
+__END__
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+Teapot::Bot::Object::PollOption - The base class for Telegram 'PollOption' type objects
+
+=head1 VERSION
+
+version 0.022
+
+=head1 DESCRIPTION
+The base class for Telegram 'PollOption' type objects.
+
+See L<https://core.telegram.org/bots/api#polloption> for details of the
+attributes available for L<Teapot::Bot::Object::PollOption> objects.
+
+=head1 AUTHOR
+
+Sergei Fedosov <eleksir@gmail.com>
+
+=head1 LICENSE AND COPYRIGHT
+
+This software is copyright (c) 2020 Sergei Fedosov <eleksir@gmail.com>.
+
+This is free software; you can redistribute it and/or modify it under
+the same terms as the Perl 5 programming language system itself.
+
+=cut

lib/Teapot/Bot/Object/ProximityAlertTriggered.pm

@@ -0,0 +1,52 @@
+package Teapot::Bot::Object::ProximityAlertTriggered;
+# ABSTRACT: The base class for Telegram message 'ProximityAlertTriggered' type.
+
+use Mojo::Base 'Teapot::Bot::Object::Base';
+
+$Teapot::Bot::Object::ProximityAlertTriggered::VERSION = '0.022';
+
+has 'traveler'; # User
+has 'watcher'; # User
+has 'distance';
+
+sub fields {
+  return {
+    'Teapot::Bot::Object::User' => [qw/traveler watcher/],
+    'scalar'                    => [qw/distance/],
+  };
+}
+
+1;
+
+__END__
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+Teapot::Bot::Object::ProximityAlertTriggered - The base class for Telegram message 'ProximityAlertTriggered' type
+
+=head1 VERSION
+
+version 0.022
+
+=head1 DESCRIPTION
+The base class for Telegram message 'ProximityAlertTriggered' type.
+
+See L<https://core.telegram.org/bots/api#proximityalerttriggered> for details of the
+attributes available for L<Teapot::Bot::Object::ProximityAlertTriggered> objects.
+
+=head1 AUTHOR
+
+Sergei Fedosov <eleksir@gmail.com>
+
+=head1 LICENSE AND COPYRIGHT
+
+This software is copyright (c) 2020 Sergei Fedosov <eleksir@gmail.com>.
+
+This is free software; you can redistribute it and/or modify it under
+the same terms as the Perl 5 programming language system itself.
+
+=cut

lib/Teapot/Bot/Object/Venue.pm

@@ -11,10 +11,12 @@ has 'title';
 has 'address';
 has 'foursquare_id';
 has 'foursquare_type';
+has 'google_place_id';
+has 'google_place_type';
 
 sub fields {
   return {
-           'scalar'                        => [qw/title address foursquare_id foursquare_type/],
+           'scalar'                        => [qw/title address foursquare_id foursquare_type google_place_id google_place_type/],
            'Teapot::Bot::Object::Location' => [qw/location/]
          };
 

lib/Teapot/Bot/Object/Video.pm

@@ -7,16 +7,19 @@ use Teapot::Bot::Object::PhotoSize;
 $Teapot::Bot::Object::Video::VERSION = '0.022';
 
 has 'file_id';
+has 'file_unique_id';
 has 'width';
 has 'height';
 has 'duration';
-has 'thumb'; #PhotoSize
-has 'mime_type';
-has 'file_size';
+has 'thumb';     # Optional. Video thumbnail
+has 'file_name'; # Optional. Original filename as defined by sender
+has 'mime_type'; # Optional. Mime type of a file as defined by sender
+has 'file_size'; # Optional. File size
 
 sub fields {
   return {
-           scalar                           => [qw/file_id width height duration mime_type file_size/],
+           scalar                           => [qw/file_id file_unique_id width height duration file_name mime_type
+                                                   file_size/],
            'Teapot::Bot::Object::PhotoSize' => [qw/thumb/]
          };
 }

lib/Teapot/Bot/Object/VoiceChatEnded.pm

@@ -0,0 +1,48 @@
+package Teapot::Bot::Object::VoiceChatEnded;
+# ABSTRACT: The base class for Telegram message 'VoiceChatEnded' type.
+
+use Mojo::Base 'Teapot::Bot::Object::Base';
+
+$Teapot::Bot::Object::VoiceChatEnded::VERSION = '0.022';
+
+# This object represents a service message about a voice chat started in the chat. Currently holds no information.
+has 'duartion';
+
+sub fields {
+  return { scalar => [qw/duration/] };
+}
+
+1;
+
+__END__
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+Teapot::Bot::Object::VoiceChatEnded - The base class for Telegram message 'VoiceChatEnded' type
+
+=head1 VERSION
+
+version 0.022
+
+=head1 DESCRIPTION
+The base class for Telegram message 'VoiceChatEnded' type.
+
+See L<https://core.telegram.org/bots/api#voicechatended> for details of the
+attributes available for L<Teapot::Bot::Object::VoiceChatEnded> objects.
+
+=head1 AUTHOR
+
+Sergei Fedosov <eleksir@gmail.com>
+
+=head1 LICENSE AND COPYRIGHT
+
+This software is copyright (c) 2021 by Sergei Fedosov <eleksir@gmail.com>.
+
+This is free software; you can redistribute it and/or modify it under
+the same terms as the Perl 5 programming language system itself.
+
+=cut

lib/Teapot/Bot/Object/VoiceChatParticipantsInvited.pm

@@ -0,0 +1,53 @@
+package Teapot::Bot::Object::VoiceChatParticipantsInvited;
+# ABSTRACT: The base class for Telegram message 'VoiceChatParticipantsInvited' type.
+
+use Mojo::Base 'Teapot::Bot::Object::Base';
+use Teapot::Bot::Object::User;
+
+$Teapot::Bot::Object::VoiceChatParticipantsInvited::VERSION = '0.022';
+
+# This object represents a service message about a voice chat started in the chat. Currently holds no information.
+has 'users';
+
+sub fields {
+  return { 'Teapot::Bot::Object::User' => [qw/users/] };
+}
+
+sub arrays {
+  return qw/users/;
+}
+
+1;
+
+__END__
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+Teapot::Bot::Object::VoiceChatParticipantsInvited - The base class for Telegram message 'VoiceChatParticipantsInvited' type
+
+=head1 VERSION
+
+version 0.022
+
+=head1 DESCRIPTION
+The base class for Telegram message 'VoiceChatParticipantsInvited' type.
+
+See L<https://core.telegram.org/bots/api#voicechatparticipantsinvited> for details of the
+attributes available for L<Teapot::Bot::Object::VoiceChatParticipantsInvited> objects.
+
+=head1 AUTHOR
+
+Sergei Fedosov <eleksir@gmail.com>
+
+=head1 LICENSE AND COPYRIGHT
+
+This software is copyright (c) 2021 by Sergei Fedosov <eleksir@gmail.com>.
+
+This is free software; you can redistribute it and/or modify it under
+the same terms as the Perl 5 programming language system itself.
+
+=cut

lib/Teapot/Bot/Object/VoiceChatStarted.pm

@@ -0,0 +1,48 @@
+package Teapot::Bot::Object::VoiceChatStarted;
+# ABSTRACT: The base class for Telegram message 'VoiceChatStarted' type.
+
+use Mojo::Base 'Teapot::Bot::Object::Base';
+
+$Teapot::Bot::Object::VoiceChatStarted::VERSION = '0.022';
+
+# This object represents a service message about a voice chat started in the chat. Currently holds no information.
+has 'stub';
+
+sub fields {
+  return { scalar => [qw/stub/] };
+}
+
+1;
+
+__END__
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+Teapot::Bot::Object::VoiceChatStarted - The base class for Telegram message 'VoiceChatStarted' type
+
+=head1 VERSION
+
+version 0.022
+
+=head1 DESCRIPTION
+The base class for Telegram message 'VoiceChatStarted' type.
+
+See L<https://core.telegram.org/bots/api#voicechatstarted> for details of the
+attributes available for L<Teapot::Bot::Object::VoiceChatStarted> objects.
+
+=head1 AUTHOR
+
+Sergei Fedosov <eleksir@gmail.com>
+
+=head1 LICENSE AND COPYRIGHT
+
+This software is copyright (c) 2021 by Sergei Fedosov <eleksir@gmail.com>.
+
+This is free software; you can redistribute it and/or modify it under
+the same terms as the Perl 5 programming language system itself.
+
+=cut

lib/admin.pm

@@ -0,0 +1,392 @@
+package admin;
+
+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 File::Path qw (make_path);
+use SQLite_File;
+use conf qw (loadConf);
+use util qw (utf2sha1);
+
+use version; our $VERSION = qw (1.0);
+use Exporter qw (import);
+# to export array we need @ISA here
+our @ISA    = qw / Exporter /; ## no critic (ClassHierarchies::ProhibitExplicitISA)
+our @EXPORT_OK = qw (@forbiddenMessageTypes @pluginList getForbiddenTypes addForbiddenType delForbiddenType listForbidden fortune_toggle fortune_toggle_list fortune_status plugin_toggle plugin_status pluginEnabled);
+
+my $c = loadConf ();
+my $dir = $c->{admin}->{dir};
+# this list is not yet used
+our @pluginList = qw (oboobs obutts); ## no critic (Variables::ProhibitPackageVars)
+our @forbiddenMessageTypes = qw (audio voice photo video video_note animation sticker dice game poll document); ## no critic (Variables::ProhibitPackageVars)
+
+sub initCensorDB {
+	my $backingfile = shift;
+
+	tie my %censor, 'SQLite_File', $backingfile  ||  cluck "Unable to tie to $backingfile: $OS_ERROR";
+
+	foreach (@forbiddenMessageTypes) {
+		$censor{$_} = 0;
+	}
+
+	untie %censor;
+
+	return;
+}
+
+sub getForbiddenTypes {
+	my $chatid = shift;
+
+	unless (-d $dir) {
+		unless (make_path $dir) {
+			cluck "Unable to create $dir: $OS_ERROR";
+			return;
+		}
+	}
+
+	my $messageTypes;
+	my $backingfile = utf2sha1 $chatid;
+	$backingfile =~ s/\//-/xmsg;
+	$backingfile = sprintf '%s/censor_%s.db', $dir, $backingfile;
+	my %censor;
+
+	unless (-f $backingfile) {
+		initCensorDB ($backingfile);
+	}
+
+	unless (tie %censor, 'SQLite_File', $backingfile) {
+		cluck "Unable to tie to $backingfile: $OS_ERROR";
+		return $messageTypes;
+	}
+
+	foreach (keys %censor) {
+		if ($censor{$_}) {
+			$messageTypes->{$_} = 1;
+		} else {
+			$messageTypes->{$_} = 0;
+		}
+	}
+
+	untie %censor;
+	return $messageTypes;
+}
+
+sub addForbiddenType {
+	my $chatid = shift;
+	my $type = shift;
+
+	unless (-d $dir) {
+		unless (make_path $dir) {
+			cluck "Unable to create $dir: $OS_ERROR";
+			return;
+		}
+	}
+
+	my $backingfile = utf2sha1 $chatid;
+	$backingfile =~ s/\//-/xmsg;
+	$backingfile = sprintf '%s/censor_%s.db', $dir, $backingfile;
+
+	unless (-f $backingfile) {
+		initCensorDB ($backingfile);
+	}
+
+	my %censor;
+
+	unless (tie %censor, 'SQLite_File', $backingfile) {
+		cluck "Unable to tie to $backingfile: $OS_ERROR";
+		return;
+	}
+
+	$censor{$type} = 1;
+	untie %censor;
+
+	return;
+}
+
+sub delForbiddenType {
+	my $chatid = shift;
+	my $type = shift;
+
+	unless (-d $dir) {
+		unless (make_path $dir) {
+			cluck "Unable to create $dir: $OS_ERROR";
+			return;
+		}
+	}
+
+	my $backingfile = utf2sha1 $chatid;
+	$backingfile =~ s/\//-/xmsg;
+	$backingfile = sprintf '%s/censor_%s.db', $dir, $backingfile;
+
+	unless (-f $backingfile) {
+		initCensorDB ($backingfile);
+		return;
+	}
+
+	my %censor;
+
+	unless (tie %censor, 'SQLite_File', $backingfile) {
+		cluck "Unable to tie to $backingfile: $OS_ERROR";
+		return;
+	}
+
+	$censor{$type} = 0;
+	untie %censor;
+
+	return;
+}
+
+sub listForbidden {
+	my $chatid = shift;
+
+	unless (-d $dir) {
+		unless (make_path $dir) {
+			cluck "Unable to create $dir: $OS_ERROR";
+			return;
+		}
+	}
+
+	my @list;
+	my $backingfile = utf2sha1 $chatid;
+	$backingfile =~ s/\//-/xmsg;
+	$backingfile = sprintf '%s/censor_%s.db', $dir, $backingfile;
+
+	unless (-f $backingfile) {
+		initCensorDB ($backingfile);
+	}
+
+	my %censor;
+
+	# FIXME: return list with all types alowed
+	unless (tie %censor, 'SQLite_File', $backingfile) {
+		cluck "Unable to tie to $backingfile: $OS_ERROR";
+		return '';
+	}
+
+	foreach (keys %censor) {
+		if ($censor{$_}) {
+			push @list, sprintf 'Тип сообщения %s удаляется', $_;
+		} else {
+			push @list, sprintf 'Тип сообщения %s не удаляется', $_;
+		}
+	}
+
+	untie %censor;
+
+	return join "\n", @list;
+}
+
+sub fortune_toggle (@) {
+	my $chatid = shift;
+	my $action = shift // undef;
+	my $phrase = 'Фортунка с утра ';
+
+	unless (-d $dir) {
+		make_path ($dir)  ||  do {
+			cluck "[ERROR] Unable to create $dir: $OS_ERROR";
+			return;
+		};
+	}
+
+	my $backingfile = sprintf '%s/fortune_morning.sqlite', $dir;
+
+	tie my %toggle, 'SQLite_File', $backingfile  ||  do {
+		cluck "[ERROR] Unable to tie to $backingfile: $OS_ERROR";
+		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) {
+		make_path ($dir)  ||  do {
+			cluck "[ERROR] Unable to create $dir: $OS_ERROR";
+			return;
+		};
+	}
+
+	my $backingfile = sprintf '%s/fortune_morning.sqlite', $dir;
+
+	tie my %toggle, 'SQLite_File', $backingfile  ||  do {
+		cluck "[ERROR] Unable to tie to $backingfile: $OS_ERROR\n";
+		return;
+	};
+
+	my $state = $toggle{$chatid};
+
+	if (defined $state && $state) {
+		$phrase .= 'показывается.';
+	} else {
+		$phrase .= 'не показывается.';
+	}
+
+	untie %toggle;
+	return $phrase;
+}
+
+sub fortune_toggle_list () {
+	unless (-d $dir) {
+		make_path ($dir)  ||  do {
+			cluck "[ERROR] Unable to create $dir: $OS_ERROR";
+			my @empty = ();
+			return @empty;
+		}
+	}
+
+	my $backingfile = sprintf '%s/fortune_morning.sqlite', $dir;
+
+	tie my %toggle, 'SQLite_File', $backingfile  ||  do {
+		cluck "[ERROR] Unable to tie to $backingfile: $OS_ERROR";
+		my @empty = ();
+		return @empty;
+	};
+
+	my @list = keys %toggle;
+	untie %toggle;
+	return @list;
+}
+
+sub plugin_status (@) {
+	my $chatid = shift;
+	my $plugin = shift;
+	my $phrase = "Плагин $plugin ";
+
+	unless (-d $dir) {
+		make_path ($dir)  ||  do {
+			cluck "[ERROR] Unable to create $dir: $OS_ERROR";
+			return;
+		};
+	}
+
+	my $backingfile = utf2sha1 $chatid;
+	$backingfile =~ s/\//-/xmsg;
+	$backingfile = sprintf '%s/%s.sqlite', $dir, $backingfile;
+
+	tie my %toggle, 'SQLite_File', $backingfile  ||  do {
+		cluck "[ERROR] Unable to tie to $backingfile: $OS_ERROR\n";
+		return;
+	};
+
+	my $state = $toggle{$plugin};
+	untie %toggle;
+
+	if (defined $state && $state) {
+		$phrase .= 'включён.';
+	} else {
+		$phrase .= 'выключен.';
+	}
+
+	return $phrase;
+}
+
+sub pluginEnabled (@) {
+	my $chatid = shift;
+	my $plugin = shift;
+
+	unless (-d $dir) {
+		make_path ($dir)  ||  do {
+			cluck "[ERROR] Unable to create $dir: $OS_ERROR";
+			return;
+		};
+	}
+
+	my $backingfile = utf2sha1 $chatid;
+	$backingfile =~ s/\//-/xmsg;
+	$backingfile = sprintf '%s/%s.sqlite', $dir, $backingfile;
+
+	tie my %toggle, 'SQLite_File', $backingfile  ||  do {
+		cluck "[ERROR] Unable to tie to $backingfile: $OS_ERROR\n";
+		return;
+	};
+
+	my $state = $toggle{$plugin};
+	untie %toggle;
+
+	if (defined $state && $state) {
+		return 1;
+	} else {
+		return 0;
+	}
+}
+
+sub plugin_toggle (@) {
+	my $chatid = shift;
+	my $plugin = shift;
+	my $action = shift // undef;
+	my $phrase = "Плагин $plugin ";
+
+	unless (-d $dir) {
+		make_path ($dir)  ||  do {
+			cluck "[ERROR] Unable to create $dir: $OS_ERROR";
+			my @empty = ();
+			return @empty;
+		}
+	}
+
+	my $backingfile = utf2sha1 $chatid;
+	$backingfile =~ s/\//-/xmsg;
+	$backingfile = sprintf '%s/%s.sqlite', $dir, $backingfile;
+
+	tie my %toggle, 'SQLite_File', $backingfile  ||  do {
+		cluck "[ERROR] Unable to tie to $backingfile: $OS_ERROR";
+		my @empty = ();
+		return @empty;
+	};
+
+	if (defined $action) {
+		if ($action) {
+			$toggle{$plugin} = 1;
+			$phrase .= 'включён';
+		} else {
+			$toggle{$plugin} = 0;
+			$phrase .= 'выключен';
+		}
+	} else {
+		if (defined ($toggle{$plugin}) && $toggle{$plugin}) {
+			$toggle{$plugin} = 0;
+			$phrase .= 'включён';
+		} else {
+			$toggle{$plugin} = 1;
+			$phrase .= 'выключен';
+		}
+	}
+
+	untie %toggle;
+	return $phrase;
+}
+
+1;
+
+# vim: set ft=perl noet ai ts=4 sw=4 sts=4:

lib/archeologist.pm

@@ -0,0 +1,126 @@
+package archeologist;
+
+use 5.018;
+use strict;
+use warnings;
+use utf8;
+use open qw (:std :utf8);
+use English qw ( -no_match_vars );
+use Math::Random::Secure qw (irand);
+
+use version; our $VERSION = qw (1.0);
+use Exporter qw (import);
+our @EXPORT_OK = qw (dig);
+
+sub dig {
+	my $name = shift;
+
+	my @artifact = (
+		'амулет Мерлина',
+		'библиотеку Ивана Грозного',
+		'деревянную плошку',
+		'диплока',
+		'доски Ноева Ковчега',
+		'древний презерватив из бараньей кишки',
+		'икону',
+		'инсталятор Windows 3.11',
+		'истлевший гроб',
+		'каменный топор',
+		'клад со златом-серебром',
+		'кривой нож',
+		'ледяную глыбу',
+		'лунный грунт',
+		'мамонта',
+		'мамонтёнка',
+		'метеорит',
+		'мумию фараона Тутанхамона',
+		'носки прапорщика (поставит в угол)',
+		'обломки грузинской керамики',
+		'птеродактиля',
+		'рубль с Лениным',
+		'рыцарские доспехи',
+		'синий мох',
+		'скелет',
+		'скелет собаки по кличке Беня',
+		'тиранозавтра',
+		'тотем индейцев',
+		'трубу с туркменским газом',
+		'скорбь еврейского народа',
+		'залежи активированного угля',
+		'не очень новый завет',
+		'мать леннарта поттеринга',
+		'руководство "начинающему археологу"',
+		'слово о полку игореве и дело о полку игореве, вместе с игорем',
+		'телепрограмму канала A-one',
+		'могилу искателя могил',
+		'заплесневевший кусок хлеба',
+		'преемник радиоприемника',
+		'глушитель от ВАЗ-2106',
+		'чувство удовлетворения',
+		'крота',
+		'воспоминания о былой любви',
+		'грязистор',
+		'египетское мумиё',
+		'окаменелый камень',
+		'кладку яиц рептилоида',
+		'яму',
+		'чеснок и стрелы',
+		'доллар по 30',
+		'несмазанные скрижали',
+		'четырелобита',
+		'чучело тролля',
+		'целое ничего',
+	);
+
+	my @location = (
+		'в архивах',
+		'в гималаях',
+		'в интернете',
+		'в кармане',
+		'в клумбе',
+		'в лунном кратере',
+		'во льдах арктики',
+		'в морге',
+		'в окрестностях погоста',
+		'в песочнице',
+		'в пустыне Гоби',
+		'в пустыне Сахаре',
+		'в русле высохшей реки',
+		'в собственной памяти',
+		'в старом сортире',
+		'в углу',
+		'в цветочном горшке',
+		'на бабушкином огороде',
+		'на винчестере',
+		'на горе Арарат',
+		'на горном плато',
+		'на дне моря',
+		'на необитаемом острове',
+		'на первом слое сумрака',
+		'на просторах Украины',
+	);
+
+	my $find_probability = irand 100;
+	my $success_probability = irand 100;
+	my $artifact_age = irand 15000;
+
+	if ($find_probability <= 20) {
+		return sprintf 'По уши закопавшись %s, %s, нифига вы не выкопали! Может повезет в другом месте?', $location[irand ($#location + 1)], $name;
+	}
+
+	my $phrase = sprintf "Вы начали раскопки %s и усиленно роете лопатами, экскаватором...\n", $location[irand ($#location + 1)];
+	$phrase .= "Вам кажется что ваш совочек ударился обо что-то твердое. Может, это клад?!\n\n";
+
+	if ($success_probability <= 25) {
+		$phrase .= sprintf '%s стал лучшим археологом, выкопав %s! возраст артефакта - %s лет!', $name, $artifact[irand ($#artifact + 1)], $artifact_age;
+	} else {
+		$phrase .= sprintf "Поздравляю, %s! Вы только что выкопали %s, возраст - %s лет!\n", $name, $artifact[irand ($#artifact + 1)], $artifact_age;
+		$phrase .= sprintf 'Извини, %s, но на артефакт это не тянет! Однако, попытка хорошая!', $name;
+	}
+
+	return $phrase;
+}
+
+1;
+
+# vim: set ft=perl noet ai ts=4 sw=4 sts=4:

lib/botlib.pm

@@ -5,225 +5,33 @@ use 5.018;
 use strict;
 use warnings;
 use utf8;
-use open qw(:std :utf8);
-use English qw( -no_match_vars );
+use open qw (:std :utf8);
+use English qw ( -no_match_vars );
+use Carp qw (carp);
+use Math::Random::Secure qw (irand);
 
-use HTTP::Tiny;
-use URI::URL;
-use JSON::XS qw(decode_json encode_json);
-use Digest::MD5 qw(md5_base64);
-use DB_File;
+use conf qw (loadConf);
+use admin qw (@forbiddenMessageTypes getForbiddenTypes addForbiddenType delForbiddenType listForbidden fortune_toggle fortune_status plugin_toggle plugin_status pluginEnabled);
+use archeologist qw (dig);
+use buni qw (buni);
+use drink qw (drink);
+use fisher qw (fish);
+use fortune qw (fortune);
+use friday qw (friday);
+use image qw (kitty fox oboobs obutts rabbit owl);
+use karma qw (karmaSet karmaGet);
+use lat qw (latAnswer);
+use monkeyuser qw (monkeyuse);
+use util qw (trim);
+use weather qw (weather);
+use xkcd qw (xkcd);
 
-use conf qw(loadConf);
+use version; our $VERSION = qw (1.0);
+use Exporter qw (import);
+our @EXPORT_OK = qw (randomCommonPhrase command highlight botsleep isCensored);
 
-use vars qw/$VERSION/;
-
-use Exporter qw(import);
-our @EXPORT_OK = qw(weather logger trim randomCommonPhrase);
-
-$VERSION = '1.0';
-
-my $c = loadConf();
-
-sub __urlencode {
-	my $str = shift;
-	my $urlobj = url $str;
-	$str = $urlobj->as_string;
-	$urlobj = undef; undef $urlobj;
-	return $str;
-}
-
-sub logger {
-	my $msg = shift;
-
-	if ($c->{debug_log}) {
-		my @date = localtime();
-		my @month = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
-		my $t = sprintf ('%02s %02d %02d:%02d:%02d ', $month[$date[4]], $date[3], $date[2], $date[1], $date[0]);
-
-		my $mode = '>';
-		$mode = '>>' if (-f $c->{debug_log});
-
-		if (open my $LOG, $mode, $c->{debug_log}) {
-			print $LOG $t . $msg . "\n";             ## no critic (InputOutput::RequireCheckedSyscalls)
-			close $LOG;                              ## no critic (InputOutput::RequireCheckedSyscalls)
-		}
-	}
-
-	return;
-}
-
-sub trim {
-	my $str = shift;
-
-	while (substr ($str, 0, 1) =~ /^\s$/xms) {
-		$str = substr ($str, 1);
-	}
-
-	while (substr ($str, -1, 1) =~ /^\s$/xms) {
-		chop ($str);
-	}
-
-	return $str;
-}
-
-
-sub weather {
-	my $city = shift;
-	$city = trim ($city);
-
-	return 'Мне нужно ИМЯ города.' if ($city eq '');
-	return 'Длинновато для названия города.' if (length($city) > 80);
-
-	$city = ucfirst ($city);
-	my $w = __weather ($city);
-	my $reply;
-
-	if ($w) {
-		if ($w->{temperature_min} == $w->{temperature_max}) {
-			$reply = sprintf ("Погода в городе %s, %s:\n%s, ветер %s %s м/c, температура %s°C, ощущается как %s°C, относительная влажность %s%%, давление %s мм.рт.с",
-				$w->{name},
-				$w->{country},
-				ucfirst ($w->{description}),
-				$w->{wind_direction},
-				$w->{wind_speed},
-				$w->{temperature_min},
-				$w->{temperature_feelslike},
-				$w->{humidity},
-				$w->{pressure}
-			);
-		} else {
-			$reply = sprintf ("Погода в городе %s, %s:\n%s, ветер %s %s м/c, температура %s-%s°C, ощущается как %s°C, относительная влажность %s%%, давление %s мм.рт.ст",
-				$w->{name},
-				$w->{country},
-				ucfirst ($w->{description}),
-				$w->{wind_direction},
-				$w->{wind_speed},
-				$w->{temperature_min},
-				$w->{temperature_max},
-				$w->{temperature_feelslike},
-				$w->{humidity},
-				$w->{pressure}
-			);
-		}
-	} else {
-		$reply = "Я не знаю, какая погода в $city";
-	}
-
-	return $reply;
-}
-
-sub __weather {
-	my $city = shift;
-	$city = __urlencode ($city);
-	my $id = md5_base64 ($city);
-	my $appid = $c->{openweathermap}->{appid};
-	my $now = time ();
-	my $fc;
-	my $w;
-
-	# attach to cache data
-	tie my %cachetime, 'DB_File', $c->{openweathermap}->{cachetime} or do {
-		logger "Something nasty happen when cachetime ties to its data: $OS_ERROR";
-		return undef;
-	};
-
-	tie my %cachedata, 'DB_File', $c->{openweathermap}->{cachedata} or do {
-		logger "Something nasty happen when cachedata ties to its data: $OS_ERROR";
-		return undef;
-	};
-
-	# lookup cache
-	if (defined ($cachetime{$id}) && ($now - $cachetime{$id}) < 10800) {
-		$fc = decode_json ($cachedata{$id});
-	} else {
-		my $r;
-
-		# try 3 times and giveup
-		for (1..3) {
-			next if ($r->{success});
-			my $http = HTTP::Tiny->new (timeout => 3);
-			$r = $http->get (sprintf ('http://api.openweathermap.org/data/2.5/weather?q=%s&lang=ru&APPID=%s', $city, $appid));
-			sleep 2;
-		}
-
-		# all 3 times can give error, so check it here
-		if ($r->{success}) {
-			$fc = eval { decode_json ($r->{content}) };
-
-			if ($EVAL_ERROR) {
-				logger "[WARN] openweathermap returns corrupted json: $EVAL_ERROR";
-				untie %cachetime;
-				untie %cachedata;
-				return undef;
-			};
-
-			$cachetime{$id} = $now;
-			$cachedata{$id} = encode_json ($fc);
-		} else {
-			untie %cachetime;
-			untie %cachedata;
-			return undef;
-		}
-	}
-
-	untie %cachetime;
-	untie %cachedata;
-
-	# TODO: check all of this for existance
-	$w->{'name'} = $fc->{name};
-	$w->{'state'} = $fc->{state};
-	$w->{'country'} = $fc->{sys}->{country};
-	$w->{'longitude'} = $fc->{coord}->{lon};
-	$w->{'latitude'} = $fc->{coord}->{lat};
-	$w->{'temperature_min'} = int ($fc->{main}->{temp_min} - 273.15);
-	$w->{'temperature_max'} = int ($fc->{main}->{temp_max} - 273.15);
-	$w->{'temperature_feelslike'} = int ($fc->{main}->{feels_like} - 273.15);
-	$w->{'humidity'} = $fc->{main}->{humidity};
-	$w->{'pressure'} = int ($fc->{main}->{pressure} * 0.75006375541921);
-	$w->{'description'} = $fc->{weather}->[0]->{description};
-	$w->{'wind_speed'} = $fc->{wind}->{speed};
-	$w->{'wind_direction'} = 'разный';
-	my $dir = int ($fc->{wind}->{deg} + 0);
-
-	if ($dir == 0) {
-		$w->{'wind_direction'} = 'северный';
-	} elsif ($dir > 0   && $dir <= 30) {
-		$w->{'wind_direction'} = 'северо-северо-восточный';
-	} elsif ($dir > 30  && $dir <= 60) {
-		$w->{'wind_direction'} = 'северо-восточный';
-	} elsif ($dir > 60  && $dir <  90) {
-		$w->{'wind_direction'} = 'восточно-северо-восточный';
-	} elsif ($dir == 90) {
-		$w->{'wind_direction'} = 'восточный';
-	} elsif ($dir > 90  && $dir <= 120) {
-		$w->{'wind_direction'} = 'восточно-юго-восточный';
-	} elsif ($dir > 120 && $dir <= 150) {
-		$w->{'wind_direction'} = 'юговосточный';
-	} elsif ($dir > 150 && $dir <  180) {
-		$w->{'wind_direction'} = 'юго-юго-восточный';
-	} elsif ($dir == 180) {
-		$w->{'wind_direction'} = 'южный';
-	} elsif ($dir > 180 && $dir <= 210) {
-		$w->{'wind_direction'} = 'юго-юго-западный';
-	} elsif ($dir > 210 && $dir <= 240) {
-		$w->{'wind_direction'} = 'юго-западный';
-	} elsif ($dir > 240 && $dir <  270) {
-		$w->{'wind_direction'} = 'западно-юго-западный';
-	} elsif ($dir == 270) {
-		$w->{'wind_direction'} = 'западный';
-	} elsif ($dir > 270 && $dir <= 300) {
-		$w->{'wind_direction'} = 'западно-северо-западный';
-	} elsif ($dir > 300 && $dir <= 330) {
-		$w->{'wind_direction'} = 'северо-западный';
-	} elsif ($dir > 330 && $dir <  360) {
-		$w->{'wind_direction'} = 'северо-северо-западный';
-	} elsif ($dir == 360) {
-		$w->{'wind_direction'} = 'северный';
-	}
-
-	return $w;
-}
+my $c = loadConf ();
+my $csign = $c->{telegrambot}->{csign};
 
 sub randomCommonPhrase {
 	my @myphrase = (
@@ -240,7 +48,342 @@ sub randomCommonPhrase {
 		'А ви, таки, почему интересуетесь?',
 	);
 
-	return $myphrase[rand ($#myphrase -1)];
+	return $myphrase[irand ($#myphrase + 1)];
+}
+
+sub command {
+	my $self = shift;
+	my $msg = shift;
+	my $text = shift;
+	my $chatid = shift;
+	my $reply;
+	my ($userid, $username, $fullname, $highlight, $visavi) = highlight ($msg);
+
+	if (substr ($text, 1) eq 'ping') {
+		$reply = 'Pong.';
+	} elsif (substr ($text, 1) eq 'пинг') {
+		$reply = 'Понг.';
+	} elsif (substr ($text, 1) eq 'pong') {
+		$reply = 'Wat?';
+	} elsif (substr ($text, 1) eq 'понг') {
+		$reply = 'Шта?';
+	} elsif (substr ($text, 1) eq 'ver' || substr ($text, 1) eq 'version' || substr ($text, 1) eq 'версия') {
+		$reply = 'Версия:  Нуль.Чего-то_там.Чего-то_там';
+	} elsif (length ($text) >= 2 && (substr ($text, 1, 2) eq 'w ' || substr ($text, 1, 2) eq 'п ')) {
+		my $city = substr $text, 3;
+		$reply = weather $city;
+	} elsif (substr ($text, 1) eq 'buni') {
+		$msg->typing ();
+		$reply = buni ();
+		sleep (irand (2) + 1);
+		$msg->replyMd ($reply);
+		return;
+	} elsif (substr ($text, 1) eq 'monkeyuser') {
+		$msg->typing ();
+		$reply = monkeyuser ();
+		sleep (irand (2) + 1);
+		$msg->replyMd ($reply);
+		return;
+	} elsif (substr ($text, 1) eq 'cat'  ||  substr ($text, 1) eq 'кис') {
+		$msg->typing ();
+		$reply = kitty ();
+		sleep (irand (2) + 1);
+		$msg->replyMd ($reply);
+		return;
+	} elsif (substr ($text, 1) eq 'lat'  ||  substr ($text, 1) eq 'лат') {
+		$reply = latAnswer ();
+	} elsif (
+		(length ($text) >= 6 && (substr ($text, 1, 6) eq 'karma ' || substr ($text, 1, 6) eq 'карма '))  ||
+		substr ($text, 1) eq 'karma'  ||  substr ($text, 1) eq 'карма'
+	) {
+		my $mytext = '';
+
+		if (length($text) > 6) {
+			$mytext = substr $text, 7;
+			chomp $mytext;
+			$mytext = trim $mytext;
+		} else {
+			$mytext = '';
+		}
+
+		$reply = karmaGet ($chatid, $mytext);
+	} elsif (substr ($text, 1) eq 'xkcd') {
+		$msg->typing ();
+		$reply = xkcd ();
+		sleep (irand (2) + 1);
+		$msg->replyMd ($reply);
+		return;
+	} elsif (substr ($text, 1) eq 'fox'  ||  substr ($text, 1) eq 'лис') {
+		$msg->typing ();
+		$reply = fox ();
+		sleep (irand (2) + 1);
+		$msg->replyMd ($reply);
+		return;
+	} elsif (substr ($text, 1) eq 'rabbit'  ||  substr ($text, 1) eq 'bunny'  ||  substr ($text, 1) eq 'кролик') {
+		$msg->typing ();
+		$reply = rabbit ();
+		$msg->replyMd ($reply);
+		return;
+	} elsif (substr ($text, 1) eq 'owl'  ||  substr ($text, 1) eq 'сова') {
+		$msg->typing ();
+		$reply = owl ();
+		$msg->replyMd ($reply);
+		return;
+	} elsif (
+		substr ($text, 1) eq 'tits'  ||
+		substr ($text, 1) eq 'boobs'  ||
+		substr ($text, 1) eq 'tities'  ||
+		substr ($text, 1) eq 'boobies'  ||
+		substr ($text, 1) eq 'сиси'  ||
+		substr ($text, 1) eq 'сисечки'
+	) {
+		if (pluginEnabled $chatid, 'oboobs') {
+			$msg->typing ();
+			$reply = oboobs ();
+			sleep (irand (2) + 1);
+			$msg->replyMd ($reply);
+		}
+
+		return;
+	} elsif (
+		substr ($text, 1) eq 'butt'  ||
+		substr ($text, 1) eq 'booty'  ||
+		substr ($text, 1) eq 'ass'  ||
+		substr ($text, 1) eq 'попа'  ||
+		substr ($text, 1) eq 'попка'
+	) {
+		if (pluginEnabled $chatid, 'obutts') {
+			$msg->typing ();
+			$reply = obutts ();
+			sleep (irand (2) + 1);
+			$msg->replyMd ($reply);
+		}
+
+		return;
+	} elsif (substr ($text, 1) eq 'friday'  ||  substr ($text, 1) eq 'пятница') {
+		$reply = friday ();
+	} elsif (substr ($text, 1) eq 'fortune'  ||  substr ($text, 1) eq 'фортунка'  ||  substr ($text, 1) eq 'f'  ||  substr ($text, 1) eq 'ф') {
+		$reply = sprintf "```\n%s\n```\n", trim (fortune ());
+		$msg->replyMd ($reply);
+		return;
+	} elsif (substr ($text, 1) eq 'drink' || substr ($text, 1) eq 'праздник') {
+		$msg->typing ();
+		$reply = drink ();
+		sleep (irand (2) + 1);
+	} elsif (substr ($text, 1) eq 'dig' || substr ($text, 1) eq 'копать') {
+		$msg->typing ();
+		$reply = dig $highlight;
+		sleep (irand (2) + 1);
+		$msg->replyMd ($reply);
+		return;
+	} elsif (substr ($text, 1) eq 'fish' || substr ($text, 1) eq 'fishing' || substr ($text, 1) eq 'рыба' || substr ($text, 1) eq 'рыбка' || substr ($text, 1) eq 'рыбалка' ) {
+		$msg->typing ();
+		$reply = fish $highlight;
+		sleep (irand (2) + 1);
+		$msg->replyMd ($reply);
+		return;
+	} elsif (substr ($text, 1) eq 'help'  ||  substr ($text, 1) eq 'помощь') {
+		$reply = << "MYHELP";
+```
+${csign}help | ${csign}помощь             - список команд
+${csign}buni                       - рандомный стрип hapi buni
+${csign}bunny | ${csign}rabbit | ${csign}кролик  - кролик
+${csign}cat | ${csign}кис                 - кошечка
+${csign}dig | ${csign}копать              - заняться археологией
+${csign}drink | ${csign}праздник          - какой сегодня праздник?
+${csign}fish | ${csign}рыба | ${csign}рыбка      - порыбачить
+${csign}fishing | ${csign}рыбалка         - порыбачить
+${csign}f | ${csign}ф                     - рандомная фраза из сборника цитат fortune_mod
+${csign}fortune | ${csign}фортунка        - рандомная фраза из сборника цитат fortune_mod
+${csign}fox | ${csign}лис                 - лисичка
+${csign}friday | ${csign}пятница          - а не пятница ли сегодня?
+${csign}lat | ${csign}лат                 - сгенерить фразу из крылатых латинских выражений
+${csign}monkeyuser                 - рандомный стрип MonkeyUser
+${csign}owl | ${csign}сова                - сова
+${csign}ping | ${csign}пинг               - попинговать бота
+${csign}ver | ${csign}version | ${csign}версия   - что-то про версию ПО
+${csign}w город | ${csign}п город         - погода в указанном городе
+${csign}xkcd                       - рандомный стрип с сайта xkcd.ru
+${csign}karma фраза | ${csign}карма фраза - посмотреть карму фразы
+фраза-- | фраза++           - убавить или добавить карму фразе
+```
+Но на самом деле я бот больше для общения, чем для исполнения команд.
+Поговоришь со мной?
+MYHELP
+		$msg->replyMd ($reply);
+		return;
+	} elsif (substr ($text, 1) eq 'admin'  ||  substr ($text, 1) eq 'админ') {
+		my $member = $self->getChatMember ({ 'chat_id' => $msg->chat->id, 'user_id' => $msg->from->id });
+
+		# this msg should be shown only if admins of chat request it
+		if (($member->status eq 'administrator') || ($member->status eq 'creator')) {
+			$reply = << "MYADMIN";
+```
+${csign}admin censor type # - где 1 - вкл, 0 - выкл цензуры для означенного типа сообщений
+${csign}админ ценз тип #    - где 1 - вкл, 0 - выкл цензуры для означенного типа сообщений
+${csign}admin censor        - показать список состояния типов сообщений
+${csign}админ ценз          - показать список состояния типов сообщений
+${csign}admin fortune #     - где 1 - вкл, 0 - выкл фортунку с утра
+${csign}admin фортунка #    - где 1 - вкл, 0 - выкл фортунку с утра
+${csign}admin fortune       - показываем ли с утра фортунку для чата
+${csign}admin фортунка      - показываем ли с утра фортунку для чата
+${csign}admin oboobs #      - где 1 - вкл, 0 - выкл плагина oboobs
+${csign}admin oboobs        - показываем ли сисечки по просьбе участников чата (команды ${csign}tits, ${csign}tities, ${csign}boobs, ${csign}boobies, ${csign}сиси, ${csign}сисечки)
+${csign}admin obutts #      - где 1 - вкл, 0 - выкл плагина obutts
+${csign}admin obutts        - показываем ли попки по просьбе участников чата (команды ${csign}ass, ${csign}butt, ${csign}booty, ${csign}попа, ${csign}попка)
+```
+Типы сообщений:
+audio voice photo video animation sticker dice game poll document
+MYADMIN
+
+			$msg->replyMd ($reply);
+		}
+
+		return;
+	} elsif ((substr ($text, 1, 5) eq 'admin'  ||  substr ($text, 1, 5) eq 'админ') && (length ($text) >= 8)) {
+		my $member = $self->getChatMember ({ 'chat_id' => $msg->chat->id, 'user_id' => $msg->from->id });
+
+		# this msg should be shown only if admins of chat request it
+		if (($member->status eq 'administrator') || ($member->status eq 'creator')) {
+			my $command = trim (substr $text, 7);
+			my ($cmd, $args) = split /\s+/, $command, 2;
+
+			if ($cmd eq '') {
+				return;
+			} elsif ($cmd eq 'censor' || $cmd eq 'ценз') {
+				if (defined ($args) && ($args ne '')) {
+					my ($msgType, $toggle) = split /\s/, $args, 2;
+
+					if (defined $toggle) {
+						foreach (@forbiddenMessageTypes) {
+							if ($msgType eq $_) {
+								if ($toggle == 1) {
+									addForbiddenType ($chatid, $msgType);
+									$reply = "Теперь сообщения с $msgType будут автоматически удаляться";
+								} elsif ($toggle == 0) {
+									delForbiddenType ($chatid, $msgType);
+									$reply = "Теперь сообщения с $msgType будут оставаться";
+								}
+							}
+						}
+					}
+				} else {
+					$reply = listForbidden ($chatid);
+				}
+			} elsif ($cmd eq 'fortune' || $cmd eq 'фортунка') {
+				if (defined $args) {
+					if ($args == 1) {
+						$reply = fortune_toggle ($chatid, 1);
+					} elsif ($args == 0) {
+						$reply = fortune_toggle ($chatid, 0);
+					}
+				} else {
+					$reply = fortune_status ($chatid);
+				}
+			} elsif ($cmd eq 'oboobs') {
+				if (defined $args) {
+					if ($args == 1) {
+						$reply = plugin_toggle ($chatid, 'oboobs', 1);
+					} elsif ($args == 0) {
+						$reply = plugin_toggle ($chatid, 'oboobs', 0);
+					}
+				} else {
+					$reply = plugin_status ($chatid, 'oboobs');
+				}
+			} elsif ($cmd eq 'obutts') {
+				if (defined $args) {
+					if ($args == 1) {
+						$reply = plugin_toggle ($chatid, 'obutts', 1);
+					} elsif ($args == 0) {
+						$reply = plugin_toggle ($chatid, 'obutts', 0);
+					}
+				} else {
+					$reply = plugin_status ($chatid, 'obutts');
+				}
+			}
+		}
+	}
+
+	return $reply;
+}
+
+sub highlight {
+	my $msg = shift;
+
+	my $fullname;
+	my $highlight;
+	my $username;
+	my $visavi = '';
+	my $userid = $msg->from->id;
+
+	if ($msg->from->can ('username') && defined $msg->from->username ) {
+		$username = $msg->from->username;
+	}
+
+	if ($msg->from->can ('first_name') && defined $msg->from->first_name) {
+		$fullname = $msg->from->first_name;
+
+		if ($msg->from->can ('last_name') && defined $msg->from->last_name) {
+			$fullname .= ' ' . $msg->from->last_name;
+		}
+	} elsif ($msg->from->can ('last_name') && defined $msg->from->last_name) {
+		$fullname .= $msg->from->last_name;
+	}
+
+	if (defined $username) {
+		$visavi .= '@' . $username;
+
+		if (defined $fullname) {
+			$highlight = "[$fullname](tg://user?id=$userid)";
+			$visavi .= ', ' . $fullname;
+		} else {
+			$highlight = "[$username](tg://user?id=$userid)";
+		}
+	} else {
+		$highlight = "[$fullname](tg://user?id=$userid)";
+		$visavi .= $fullname;
+	}
+
+	$visavi .= " ($userid)";
+
+	return ($userid, $username, $fullname, $highlight, $visavi);
+}
+
+sub botsleep {
+	# TODO: Parametrise this with fuzzy sleep time in seconds
+	my $msg = shift;
+	# let's emulate real human and delay answer
+	sleep (irand (2) + 1);
+
+	for (0..(4 + irand (3))) {
+		$msg->typing ();
+		sleep 3;
+		sleep 3 unless ($_);
+	}
+
+	sleep ( 3 + irand (2));
+	return;
+}
+
+sub isCensored {
+	my $msg = shift;
+
+	my $forbidden = getForbiddenTypes ($msg->chat->id);
+
+	# voice messages are special
+	if (defined ($msg->voice) && defined ($msg->voice->duration) && ($msg->voice->duration > 0)) {
+		if ($forbidden->{'voice'}) {
+			return 1;
+		}
+	}
+
+	foreach (keys %{$forbidden}) {
+		if ($forbidden->{$_} && (defined $msg->{$_})) {
+			return 1;
+		}
+	}
+
+	return 0;
 }
 
 1;

lib/buni.pm

@@ -0,0 +1,58 @@
+package buni;
+
+use 5.018;
+use strict;
+use warnings;
+use utf8;
+use open qw (:std :utf8);
+use English qw ( -no_match_vars );
+use Carp qw (cluck);
+use HTML::TokeParser;
+use Mojo::UserAgent;
+
+use version; our $VERSION = qw (1.0);
+use Exporter qw (import);
+our @EXPORT_OK = qw (buni);
+
+sub buni {
+	my $r;
+	my $ret = 'Нету Buni';
+
+	for (1..3) {
+		my $ua  = Mojo::UserAgent->new->connect_timeout (3);
+		$r = $ua->get ('http://www.bunicomic.com/?random&nocache=1')->result;
+
+		if ($r->is_success) {
+			last;
+		}
+
+		sleep 2;
+	}
+
+	if ($r->is_success) {
+		my $p = HTML::TokeParser->new(\$r->body);
+		my @a;
+
+		# additional {} required in order "last" to work properly :)
+		{
+			do {
+				$#a = -1;
+				@a = $p->get_tag('meta'); ## no critic (Variables::RequireLocalizedPunctuationVars)
+
+				if (defined $a[0][1]->{property} && $a[0][1]->{property} eq 'og:image') {
+					$ret = sprintf '[buni](%s)', $a[0][1]->{content};
+					last;
+				}
+
+			} while ($#{$a[0]} > 1);
+		}
+	} else {
+		cluck sprintf 'Server return status %s with message: %s', $r->code, $r->message;
+	}
+
+	return $ret;
+}
+
+1;
+
+# vim: set ft=perl noet ai ts=4 sw=4 sts=4:

lib/conf.pm

@@ -5,32 +5,29 @@ use 5.018;
 use strict;
 use warnings;
 use utf8;
-use open qw(:std :utf8);
-use English qw( -no_match_vars );
-
-use vars qw/$VERSION/;
+use open qw (:std :utf8);
+use English qw ( -no_match_vars );
 use JSON::XS;
 
-use Exporter qw(import);
-our @EXPORT_OK = qw(loadConf);
-
-$VERSION = '1.0';
+use version; our $VERSION = qw (1.0);
+use Exporter qw (import);
+our @EXPORT_OK = qw (loadConf);
 
 sub loadConf {
 	my $c = 'data/config.json';
-	open my $CH, '<', $c or die "[FATA] No conf at $c: $OS_ERROR\n";
-	my $len = (stat ($c)) [7];
+	open my $CH, '<', $c or die "[FATAL] No conf at $c: $OS_ERROR\n";
+	my $len = (stat $c) [7];
 	my $json;
 	my $readlen = read $CH, $json, $len;
 
 	unless ($readlen) {
 		close $CH;                                   ## no critic (InputOutput::RequireCheckedSyscalls
-		die "[FATA] Unable to read $c: $OS_ERROR\n";
+		die "[FATAL] Unable to read $c: $OS_ERROR\n";
 	}
 
 	if ($readlen != $len) {
 		close $CH;                                   ## no critic (InputOutput::RequireCheckedSyscalls
-		die "[FATA] File $c is $len bytes on disk, but we read only $readlen bytes\n";
+		die "[FATAL] File $c is $len bytes on disk, but we read only $readlen bytes\n";
 	}
 
 	close $CH;                                       ## no critic (InputOutput::RequireCheckedSyscalls

lib/drink.pm

@@ -0,0 +1,111 @@
+package drink;
+
+use 5.018;
+use strict;
+use warnings;
+use utf8;
+use open qw (:std :utf8);
+use CHI;
+use CHI::Driver::BerkeleyDB;
+use DateTime;
+use English qw ( -no_match_vars );
+use Encode;
+use Carp qw (cluck);
+use HTML::TokeParser;
+use Mojo::Log;
+use Mojo::UserAgent::Cached;
+use POSIX qw (strftime);
+
+use version; our $VERSION = qw (1.0);
+use Exporter qw (import);
+our @EXPORT_OK = qw (drink);
+
+my @MONTH = qw (yanvar fevral mart aprel may iyun iyul avgust sentyabr oktyabr noyabr dekabr);
+
+sub drink {
+	my $r;
+	my $ret = 'Не знаю праздников - вджобываю весь день на шахтах, как проклятая.';
+	my ($dayNum, $monthNum) = (localtime ())[3, 4];
+	my $url = sprintf 'https://kakoysegodnyaprazdnik.ru/baza/%s/%s', $MONTH[$monthNum], $dayNum;
+
+	# Those POSIX assholes just forgot to add unix timestamps without TZ offset, so...
+	my ($mday, $mon, $year) = (gmtime ())[3, 4, 5];
+	my $offset = strftime ('%z', gmtime ());
+	my $offsetMinutes = (substr $offset, -2) * 60;
+	my $offsetHours = (substr $offset, 1, 2) * 60 * 60;
+	my $offsetSign;
+
+	if ((substr $offset, 0, 1) eq '+') {
+		$offsetSign = 1;
+	}
+
+	my $expirationDate = DateTime->new (
+		year => $year + 1900,
+		month => $mon + 1,
+		day => $mday,
+		hour => 0,
+		minute => 0,
+		second => 0
+	)->add (days => 1)->strftime ('%s');
+
+	if ((substr $offset, 0, 1) eq '+') {
+		$expirationDate = $expirationDate - $offsetHours - $offsetMinutes;
+	} else {
+		$expirationDate = $expirationDate + $offsetHours + $offsetMinutes;
+	}
+
+	for (1..3) {
+		my $ua = Mojo::UserAgent::Cached->new->connect_timeout (3);
+		$ua->cache_agent(
+				CHI->new (
+				driver             => 'BerkeleyDB',
+				root_dir           => 'data/cache',
+				namespace          => __PACKAGE__,
+				expires_at         => $expirationDate,
+				expires_on_backend => 1,
+			)
+		);
+		# just to make Mojo::UserAgent::Cached happy
+		$ua->logger (Mojo::Log->new (path => '/dev/null', level => 'error'));
+		$r = $ua->get ($url => {'Accept-Language' => 'ru-RU', 'Accept-Charset' => 'utf-8'})->result;
+
+		if ($r->is_success) {
+			last;
+		}
+
+		sleep 2;
+	}
+
+	if ($r->is_success) {
+		my $p = HTML::TokeParser->new(\$r->body);
+		my @a;
+		my @holyday;
+
+		do {
+			$#a = -1;
+			@a = $p->get_tag('span'); ## no critic (Variables::RequireLocalizedPunctuationVars)
+
+			if ($#{$a[0]} > 2 && defined $a[0][1]->{itemprop} && $a[0][1]->{itemprop} eq 'text') {
+				push @holyday,'* ' . decode ('UTF-8', $p->get_trimmed_text ('/span'));
+			}
+
+		} while ($#{$a[0]} > 1);
+
+		if ($#holyday > 0) {
+			# cut off something weird, definely not a "holyday"
+			$#holyday = $#holyday - 1;
+		}
+
+		if ($#holyday > 0) {
+			$ret = join "\n", @holyday;
+		}
+	} else {
+		cluck sprintf 'Server return status %s with message: %s', $r->code, $r->message;
+	}
+
+	return $ret;
+}
+
+1;
+
+# vim: set ft=perl noet ai ts=4 sw=4 sts=4:

lib/fisher.pm

@@ -0,0 +1,133 @@
+package fisher;
+
+use 5.018;
+use strict;
+use warnings;
+use utf8;
+use open qw (:std :utf8);
+use English qw ( -no_match_vars );
+use Math::Random::Secure qw (irand);
+
+use version; our $VERSION = qw (1.0);
+use Exporter qw (import);
+our @EXPORT_OK = qw (fish);
+
+
+sub fish {
+	my $name = shift;
+
+	my @artifact = (
+		'семикрылого чешуйчатого пятихуя',
+		'разумного конденсатора',
+		'сальмонеллу',
+		'селёдку',
+		'желтоперого тунца',
+		'розовую сальмонеллу',
+		'голавля',
+		'барбуса',
+		'окуня',
+		'верхоплавку',
+		'коричневую форель',
+		'полярника',
+		'плотву',
+		'зубатку',
+		'солнечную рыбу',
+		'старую шину',
+		'скользкую корягу',
+		'лампу джина',
+		'любовное послание в бутылке',
+		'старое бревно',
+		'резиновый сапог',
+		'труп',
+		'Лох-Несское чудовище',
+		'старую рыбацкую приманку',
+		'кусок Титаника',
+		'обломок Атлантиды',
+		'кита',
+		'кальмара',
+		'дельфина',
+		'ската',
+		'подводную лодку',
+		'медузу',
+		'морскую звезду',
+		'электрического угря',
+		'большую белую акулу',
+		'аквалангиста',
+		'монстра',
+		'вируса',
+		'сырую пачку сигарет',
+		'водоросли',
+		'якорь от лодки',
+		'водяного',
+		'русалку',
+		'палтуса',
+		'труп собаки по кличке Беня',
+		'олигофрена Проню',
+		'огеймера Фишкина',
+	);
+
+	my @location = (
+		'в поток',
+		'в озеро',
+		'в реку',
+		'в северный ледовитый океан',
+		'в индийский океан',
+		'в биде',
+		'в детский плавательный бассейн',
+		'в туалет',
+		'в кучу рвоты',
+		'в лужу мочи',
+		'в раковину',
+		'в слив ванной',
+		'в лужу грязи',
+		'в ведро воды',
+		'в бутылку с водкой',
+		'в ванную',
+		'в бочку с дождевой водой',
+		'в аквариум',
+		'в сугроб',
+		'в водопад',
+		'в чашку кофе',
+		'в стакан молока',
+		'в черную дыру',
+		'дно Удомельского реактора',
+		'на Марс',
+		'в соседнюю галактику',
+		'к соседу на балкон',
+		'далеко-далеко',
+		'далеко и надолго',
+		'на крышу дома',
+	);
+
+	my @material = (
+		'бамбуковую',
+		'фибергласовую',
+		'карбоновую',
+		'композитную',
+	);
+
+	my $find_probability = irand 100;
+	my $success_probability = irand 100;
+	my $weight = irand 7000;
+
+	my $phrase = sprintf "Вы забрасываете %s удочку %s.\nВы чувствуете поклёвку и начинаете быстро тащить что-то.\n", $material[irand ($#material + 1)], $location[irand ($#location + 1)];
+
+	if ($find_probability <= 20) {
+		$phrase .= sprintf 'Черт, твоя рыбка сорвалась, %s! Не беда, может потом повезет?', $name;
+		return $phrase;
+	}
+
+	$phrase .= sprintf "Поздравляю, %s! Вы только что поймали %s! аж на %d кило!\n\n", $name, $artifact[irand ($#artifact + 1)], $weight;
+
+	if ($success_probability <= 25) {
+		$phrase .= sprintf 'Ё-мое!!! А это ведь новый рекорд! Продолжай в том же духе, %s!', $name;
+	} else {
+		$phrase .= sprintf 'Извини, %s, но это не новый рекорд! Однако, хорошая попытка!', $name;
+	}
+
+	return $phrase;
+}
+
+1;
+
+# vim: set ft=perl noet ai ts=4 sw=4 sts=4:

lib/flickr.pm

@@ -0,0 +1,634 @@
+package flickr;
+
+use 5.018;
+use strict;
+use warnings;
+use utf8;
+use open qw (:std :utf8);
+use English qw ( -no_match_vars );
+use Carp qw (cluck);
+use Digest::HMAC_SHA1 qw (hmac_sha1);
+use File::Path qw (make_path);
+use Math::Random::Secure qw (irand);
+use MIME::Base64;
+use Mojo::UserAgent;
+use SQLite_File;
+use URI::Encode::XS qw (uri_encode);
+
+use conf qw (loadConf);
+use util qw (urlencode);
+
+use Data::Dumper;
+
+use version; our $VERSION = qw (1.0);
+use Exporter qw (import);
+our @EXPORT_OK = qw (flickr_init flickr_by_tags flickr_by_text flickr_test_login);
+
+my $c = loadConf ();
+my $dir = $c->{image}->{dir};
+
+my $flickr_consumer_key      = $c->{image}->{flickr}->{consumer_key};
+my $flickr_consumer_secret   = $c->{image}->{flickr}->{consumer_secret};
+my $flickr_verifier          = $c->{image}->{flickr}->{verifier};
+my $flickr_request_token_url = 'https://www.flickr.com/services/oauth/request_token';
+my $flickr_authorization_url = 'https://www.flickr.com/services/oauth/authorize';
+my $flickr_access_token_url  = 'https://www.flickr.com/services/oauth/access_token';
+my $flickr_callback_url      = 'http://www.example.com';
+my $flickr_api_url           = 'https://www.flickr.com/services/rest/';
+
+sub mknonce {
+	# make random number, 8 symbols in length
+	my $nonce = sprintf '%08d', irand (99999999);
+	return $nonce;
+}
+
+sub flickerSignReq {
+	my %p = @_;
+	my $string;
+	my $hmac;
+
+	if ($p{type} eq 'request_token') {
+		my @parameters;
+		delete $p{type};
+		push @parameters, 'oauth_signature_method=HMAC-SHA1';
+		push @parameters, 'oauth_version=1.0';
+		push @parameters, sprintf 'oauth_callback=%s', uri_encode ($flickr_callback_url);
+		push @parameters, sprintf 'oauth_consumer_key=%s', $flickr_consumer_key;
+
+		foreach my $param (keys %p) {
+			push @parameters, sprintf ('%s=%s', $param, $p{$param});
+		}
+
+		$string = sprintf 'GET&%s&', uri_encode ($flickr_request_token_url);
+		$string .= uri_encode (join '&', sort (@parameters));
+		# Thanks to twitter api dev portal, they explain this particular case: while we requesting this token
+		# we do not yet know access_token secret, so we just omit it in this signature
+		# https://developer.twitter.com/en/docs/authentication/oauth-1-0a/creating-a-signature
+		$hmac = Digest::HMAC_SHA1->new (sprintf '%s&', uri_encode ($flickr_consumer_secret));
+	} elsif ($p{type} eq 'access_token') {
+		my @parameters;
+		my $flickr_request_token_secret = $p{oauth_token_secret};
+		delete $p{oauth_token_secret};
+		delete $p{type};
+		push @parameters, 'oauth_signature_method=HMAC-SHA1';
+		push @parameters, 'oauth_version=1.0';
+		push @parameters, sprintf 'oauth_consumer_key=%s', $flickr_consumer_key;
+
+		foreach my $param (keys %p) {
+			push @parameters, sprintf ('%s=%s', $param, $p{$param});
+		}
+
+		$string = sprintf 'GET&%s&', uri_encode ($flickr_access_token_url);
+		$string .= uri_encode (join '&', sort (@parameters));
+		$hmac = Digest::HMAC_SHA1->new (sprintf '%s&%s', uri_encode ($flickr_consumer_secret), uri_encode ($flickr_request_token_secret));
+	} elsif ($p{type} eq 'test_login' || $p{type} eq 'search_text' ||  $p{type} eq 'search_tags') {
+		my @parameters;
+		my $flickr_request_token_secret = $p{oauth_token_secret};
+		delete $p{oauth_token_secret};
+		delete $p{type};
+
+		foreach my $param (keys %p) {
+			push @parameters, sprintf ('%s=%s', $param, $p{$param});
+		}
+
+		$string = sprintf 'GET&%s&', uri_encode ($flickr_api_url);
+		$string .= uri_encode (join '&', sort (@parameters));
+		$hmac = Digest::HMAC_SHA1->new (sprintf '%s&%s', uri_encode ($flickr_consumer_secret), uri_encode ($flickr_request_token_secret));
+	}
+
+	$hmac->add ($string);
+	return encode_base64 ($hmac->digest, '');
+}
+
+sub flickrRequestToken {
+	my $oauth_timestamp = time ();
+	my $oauth_nonce = mknonce ();
+
+	my $oauth_signature = flickerSignReq (
+		type => 'request_token',
+		oauth_timestamp => $oauth_timestamp,
+		oauth_nonce => $oauth_nonce
+	);
+
+	my $url = $flickr_request_token_url . sprintf (
+		'?oauth_nonce=%s&oauth_timestamp=%s&oauth_consumer_key=%s&oauth_signature_method=HMAC-SHA1&oauth_version=1.0&&oauth_signature=%s&oauth_callback=%s',
+		$oauth_nonce,
+		$oauth_timestamp,
+		$flickr_consumer_key,
+		uri_encode ($oauth_signature),
+		uri_encode ($flickr_callback_url)
+	);
+
+	my $ua = Mojo::UserAgent->new->connect_timeout (5);
+	my $r = $ua->get ($url)->result;
+	my %params;
+
+	if ($r->is_success) {
+		# they ignore format=json, so...
+		%params = map {split /=/} split /&/, $r->body;
+	} else {
+		say "Something bad returns from flickr api: $r->code $r->message"; ## no critic (InputOutput::RequireCheckedSyscalls)
+	}
+
+	return %params;
+}
+
+sub flickrAccessToken {
+	my $flickr_request_token = shift;
+	my $flickr_request_token_secret = shift;
+	my $flickr_verifier = shift; ## no critic (Variables::ProhibitReusedNames)
+
+	my $oauth_timestamp = time ();
+	my $oauth_nonce = mknonce ();
+
+	my $oauth_signature = flickerSignReq (
+		type => 'access_token',
+		oauth_timestamp => $oauth_timestamp,
+		oauth_nonce => $oauth_nonce,
+		oauth_token => $flickr_request_token,
+		oauth_token_secret => $flickr_request_token_secret,
+		oauth_verifier => $flickr_verifier
+	);
+
+	my $url = $flickr_access_token_url . sprintf (
+		'?oauth_nonce=%s&oauth_timestamp=%s&oauth_verifier=%s&oauth_consumer_key=%s&oauth_signature_method=HMAC-SHA1&oauth_version=1.0&oauth_token=%s&oauth_signature=%s',
+		$oauth_nonce,
+		$oauth_timestamp,
+		$flickr_verifier,
+		$flickr_consumer_key,
+		$flickr_request_token,
+		uri_encode ($oauth_signature)
+	);
+
+	my $ua  = Mojo::UserAgent->new->connect_timeout (5);
+	my $r = $ua->get ($url)->result;
+	my %params;
+
+	if ($r->is_success) {
+		# they ignore format=json
+		%params = map {split /=/} split /&/, $r->body;
+	} else {
+		say "Something bad returns from flickr api: $r->code $r->message"; ## no critic (InputOutput::RequireCheckedSyscalls)
+	}
+
+	return %params;
+}
+
+sub flickrAuthorization {
+	my $flickr_request_token = shift;
+
+	my $url = $flickr_authorization_url . sprintf (
+		'?oauth_token=%s&perms=read',
+		$flickr_request_token,
+	);
+
+	my $ua = Mojo::UserAgent->new->connect_timeout (5);
+	my $r = $ua->get ($url)->result;
+
+	if ($r->is_success) {
+		return $r->url;
+	} else {
+		say "Something went wrong: $r->code $r->message"; ## no critic (InputOutput::RequireCheckedSyscalls)
+		return;
+	}
+}
+
+sub flickrTestLogin {
+	my $flickr_access_token = shift;
+	my $flickr_access_token_secret = shift;
+
+	my $oauth_timestamp = time ();
+	my $oauth_nonce = mknonce ();
+
+	my $oauth_signature = flickerSignReq (
+		nojsoncallback => 1,
+		oauth_nonce => $oauth_nonce,
+		format => 'json',
+		oauth_consumer_key => $flickr_consumer_key,
+		oauth_timestamp => $oauth_timestamp,
+		type => 'test_login',
+		method => 'flickr.test.login',
+		oauth_token => $flickr_access_token,
+		oauth_token_secret => $flickr_access_token_secret,
+		oauth_signature_method => 'HMAC-SHA1',
+		oauth_version => '1.0'
+	);
+
+	my $url = $flickr_api_url . sprintf (
+		'?nojsoncallback=1&oauth_nonce=%s&format=json&oauth_consumer_key=%s&oauth_timestamp=%s&oauth_signature_method=HMAC-SHA1&oauth_version=1.0&oauth_token=%s&oauth_signature=%s&method=flickr.test.login',
+		$oauth_nonce,
+		$flickr_consumer_key,
+		$oauth_timestamp,
+		$flickr_access_token,
+		uri_encode ($oauth_signature)
+	);
+
+	my $ua = Mojo::UserAgent->new->connect_timeout (5);
+	my $r = $ua->get ($url)->result;
+
+	if ($r->is_success) {
+		my $response = eval {
+			return $r->json;
+		};
+
+		if (defined $response) {
+			say Dumper $response; ## no critic (InputOutput::RequireCheckedSyscalls)
+			return 1;
+		} else {
+			say "Flickr api returns incorrect json: $r->message"; ## no critic (InputOutput::RequireCheckedSyscalls)
+			return 0;
+		}
+	} else {
+		say "HTTP status code not 200: $r->code, $r->message"; ## no critic (InputOutput::RequireCheckedSyscalls)
+		return 0;
+	}
+}
+
+sub flickrSearchByText {
+	my $flickr_access_token = shift;
+	my $flickr_access_token_secret = shift;
+	my $text = shift;
+
+	my $oauth_timestamp = time ();
+	my $oauth_nonce = mknonce ();
+
+	my $oauth_signature = flickerSignReq (
+		nojsoncallback => 1,
+		oauth_nonce => $oauth_nonce,
+		format => 'json',
+		oauth_consumer_key => $flickr_consumer_key,
+		oauth_timestamp => $oauth_timestamp,
+		type => 'search_text',
+		content_type => 1,
+		media => 'photos',
+		method => 'flickr.photos.search',
+		text => $text,
+		per_page => 1,
+		oauth_token => $flickr_access_token,
+		oauth_token_secret => $flickr_access_token_secret,
+		oauth_signature_method => 'HMAC-SHA1',
+		oauth_version => '1.0'
+	);
+
+	my $url = $flickr_api_url . sprintf (
+		'?nojsoncallback=1&oauth_nonce=%s&format=json&oauth_consumer_key=%s&oauth_timestamp=%s&oauth_signature_method=HMAC-SHA1&oauth_version=1.0&oauth_token=%s&oauth_signature=%s&method=flickr.photos.search&content_type=1&media=photos&per_page=1&text=%s',
+		$oauth_nonce,
+		$flickr_consumer_key,
+		$oauth_timestamp,
+		$flickr_access_token,
+		uri_encode ($oauth_signature),
+		uri_encode ($text)
+	);
+
+	my $ua = Mojo::UserAgent->new->connect_timeout (5);
+	my $r = $ua->get ($url)->result;
+
+	if ($r->is_success) {
+		my $response = eval {
+			return $r->json;
+		};
+
+		if (defined $response) {
+			# lets make another query, this time with random picture
+			my $page = irand int ($response->{photos}->{total} / 500);
+			$oauth_timestamp = time ();
+			$oauth_nonce = mknonce ();
+			$oauth_signature = flickerSignReq (
+				nojsoncallback => 1,
+				oauth_nonce => $oauth_nonce,
+				format => 'json',
+				oauth_consumer_key => $flickr_consumer_key,
+				oauth_timestamp => $oauth_timestamp,
+				type => 'search_text',
+				content_type => 1,
+				media => 'photos',
+				method => 'flickr.photos.search',
+				text => $text,
+				page => $page,
+				per_page => 500,
+				oauth_token => $flickr_access_token,
+				oauth_token_secret => $flickr_access_token_secret,
+				oauth_signature_method => 'HMAC-SHA1',
+				oauth_version => '1.0'
+			);
+
+			$url = $flickr_api_url . sprintf (
+				'?nojsoncallback=1&oauth_nonce=%s&format=json&oauth_consumer_key=%s&oauth_timestamp=%s&oauth_signature_method=HMAC-SHA1&oauth_version=1.0&oauth_token=%s&oauth_signature=%s&method=flickr.photos.search&content_type=1&media=photos&per_page=500&page=%d&text=%s',
+				$oauth_nonce,
+				$flickr_consumer_key,
+				$oauth_timestamp,
+				$flickr_access_token,
+				uri_encode ($oauth_signature),
+				$page,
+				uri_encode ($text)
+			);
+
+			$ua = Mojo::UserAgent->new->connect_timeout (5);
+			$r = $ua->get ($url)->result;
+
+
+			if ($r->is_success) {
+				$response = eval {
+					return $r->json;
+				};
+
+				if (defined $response) {
+					return $response;
+				} else {
+					cluck "Flickr api returns incorrect json: $r->message";
+					return undef;
+				}
+			} else {
+				cluck "Flickr api returns incorrect json: $r->message";
+				return undef;
+			}
+		} else {
+			cluck "Flickr api returns incorrect json: $r->message";
+			return undef;
+		}
+	} else {
+		cluck "HTTP status code not 200: $r->code, $r->message";
+		return undef;
+	}
+}
+
+sub flickrSearchByTags {
+	my $flickr_access_token = shift;
+	my $flickr_access_token_secret = shift;
+	my $tags = shift;
+
+	my $oauth_timestamp = time ();
+	my $oauth_nonce = mknonce ();
+
+	my $oauth_signature = flickerSignReq (
+		nojsoncallback => 1,
+		oauth_nonce => $oauth_nonce,
+		format => 'json',
+		oauth_consumer_key => $flickr_consumer_key,
+		oauth_timestamp => $oauth_timestamp,
+		type => 'search_tags',
+		content_type => 1,
+		media => 'photos',
+		method => 'flickr.photos.search',
+		tags => $tags,
+		per_page => 1,
+		oauth_token => $flickr_access_token,
+		oauth_token_secret => $flickr_access_token_secret,
+		oauth_signature_method => 'HMAC-SHA1',
+		oauth_version => '1.0'
+	);
+
+	my $url = $flickr_api_url . sprintf (
+		'?nojsoncallback=1&oauth_nonce=%s&format=json&oauth_consumer_key=%s&oauth_timestamp=%s&oauth_signature_method=HMAC-SHA1&oauth_version=1.0&oauth_token=%s&oauth_signature=%s&method=flickr.photos.search&content_type=1&media=photos&per_page=1&tags=%s&tag_mode=all',
+		$oauth_nonce,
+		$flickr_consumer_key,
+		$oauth_timestamp,
+		$flickr_access_token,
+		uri_encode ($oauth_signature),
+		uri_encode ($tags)
+	);
+
+	my $ua = Mojo::UserAgent->new->connect_timeout (5);
+	my $r = $ua->get ($url)->result;
+
+	if ($r->is_success) {
+		my $response = eval {
+			return $r->json;
+		};
+
+		if (defined $response) {
+			# lets make another query, this time with random picture
+			my $page = irand int ($response->{photos}->{total} / 500);
+			$oauth_timestamp = time ();
+			$oauth_nonce = mknonce ();
+			$oauth_signature = flickerSignReq (
+				nojsoncallback => 1,
+				oauth_nonce => $oauth_nonce,
+				format => 'json',
+				oauth_consumer_key => $flickr_consumer_key,
+				oauth_timestamp => $oauth_timestamp,
+				type => 'search_text',
+				content_type => 1,
+				media => 'photos',
+				method => 'flickr.photos.search',
+				tags => $tags,
+				page => $page,
+				per_page => 500,
+				oauth_token => $flickr_access_token,
+				oauth_token_secret => $flickr_access_token_secret,
+				oauth_signature_method => 'HMAC-SHA1',
+				oauth_version => '1.0'
+			);
+
+			$url = $flickr_api_url . sprintf (
+				'?nojsoncallback=1&oauth_nonce=%s&format=json&oauth_consumer_key=%s&oauth_timestamp=%s&oauth_signature_method=HMAC-SHA1&oauth_version=1.0&oauth_token=%s&oauth_signature=%s&method=flickr.photos.search&content_type=1&media=photos&per_page=500&page=%d&tags=%s&tag_mode=all',
+				$oauth_nonce,
+				$flickr_consumer_key,
+				$oauth_timestamp,
+				$flickr_access_token,
+				uri_encode ($oauth_signature),
+				$page,
+				uri_encode ($tags)
+			);
+
+			$ua = Mojo::UserAgent->new->connect_timeout (5);
+			$r = $ua->get ($url)->result;
+
+			if ($r->is_success) {
+				$response = eval {
+					return $r->json;
+				};
+
+				if (defined $response) {
+					return $response;
+				} else {
+					cluck "Flickr api returns incorrect json: $r->message";
+					return undef;
+				}
+			} else {
+				cluck "Flickr api returns incorrect json: $r->message";
+				return undef;
+			}
+		} else {
+			cluck "Flickr api returns incorrect json: $r->message";
+			return undef;
+		}
+	} else {
+		cluck "HTTP status code not 200: $r->code, $r->message";
+		return undef;
+	}
+}
+
+sub flickr_init {
+	my $backingfile = sprintf '%s/secrets.sqlite', $dir;
+
+	unless (-d $dir) {
+		make_path ($dir) or do {
+			say "Unable to create $dir: $OS_ERROR"; ## no critic (InputOutput::RequireCheckedSyscalls)
+			return 0;
+		};
+	}
+
+	tie my %secret, 'SQLite_File', $backingfile  ||  do {
+		say "[ERROR] Unable to tie to $backingfile: $OS_ERROR"; ## no critic (InputOutput::RequireCheckedSyscalls)
+		return 0;
+	};
+
+	if (defined $flickr_verifier && $flickr_verifier) {
+		my $flickr_request_token = $secret{flickr_request_token};
+		my $flickr_request_token_secret = $secret{flickr_request_token_secret};
+
+		unless (defined $flickr_request_token || defined $flickr_request_token_secret) {
+			say "Looks like there is no request token or request token secret in $backingfile"; ## no critic (InputOutput::RequireCheckedSyscalls)
+			say 'Please remove verifier settings from config.json and run this script again';   ## no critic (InputOutput::RequireCheckedSyscalls)
+			untie %secret;
+			return 0;
+		}
+
+		my %accessToken = flickrAccessToken ($flickr_request_token, $flickr_request_token_secret, $flickr_verifier);
+
+		if (defined ($accessToken{oauth_token}) && defined ($accessToken{oauth_token_secret})) {
+			$secret{flickr_access_token} = $accessToken{oauth_token};
+			$secret{flickr_access_token_secret} = $accessToken{oauth_token_secret};
+
+			say sprintf ( ## no critic (InputOutput::RequireCheckedSyscalls)
+				'Access token (%s) and access token secret (%s) are in %s',
+				$accessToken{oauth_token},
+				$accessToken{oauth_token_secret},
+				$backingfile
+			);
+
+			untie %secret;
+			return 1;
+		}
+	} else {
+		my %req = flickrRequestToken ();
+		if (defined ($req{oauth_token}) && defined ($req{oauth_token_secret}) && defined ($req{oauth_token})) {
+			$secret{flickr_request_token} = $req{oauth_token};
+			$secret{flickr_request_token_secret} = $req{oauth_token_secret};
+			my $confirm_url = flickrAuthorization ($req{oauth_token});
+
+			if (defined $confirm_url) {
+				say "Please open this url in your browser and grant access for this app:\n$confirm_url"; ## no critic (InputOutput::RequireCheckedSyscalls)
+				say 'Do not forget to put oauth_verifier to config.json file and re-run this script to get access token'; ## no critic (InputOutput::RequireCheckedSyscalls)
+				say 'Note that you should be logged off from flickr account.'; ## no critic (InputOutput::RequireCheckedSyscalls)
+				untie %secret;
+				return 1;
+			}
+		}
+	}
+
+	untie %secret;
+	return 0;
+}
+
+sub flickr_test_login {
+	my $text = shift;
+	my $backingfile = sprintf '%s/secrets.sqlite', $dir;
+
+	unless (-d $dir) {
+		make_path ($dir) or do {
+			say "Unable to create $dir: $OS_ERROR"; ## no critic (InputOutput::RequireCheckedSyscalls)
+			return 0;
+		};
+	}
+
+	tie my %secret, 'SQLite_File', $backingfile  ||  do {
+		say "[ERROR] Unable to tie to $backingfile: $OS_ERROR"; ## no critic (InputOutput::RequireCheckedSyscalls)
+		return 0;
+	};
+
+	my $flickr_access_token = $secret{flickr_access_token};
+	my $flickr_access_token_secret = $secret{flickr_access_token_secret};
+	untie %secret;
+
+	if (flickrTestLogin ($flickr_access_token, $flickr_access_token_secret)) {
+		return 1;
+	} else {
+		return 0;
+	}
+}
+
+sub flickr_by_tags {
+	my $text = shift;
+	my $backingfile = sprintf '%s/secrets.sqlite', $dir;
+
+	unless (-d $dir) {
+		make_path ($dir) or do {
+			say "Unable to create $dir: $OS_ERROR"; ## no critic (InputOutput::RequireCheckedSyscalls)
+			return 0;
+		};
+	}
+
+	tie my %secret, 'SQLite_File', $backingfile  ||  do {
+		say "[ERROR] Unable to tie to $backingfile: $OS_ERROR"; ## no critic (InputOutput::RequireCheckedSyscalls)
+		return 0;
+	};
+
+	my $flickr_access_token = $secret{flickr_access_token};
+	my $flickr_access_token_secret = $secret{flickr_access_token_secret};
+	untie %secret;
+
+	# NB: I honestly query random page (among number of pages) of results from api, but always got first page,
+	# no matter what is shown in response' "page" parameter. Looks like bug in API. Try to little bit mitigate
+	# this bug via query 500 results per page, then we can select random result in this heap. But anyway, let's
+	# make this thing future proof and leave randomizer in page select.
+	my $result = flickrSearchByTags ($flickr_access_token, $flickr_access_token_secret, $text);
+
+	if ($result) {
+		if (defined ($result->{photos}) && defined ($result->{photos}->{photo})) {
+			my $item = irand int(@{$result->{photos}->{photo}});
+			$item = ${$result->{photos}->{photo}}[$item];
+			$item = sprintf 'https://live.staticflickr.com/%s/%s_%s_z.jpg', $item->{server}, $item->{id}, $item->{secret};
+			return $item;
+		} else {
+			cluck 'Flickr api returns empty search result list';
+			return;
+		}
+	} else {
+		return;
+	}
+}
+
+sub flickr_by_text {
+	my $text = shift;
+	my $backingfile = sprintf '%s/secrets.sqlite', $dir;
+
+	unless (-d $dir) {
+		make_path ($dir) or do {
+			say "Unable to create $dir: $OS_ERROR"; ## no critic (InputOutput::RequireCheckedSyscalls)
+			return 0;
+		};
+	}
+
+	tie my %secret, 'SQLite_File', $backingfile  ||  do {
+		say "[ERROR] Unable to tie to $backingfile: $OS_ERROR"; ## no critic (InputOutput::RequireCheckedSyscalls)
+		return 0;
+	};
+
+	my $flickr_access_token = $secret{flickr_access_token};
+	my $flickr_access_token_secret = $secret{flickr_access_token_secret};
+	untie %secret;
+
+	# NB: I honestly query random page (among number of pages) of results from api, but always got first page,
+	# no matter what is shown in response' "page" parameter. Looks like bug in API. Try to little bit mitigate
+	# this bug via query 500 results per page, then we can select random result in this heap. But anyway, let's
+	# make this thing future proof and leave randomizer in page select.
+	my $result = flickrSearchByText ($flickr_access_token, $flickr_access_token_secret, $text);
+
+	if ($result) {
+		if (defined ($result->{photos}) && defined ($result->{photos}->{photo})) {
+			my $item = irand int(@{$result->{photos}->{photo}});
+			$item = ${$result->{photos}->{photo}}[$item];
+			$item = sprintf 'https://live.staticflickr.com/%s/%s_%s_z.jpg', $item->{server}, $item->{id}, $item->{secret};
+			return $item;
+		} else {
+			cluck 'Flickr api returns empty search result list';
+			return;
+		}
+	} else {
+		return;
+	}
+}
+
+1;

lib/fortune.pm

@@ -0,0 +1,85 @@
+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 File::Path qw (make_path);
+use Math::Random::Secure qw (irand);
+use SQLite_File;
+use conf qw (loadConf);
+
+use version; our $VERSION = qw (1.0);
+use Exporter qw (import);
+our @EXPORT_OK = qw (seed fortune);
+
+my $c = loadConf ();
+my $dir = $c->{fortune}->{dir};
+my $srcdir = $c->{fortune}->{srcdir};
+
+sub seed () {
+	unless (-d $dir) {
+		make_path ($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";
+	}
+
+	tie my @fortune, 'SQLite_File', $backingfile  ||  croak "Unable to tie to $backingfile: $OS_ERROR";
+
+	opendir (my $srcdirhandle, $srcdir)  ||  croak "Unable to open $srcdir: $OS_ERROR";
+
+	while (my $fortunefile = readdir ($srcdirhandle)) {
+		my $srcfile = sprintf '%s/%s', $srcdir, $fortunefile;
+
+		unless (-f $srcfile) {
+			next;
+		}
+
+		if ($fortunefile =~ m/^\.+$/) {
+			next;
+		}
+
+		open (my $fh, '<', $srcfile)  ||  croak "Unable to open $srcfile, $OS_ERROR";
+		# 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 "[ERROR] Unable to tie to $backingfile: $OS_ERROR";
+		return '';
+	};
+
+	my $phrase = $array[irand ($#array + 1)];
+	# decode?
+	utf8::decode $phrase;
+	untie @array;
+	return $phrase;
+}
+
+1;
+
+# vim: ft=perl noet ai ts=4 sw=4 sts=4:

lib/friday.pm

@@ -0,0 +1,95 @@
+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 File::Path qw (make_path);
+use Math::Random::Secure qw (irand);
+use SQLite_File;
+use conf qw (loadConf);
+
+use version; our $VERSION = qw (1.0);
+use Exporter qw (import);
+our @EXPORT_OK = qw (seed friday);
+
+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) {
+		make_path ($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) {
+		unless (m/ \|\| /xmsg) {
+			next;
+		}
+
+		chomp();
+		my ($phrase, $days) = split(/ \|\| /);
+		my @daylist = split(//, $days);
+
+		foreach my $day (@daylist) {
+			unless (defined $day) {
+				next;
+			}
+
+			unless ($day =~ /^\d$/) {
+				next;
+			}
+
+			if (defined $phrase && ($phrase ne '') && ($phrase !~ m/^\s+$/xmsg)) {
+				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 "[ERROR] Unable to tie to $backingfile: $OS_ERROR\n";
+		return '';
+	};
+
+	my $phrase = $array[irand ($#array + 1)];
+	utf8::decode $phrase;
+	untie @array;
+	return $phrase;
+}
+
+1;
+
+# vim: ft=perl noet ai ts=4 sw=4 sts=4:

lib/image.pm

@@ -0,0 +1,211 @@
+package image;
+
+use 5.018;
+use strict;
+use warnings;
+use utf8;
+use open qw (:std :utf8);
+use English qw ( -no_match_vars );
+use Carp qw (cluck);
+use File::Path qw (make_path);
+use Math::Random::Secure qw (irand);
+use Mojo::UserAgent;
+use SQLite_File;
+use conf qw (loadConf);
+use flickr qw (flickr_by_tags);
+use imgur qw (imgur);
+use util qw (urlencode);
+
+use version; our $VERSION = qw (1.0);
+use Exporter qw (import);
+our @EXPORT_OK = qw (kitty fox oboobs obutts rabbit owl);
+
+my $c = loadConf ();
+my $dir = $c->{image}->{dir};
+
+sub kitty {
+	my $r;
+	my $ret = 'Нету кошечек, все разбежались.';
+
+	for (1..3) {
+		my $ua  = Mojo::UserAgent->new->connect_timeout (3);
+		$r = $ua->get ('https://api.thecatapi.com/v1/images/search')->result;
+
+		if ($r->is_success) {
+			last;
+		}
+
+		sleep 2;
+	}
+
+	if ($r->is_success) {
+		my $jcat = eval {
+			return $r->json;
+		};
+
+		unless (defined $jcat) {
+			cluck "[ERROR] Unable to decode JSON: $EVAL_ERROR";
+		} else {
+			if ($jcat->[0]->{url}) {
+				my @cats = ('龴ↀ◡ↀ龴', '=^..^=', '≧◔◡◔≦ ','^ↀᴥↀ^' );
+				$ret = sprintf '[%s](%s)', $cats[irand ($#cats + 1)], $jcat->[0]->{url};
+			}
+		}
+	} else {
+		cluck sprintf 'Server return status %s with message: %s', $r->code, $r->message;
+	}
+
+	return $ret;
+}
+
+sub fox {
+	my $r;
+	my $ret = 'Нету лисичек, все разбежались.';
+
+	for (1..3) {
+		my $ua  = Mojo::UserAgent->new->connect_timeout (3);
+		$r = $ua->get ('https://randomfox.ca/floof/')->result;
+
+		if ($r->is_success) {
+			last;
+		}
+
+		sleep 2;
+	}
+
+	if ($r->is_success) {
+		my $jfox = eval {
+			return $r->json;
+		};
+
+		unless (defined $jfox) {
+			cluck "[ERROR] Unable to decode JSON: $EVAL_ERROR";
+		} else {
+			if ($jfox->{image}) {
+				$jfox->{image} =~ s/\\//xmsg;
+				$ret = sprintf '[-^^,--,~](%s)', $jfox->{image};
+			}
+		}
+	} else {
+		cluck sprintf 'Server return status %s with message: %s', $r->code, $r->message;
+	}
+
+	return $ret;
+}
+
+sub oboobs {
+	my $r;
+	my $ret = 'Нету cисичек, все разбежались.';
+
+	for (1..3) {
+		my $ua  = Mojo::UserAgent->new->connect_timeout (3);
+		$r = $ua->get ('http://api.oboobs.ru/boobs/0/1/random')->result;
+
+		if ($r->is_success) {
+			last;
+		}
+
+		sleep 2;
+	}
+
+	if ($r->is_success) {
+		my $joboobs = eval {
+			return $r->json;
+		};
+
+		unless (defined $joboobs) {
+			cluck "[ERROR] Unable to decode JSON: $EVAL_ERROR";
+		} else {
+			if ($joboobs->[0]->{preview}) {
+				my @boobs = ('(. )( .)', '(  . Y .  )', '(o)(o)', '( @ )( @ )', '(.)(.)');
+				$ret = sprintf '[%s](https://media.oboobs.ru/%s)', $boobs[irand ($#boobs + 1)], $joboobs->[0]->{preview};
+			}
+		}
+	} else {
+		cluck sprintf 'Server return status %s with message: %s', $r->code, $r->message;
+	}
+
+	return $ret;
+}
+
+sub obutts {
+	my $r;
+	my $ret = 'Нету попок, все разбежались.';
+
+	for (1..3) {
+		my $ua  = Mojo::UserAgent->new->connect_timeout (3);
+		$r = $ua->get ('http://api.obutts.ru/butts/0/1/random')->result;
+
+		if ($r->is_success) {
+			last;
+		}
+
+		sleep 2;
+	}
+
+	if ($r->is_success) {
+		my $jobutts = eval {
+			return $r->json;
+		};
+
+		unless (defined $jobutts) {
+			cluck "[ERROR] Unable to decode JSON: $EVAL_ERROR";
+		} else {
+			if ($jobutts->[0]->{preview}) {
+				my @butts = ('(__(__)', '(_!_)', '(__.__)');
+				$ret = sprintf '[%s](http://media.obutts.ru/%s)', $butts[irand ($#butts + 1)], $jobutts->[0]->{preview};
+			}
+		}
+	} else {
+		cluck sprintf 'Server return status %s with message: %s', $r->code, $r->message;
+	}
+
+	return $ret;
+}
+
+# It works but results are not particulary relevant, partially. about 20-30% miss
+# So i prefer to use flickr rabbits selection :)
+sub rabbit_imgur {
+	my @terms = (
+		urlencode '?q=animals AND (rabbits OR bunnies)',
+		urlencode 'year?q=animals AND (rabbits OR bunnies)',
+		urlencode 'relevance?q=animals AND (rabbits OR bunnies)',
+		urlencode 'relevance/year?q=animals AND (rabbits OR bunnies)',
+		urlencode 'score?q_not=cat OR kitten OR kittens OR dog OR cats OR dogs OR puppy OR puppies&q_tags=bunnies,bunny,rabbits,rabbit',
+	);
+
+	my $rabbit = imgur ($terms[irand ($#terms + 1)]);
+	# return just large thumbnail instead of real photo (that can be really huge)
+	$rabbit = sprintf '%sl%s', substr ($rabbit, 0, -4), substr ($rabbit, -4);
+
+	if (defined $rabbit) {
+		return sprintf '[(\_/)](%s)', $rabbit;
+	} else {
+		return 'Нету кроликов, все разбежались.'
+	}
+}
+
+sub rabbit {
+	# rabbit, but bunny
+	my $url = flickr_by_tags ('animal,bunny');
+
+	if (defined $url) {
+		return sprintf '[(\_/)](%s)', $url;
+	} else {
+		return 'Нету кроликов, все разбежались.';
+	}
+}
+
+sub owl {
+	my $url = flickr_by_tags ('bird,owl');
+
+	if (defined $url) {
+		return sprintf '[{ O v O }](%s)', $url;
+	} else {
+		return 'Нету сов, все разлетелись.';
+	}
+}
+
+1;
+
+# vim: set ft=perl noet ai ts=4 sw=4 sts=4:

lib/imgur.pm

@@ -0,0 +1,148 @@
+package imgur;
+
+use 5.018;
+use strict;
+use warnings;
+use utf8;
+use open qw (:std :utf8);
+use English qw ( -no_match_vars );
+use Carp qw (cluck);
+use File::Path qw (make_path);
+use Math::Random::Secure qw (irand);
+use Mojo::UserAgent;
+use SQLite_File;
+use conf qw (loadConf);
+
+use version; our $VERSION = qw (1.0);
+use Exporter qw (import);
+our @EXPORT_OK = qw (imgur);
+
+my $c = loadConf ();
+my $dir = $c->{image}->{dir};
+my $imgur_client_id     = $c->{image}->{imgur}->{client_id};
+my $imgur_client_secret = $c->{image}->{imgur}->{client_secret};
+my $imgur_access_token  = $c->{image}->{imgur}->{access_token};;
+my $imgur_refresh_token = $c->{image}->{imgur}->{refresh_token};
+
+sub imgur {
+	my $tag = shift;
+
+	my $refresh_url   = 'https://api.imgur.com/oauth2/token';
+	my $search_url    = 'https://api.imgur.com/3/gallery/search/';
+
+	# load all tokens from api secrets db
+	my $backingfile = sprintf '%s/secrets.sqlite', $dir;
+
+	unless (-d $dir) {
+		make_path ($dir) or do {
+			cluck "Unable to create $dir: $OS_ERROR";
+			return undef;
+		};
+	}
+
+	tie my %secret, 'SQLite_File', $backingfile  ||  do {
+		cluck "[ERROR] Unable to tie to $backingfile: $OS_ERROR";
+		return undef;
+	};
+
+	# if there is no access_token in db - put there one from config
+	if (defined $secret{imgur_access_token}) {
+		$imgur_access_token = $secret{imgur_access_token};
+	} else {
+		$secret{imgur_access_token} = $imgur_access_token;
+	}
+
+	# if there is no refresh_token in db - put there one from config
+	if (defined $secret{imgur_refresh_token}) {
+		$imgur_refresh_token = $secret{imgur_refresh_token};
+	} else {
+		$secret{imgur_refresh_token} = $imgur_refresh_token;
+	}
+
+	# query api
+	my $ua = Mojo::UserAgent->new->connect_timeout (3);
+	my $r = $ua->get ($search_url . $tag => {Authorization => "Bearer $imgur_access_token"})->result;
+
+	# looks like we need to refresh token
+	if (($r->code == 401) || ($r->code == 403)) {
+		$ua->post (
+			$refresh_url => form {
+				refresh_token => $imgur_refresh_token,
+				client_id => $imgur_client_id,
+				clinent_secret => $imgur_client_secret,
+				grant_type => 'refresh_token',
+			}
+		);
+
+		unless ($r->is_success) {
+			cluck "Unable to refresh imgur token, please re-authorise app! or imgur experiencing api outage: $r->code $r->message";
+			untie %secret;
+			return undef;
+		}
+
+		my $refresh = eval { return $r->json; };
+
+		if (defined $refresh) {
+			$imgur_refresh_token = $refresh->{refresh_token};
+			$secret{imgur_refresh_token} = $refresh->{refresh_token};
+			$imgur_access_token = $refresh->{access_token};
+			$secret{imgur_access_token} = $refresh->{access_token};
+		} else {
+			cluck "Unable to refresh imgur access_token, unable to decode json: $EVAL_ERROR";
+			untie %secret;
+			return undef;
+		}
+
+		# query api again
+		$r = $ua->get ($search_url . $tag => {Authorization => "Bearer $imgur_access_token"})->result;
+	}
+
+	untie %secret;
+
+	if ($r->is_success) {
+		my $searchResult = eval { return $r->json; };
+		my @urls;
+
+		if (defined $searchResult) {
+			if ($searchResult->{success}) {
+				foreach my $item (@{$searchResult->{data}}) {
+					foreach my $image (@{$item->{images}}) {
+						if (defined ($image->{animated}) && (0 + $image->{animated}) != 0) {
+							next;
+						}
+
+						if (($image->{type} eq 'image/jpeg') || ($image->{type} eq 'image/png')) {
+							if (defined ($image->{is_ad}) && (0 + $image->{is_ad}) !=0) {
+								next;
+							}
+
+							if (defined ($image->{nsfw}) && (0 + $image->{nsfw}) != 0) {
+								next;
+							}
+
+							push @urls, $image->{link};
+						}
+					}
+				}
+
+				if ($#urls > 0) {
+					return $urls[irand ($#urls + 1)];
+				} else {
+					cluck 'Imgur api returned empty result.';
+					return undef;
+				}
+			} else {
+				cluck "Unable to get results from imgur api: $r->message";
+				return undef;
+			}
+		} else {
+			cluck "Unable to decode imgur api json: $EVAL_ERROR";
+			return undef;
+		}
+	} else {
+		cluck "Unable to get results from imgur api: $r->code, $r->message";
+		return undef;
+	}
+}
+
+1;

lib/karma.pm

@@ -4,23 +4,19 @@ use 5.018;
 use strict;
 use warnings;
 use utf8;
-use open qw(:std :utf8);
-use English qw( -no_match_vars );
-use Digest::SHA1;
+use open qw (:std :utf8);
+use English qw ( -no_match_vars );
+use Carp qw (cluck);
+use Digest::SHA qw (sha1_base64);
 use DB_File;
+use File::Path qw (make_path);
+use conf qw (loadConf);
 
-use vars qw/$VERSION/;
-use Exporter qw(import);
-our @EXPORT_OK = qw(karmaSet karmaGet);
+use version; our $VERSION = qw (1.0);
+use Exporter qw (import);
+our @EXPORT_OK = qw (karmaSet karmaGet);
 
-$VERSION = '1.0';
-
-use File::Basename qw(dirname);
-use File::Path qw(mkpath);
-use conf qw(loadConf);
-use botlib qw(logger);
-
-my $c = loadConf();
+my $c = loadConf ();
 my $karmadir = $c->{karma}->{dir};
 my $max = 5;
 
@@ -30,14 +26,32 @@ sub karmaSet (@) {
 	my $phrase = shift;
 	my $action = shift;
 	my $score = 0;
-	my $karmafile = sprintf "$karmadir/%s.db", sha1_base64 ($chatid);
+	# sha1* does not understand utf8, so explicitly construct string cost of decimal numbers only 
+	my $karmafile = join ('', unpack ('C*', $chatid));
+	$karmafile = sha1_base64 $karmafile;
+	# sha1 string can contain slashes, so make a bit longer string consist of only decimal numbers
+	$karmafile = join ('', unpack ('C*', $karmafile));
+	$karmafile = sprintf '%s/%s.db', $karmadir, $karmafile;
+
+	if (($phrase eq '') || ($phrase =~ /^ +$/)) {
+		$phrase = '';
+	}
+
+	unless (-d $karmadir) {
+		make_path ($karmadir) or do {
+			cluck "Unable to create $karmadir: $OS_ERROR";
+			return sprintf 'Карма %s составляет 0', $phrase;
+		};
+	}
+
 	# init hash, store phrase and score
-	tie my %karma, 'DB_File', $karmafile or do {
-		logger "Something nasty happen when cachedata ties to its data: $OS_ERROR";
+	tie my %karma, 'DB_File', $karmafile || do {
+		cluck "[ERROR] Something nasty happen when cachedata ties to its data: $OS_ERROR";
 		return sprintf 'Карма %s составляет 0', $phrase;
 	};
 
-	my $sha1_phrase = sha1($phrase);
+	# bdb does not understand utf8, so tied hash too, we do not want store original phrase anyway
+	my $sha1_phrase = sha1_base64 (join ('', unpack ('C*', $phrase)));
 
 	if (defined $karma{$sha1_phrase}) {
 		if ($action eq '++') {
@@ -50,17 +64,27 @@ sub karmaSet (@) {
 	} else {
 		if ($action eq '++') {
 			$karma{$sha1_phrase} = 1;
+			$score = 1;
 		} else {
 			$karma{$sha1_phrase} = -1;
+			$score = -1;
 		}
 	}
 
 	untie %karma;
 
-	if ($score < 0 && (($score % $max) - 1) == 0)) {
-		return sprintf 'Зарегистрировано пробитие дна, карма %s составляет %d', $phrase, $score;
+	if ($score < -1 && (($score % (0 - $max)) + 1) == 0) {
+		if ($phrase eq '') {
+			return sprintf 'Зарегистрировано пробитие дна, карма пустоты составляет %d', $score;
+		} else {
+			return sprintf 'Зарегистрировано пробитие дна, карма %s составляет %d', $phrase, $score;
+		}
 	} else {
-		return sprintf 'Карма %s составляет %d', $phrase, $score;
+		if ($phrase eq '') {
+			return sprintf 'Карма пустоты составляет %d', $score;
+		} else {
+			return sprintf 'Карма %s составляет %d', $phrase, $score;
+		}
 	}
 }
 
@@ -68,15 +92,32 @@ sub karmaSet (@) {
 sub karmaGet (@) {
 	my $chatid = shift;
 	my $phrase = shift;
+	# sha1* does not understand utf8, so explicitly construct string cost of decimal numbers only 
+	my $karmafile = join ('', unpack ('C*', $chatid));
+	$karmafile = sha1_base64 $karmafile;
+	# sha1 string can contain slashes, so make a bit longer string consist of only decimal numbers
+	$karmafile = join ('', unpack ('C*', $karmafile));
+	$karmafile = sprintf '%s/%s.db', $karmadir, $karmafile;
+
+	if (($phrase eq '') || ($phrase =~ /^ +$/)) {
+		$phrase = '';
+	}
+
+	unless (-d $karmadir) {
+		make_path ($karmadir) or do {
+			cluck "Unable to create $karmadir: $OS_ERROR";
+			return sprintf 'Карма %s составляет 0', $phrase;
+		};
+	}
 
-	my $karmafile = sprintf "$karmadir/%s.db", sha1_base64 ($chatid);
 	# init hash, store phrase and score
-	tie my %karma, 'DB_File', $karmafile or do {
-		logger "Something nasty happen when karma ties to its data: $OS_ERROR";
+	tie my %karma, 'DB_File', $karmafile || do {
+		cluck "[ERROR] Something nasty happen when karma ties to its data: $OS_ERROR";
 		return sprintf 'Карма %s составляет 0', $phrase;
 	};
 
-	my $sha1_phrase = sha1 ($phrase);
+	# bdb does not understand utf8, so tied hash too, we do not want store original phrase anyway
+	my $sha1_phrase = sha1_base64 (join ('', unpack ('C*', $phrase)));
 	my $score = $karma{$sha1_phrase};
 	untie %karma;
 
@@ -84,7 +125,11 @@ sub karmaGet (@) {
 		$score = 0;
 	}
 
-	return sprintf 'Карма %s составляет %d', $phrase, $score;
+	if ($phrase eq '') {
+		return sprintf 'Карма пустоты составляет %d', $score;
+	} else {
+		return sprintf 'Карма %s составляет %d', $phrase, $score;
+	}
 }
 
 1;

lib/lat.pm

@@ -5,31 +5,28 @@ use 5.018;
 use strict;
 use warnings;
 use utf8;
-use open qw(:std :utf8);
-use English qw( -no_match_vars );
-
-use vars qw/$VERSION/;
-use Exporter qw(import);
-our @EXPORT_OK = qw(train latAnswer);
-
-$VERSION = '1.0';
-
+use open qw (:std :utf8);
+use English qw ( -no_match_vars );
+use Carp qw (cluck);
+use File::Basename qw (dirname);
+use File::Path qw (make_path);
 use Hailo;
-use File::Basename qw(dirname);
-use File::Path qw(mkpath);
-use conf qw(loadConf);
-use botlib qw(logger);
+use conf qw (loadConf);
 
-my $c = loadConf();
+use version; our $VERSION = qw (1.0);
+use Exporter qw (import);
+our @EXPORT_OK = qw (train latAnswer);
+
+my $c = loadConf ();
 my $brain = $c->{lat}->{brain};
+my $srcfile = $c->{lat}->{src};
 
-# swallow phrase and return answer
 sub train () {
-	my $braindir = dirname ($brain);
+	my $braindir = dirname $brain;
 
 	unless (-d $braindir) {
-		mkpath ($braindir) or do {
-			logger "Unable to create $braindir: $OS_ERROR";
+		make_path ($braindir) or do {
+			cluck "Unable to create $braindir: $OS_ERROR";
 			exit 1;
 		};
 	}
@@ -40,24 +37,24 @@ sub train () {
 		order => 2
 	);
 
-	$lat->train('data/phrases.txt');
-	my ($tokens, $expressions) = ($lat->stats())[0,1];
-	printf "Total tokens: %s\nTotal expressins: %s\n", $tokens, $expressions;
-	$lat->save();
+	$lat->train ($srcfile);
+	my ($tokens, $expressions) = ($lat->stats ())[0,1];
+	printf "Total tokens: %s\nTotal expressions: %s\n", $tokens, $expressions;
+	$lat->save ();
 	return;
 }
 
 # just return answer
 sub latAnswer () {
-	my $braindir = dirname ($brain);
+	my $braindir = dirname $brain;
 
 	unless (-d $braindir) {
-		logger ("No lat module data: $braindir is absent! Train lat first.");
+		cluck "[ERROR] No lat module data: $braindir is absent! Train lat first.";
 		return '';
 	}
 
 	unless (-f $brain) {
-		logger ("No lat module data: $brain is absent! Train lat first.");
+		cluck "[ERROR] No lat module data: $brain is absent! Train lat first.";
 		return '';
 	}
 
@@ -68,7 +65,7 @@ sub latAnswer () {
 		save_on_exit => 0
 	);
 
-	return $lat->reply();
+	return $lat->reply ();
 }
 
 1;

lib/monkeyuser.pm

@@ -0,0 +1,62 @@
+package monkeyuser;
+
+use 5.018;
+use strict;
+use warnings;
+use utf8;
+use open qw (:std :utf8);
+use English qw ( -no_match_vars );
+use Carp qw (cluck);
+use HTML::TokeParser;
+use Math::Random::Secure qw (irand);
+use Mojo::UserAgent;
+
+use version; our $VERSION = qw (1.0);
+use Exporter qw (import);
+our @EXPORT_OK = qw (monkeyuser);
+
+sub monkeyuser {
+	my $r;
+	my $ret = 'Нету Monkey User-ов, они все спрятались.';
+	my @link;
+
+	for (1..3) {
+		my $ua  = Mojo::UserAgent->new->connect_timeout (3);
+		$r = $ua->get ('https://www.monkeyuser.com/toc/')->result;
+
+		if ($r->is_success) {
+			last;
+		}
+
+		sleep 2;
+	}
+
+	if ($r->is_success) {
+		my $p = HTML::TokeParser->new(\$r->body);
+		my @a;
+
+		do {
+			$#a = -1;
+			@a = $p->get_tag('a'); ## no critic (Variables::RequireLocalizedPunctuationVars)
+
+			if (defined $a[0][1]->{class} && $a[0][1]->{class} eq 'lazyload small-image') {
+				if (defined $a[0][1]->{'data-src'} && ($a[0][1]->{'data-src'} !~ /adlitteram/)) {
+					push @link, $a[0][1]->{'data-src'};
+				}
+			}
+
+		} while ($#{$a[0]} > 1);
+
+		if ($#link > 0) {
+			$ret = sprintf '[MonkeyUser](https://www.monkeyuser.com%s)', $link [irand (1 + $#link)];
+		}
+	} else {
+		cluck sprintf 'Server return status %s with message: %s', $r->{status}, $r->{reason};
+	}
+
+	return $ret;
+}
+
+1;
+
+# vim: set ft=perl noet ai ts=4 sw=4 sts=4:

lib/telegrambot.pm

@@ -4,40 +4,58 @@ package telegrambot;
 use 5.018;
 use strict;
 use warnings;
-use vars qw/$VERSION/;
 use utf8;
 use Data::Dumper;
-use open qw(:std :utf8);
-use File::Path qw( mkpath );
+use open qw (:std :utf8);
+use English qw ( -no_match_vars );
+use Carp qw (cluck carp);
+use File::Path qw (make_path);
 use Hailo;
+use Math::Random::Secure qw (irand);
 use Mojo::Base 'Teapot::Bot::Brain';
+use admin qw (fortune_toggle_list);
+use botlib qw (randomCommonPhrase command highlight botsleep isCensored);
+use conf qw (loadConf);
+use fortune qw (fortune);
+use karma qw (karmaSet);
+use util qw (trim fmatch);
 
-use conf qw(loadConf);
-use botlib qw(weather logger trim randomCommonPhrase);
-use telegramlib qw(visavi);
-use lat qw(latAnswer);
+use version; our $VERSION = qw (1.0);
+use Exporter qw (import);
+our @EXPORT_OK = qw (run_telegrambot);
 
-use Exporter qw(import);
-our @EXPORT_OK = qw(run_telegrambot);
-
-$VERSION = '1.0';
-
-my $c = loadConf();
+my $c = loadConf ();
 my $hailo;
 my $myid;
 my $myusername;
 my $myfirst_name;
 my $mylast_name;
 my $myfullname;
-# guess it later
-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 @intro = (
+		'Сегодняшний день пройдёт под эгидой фразы:',
+		'Крылатая фраза на сегодня:',
+		'Сегодняшняя фраза дня:',
+	);
+
+	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} = sprintf "%s\n```\n%s\n```\n", $intro[irand ($#intro + 1)], trim (fortune ());
+			$send_args->{chat_id} = $enabledfortunechat;
+			$send_args->{parse_mode} = 'Markdown';
+			$self->sendMessage ($send_args);
+		}
+	}
+
 	return;
 }
 
@@ -47,23 +65,18 @@ sub __on_msg {
 	my $chatid;
 	my $chatname = 'Noname chat';
 	# user sending message info
-	my $userid;
-	my $username;
-	my $fullname;
-	my $vis_a_vi = 'unknown';
-
-	$can_talk = 0;
+	my ($userid, $username, $fullname, $highlight, $vis_a_vi) = highlight $msg;
+	my $csign = $c->{telegrambot}->{csign};
 
 	unless ($myid) {
-		my $myObj = Teapot::Bot::Brain::getMe ($self);
+		my $myObj = $self->getMe ();
 
 		unless ($myObj) {
-			sleep 3;
-			$myObj = Teapot::Bot::Brain::getMe ($self);
+			carp '[ERROR] Unable to get chatid, API Error?';
+			return;
 		}
 
 		$myid = $myObj->id;
-		# TODO: use these values instead of pre-defined in config!
 		$myusername = $myObj->username;
 		$myfirst_name = $myObj->first_name;
 		$mylast_name = $myObj->last_name;
@@ -81,7 +94,6 @@ sub __on_msg {
 
 	if ($msg->chat->can ('id') && defined ($msg->chat->id)) {
 		$chatid = $msg->chat->id;
-		my $group_talk = 0;
 
 		if ($msg->chat->can ('username') && defined ($msg->chat->username)) {
 			$chatname = $msg->chat->username ;
@@ -92,109 +104,52 @@ sub __on_msg {
 				$chatname = 'Noname chat';
 			}
 		}
-
-		# because of bot api restriction there is no events about changing permissions
-		# in chat sent to bot so before sending any answer, we should check if we can do so
-
-		# N.B. there is situation when we do not recieve any messages from chat: if we
-		# are in exception list, even if it allows any kind of events for bot
-
-		# If we are just member of chat, it looks like we obey general chat restrictions,
-		# so we need only to query getChat in this case
-		# If we admin, we can get|send messages even if group by itself disallows it.
-
-		# works only for public chats, so id shoud be < 0.
-		if ($chatid < 0) {
-			my $chatobj = Teapot::Bot::Brain::getChat ($self, { 'chat_id' => $chatid });
-
-			unless ($chatobj) {
-				sleep 3;
-				$chatobj = Teapot::Bot::Brain::getChat ($self, { 'chat_id' => $chatid });
-			}
-
-			# actually evaluates to 1 for true and to 0 for false
-			$group_talk = int ($chatobj->{permissions}->{can_send_messages});
-			my $me = Teapot::Bot::Brain::getChatMember ($self, { 'chat_id' => $chatid, 'user_id' => $myid });
-
-			unless ($me) {
-				sleep 3;
-				$me = Teapot::Bot::Brain::getChatMember ($self, { 'chat_id' => $chatid, 'user_id' => $myid });
-			}
-
-			if ($me->{'status'} eq 'administrator') {
-				logger "I can talk in group chat $chatname ($chatid)";
-				$can_talk = 1;
-			} else {
-				logger "I can talk in group chat $chatname ($chatid)" if ($group_talk);
-				logger "I can not talk in group chat $chatname ($chatid)" unless ($group_talk);
-				$can_talk = $group_talk;
-			}
-		} else {
-			# private chat, so definely bot can talk
-			logger "I can talk in private chat $chatname ($chatid)";
-			$can_talk = 1;
-		}
 	} else {
-		logger 'Unable to get chatid';
-	}
-
-	# according api user must have username and/or first_name and/or last_name at least one of these fields
-	if ($msg->can ('from') && defined ($msg->from)) {
-		$userid = $msg->from->id; # it must be filled, so do not check it
-		$username = $msg->from->username if ($msg->from->can ('username') && defined($msg->from->username));
-
-		if ($msg->from->can ('first_name') && defined ($msg->from->first_name)) {
-			$fullname = $msg->from->first_name;
-
-			if ($msg->from->can('last_name') && defined ($msg->from->last_name)) {
-				$fullname .= ' ' . $msg->from->last_name;
-			}
-		} elsif ($msg->from->can ('last_name') && defined ($msg->from->last_name)) {
-			$fullname .= $msg->from->last_name;
-		}
-
-		$vis_a_vi = visavi ($userid, $username, $fullname);
+		carp '[INFO] Unable to get chatid';
+		return;
 	}
 
 	my $phrase = '';
 
 	# Newcommer event, greet our new member and suggest to introduce themself.
 	if ($msg->can ('new_chat_members') && defined ($msg->new_chat_members)) {
-		my $send_args;
-		$send_args->{parse_mode} = 'Markdown';
-		$send_args->{chat_id} = $chatid;
+		my @members;
 
-		if (defined ($username)) {
-			if (defined ($fullname)) {
-				logger "Newcommer in $chatname ($chatid): \@$username, $fullname ($userid)";
-				$send_args->{text} = "Дратути, [$fullname](tg://user?id=$userid). Представьтес, пожалуйста, и расскажите, что вас сюда привело.";
+		foreach my $member (@{$msg->new_chat_members}) {
+			my $member_str = '';
+
+			if ($member->can ('first_name') && defined ($member->first_name)) {
+				$member_str .= $member->first_name;
+
+				if ($member->can ('last_name') && defined ($member->last_name)) {
+					$member_str .= ' ' . $member->last_name;
+				}
 			} else {
-				logger "Newcommer in $chatname ($chatid): \@$username ($userid)";
-				$send_args->{text} = "Дратути, [$username](tg://user?id=$userid). Представьтес, пожалуйста, и расскажите, что вас сюда привело.";
+				if ($member->can ('last_name') && defined ($member->last_name)) {
+					$member_str .= ' ' . $member->last_name;
+				} else {
+					$member_str .= '@' . $member->username;
+				}
 			}
+
+			push @members, sprintf '[%s](tg://user?id=%s)', $member_str, $member->id;
+		};
+
+		if ($#members > 1) {
+			my $lastone = pop @members;
+			$phrase = sprintf 'Дратути, %s и %s. Представьтес, пожалуйста, и расскажите, что вас сюда привело.', join (', ', @members), $lastone;
 		} else {
-			logger "Newcommer in $chatname ($chatid): $fullname ($userid)";
-			$send_args->{text} = "Дратути, [$fullname](tg://user?id=$userid). Представьтес, пожалуйста, и расскажите, что вас сюда привело.";
+			$phrase = sprintf 'Дратути, %s. Представьтес, пожалуйста, и расскажите, что вас сюда привело.', $members[0];
 		}
 
-		# let's emulate real human and delay answer
-		sleep (int ( rand (2) + 1));
-
-		for (0..(4 + int (rand (3)))) {
-			$msg->typing();
-			sleep(3);
-			sleep 3 unless ($_);
-		}
-
-		sleep ( 3 + int ( rand (2)));
-
-		Teapot::Bot::Brain::sendMessage ($self, $send_args);
+		botsleep $msg;
+		$msg->replyMd ($phrase);
 		return;
 	}
 
 # lazy init chat-bot brains
-	unless (defined ($hailo->{$chatid})) {
-		my $brainname = sprintf ('%s/%s.brain.sqlite', $c->{telegrambot}->{braindir}, $chatid);
+	unless (defined $hailo->{$chatid}) {
+		my $brainname = sprintf '%s/%s.brain.sqlite', $c->{telegrambot}->{braindir}, $chatid;
 
 		$hailo->{$chatid} = Hailo->new (
 # we'll got file like this: data/telegrambot-brains/-1001332512695.brain.sqlite
@@ -203,175 +158,120 @@ sub __on_msg {
 		);
 
 		if ($chatid < 0) {
-			logger "Initialized brain for public chat $chatname ($chatid): $brainname";
+			carp "[INFO] Initialized brain for public chat $chatname ($chatid): $brainname";
 		} else {
-			logger "Initialized for private chat $chatname ($chatid): $brainname";
+			carp "[INFO] Initialized brain for private chat $chatname ($chatid): $brainname";
 		}
 	}
 
 # is this a 1-on-1 ?
 	if ($msg->chat->type eq 'private') {
-		# TODO: what about stickers, photos, documents, audio, video, etc... We should log em at least.
-		return unless ($msg->can ('text') && defined ($msg->text));
+		unless (defined $msg->text) {
+			return;
+		}
 
 		my $text = $msg->text;
-		logger sprintf ('Private chat %s say to bot: %s', $vis_a_vi, $text);
-		my $csign = quotemeta ($c->{telegrambot}->{csign});
+		carp sprintf ('[DEBUG] Private chat %s say to bot: %s', $vis_a_vi, $text) if $c->{debug};
 		my $reply = 'Давайте ещё пообщаемся, а то я ещё не научилась от вас плохому.';
 
-		# TODO: Process commands in separate sub, they are same for public and private chats.
-		if (substr ($text, 0, 1) eq $c->{telegrambot}->{csign}) {
-			if (substr ($text, 1) eq 'ping') {
-				$reply = 'Pong.';
-			} elsif (substr ($text, 1) eq 'пинг') {
-				$reply = 'Понг.';
-			} elsif (substr ($text, 1, 2) eq 'w ' || substr ($text, 1, 2) eq 'п ') {
-				my $city = substr ($text, 2);
-				$reply = weather ($city);
-			} elsif ((length ($text) == 4) && (substr ($text, 1, 3) eq 'lat' || substr ($text, 1, 2) eq 'лат')) {
-				$reply = latAnswer();
-			} else {
-				$reply = 'Чего?';
-			}
+		if (substr ($text, 0, 1) eq $csign) {
+			$reply = command ($self, $msg, $text, $userid);
 		} else {
-			my $str = $hailo->{$msg->chat->id}->learn_reply ($text);
+			my $just_message_in_chat = 0;
 
-			if (defined ($str) && $str ne '') {
-				$reply = $str;
-				# TODO: move it to telegramlib.pm/botlib.pm!
-				$phrase = trim ($text);
+			# is it karma adjustment?
+			if (substr ($text, -2) eq '++'  ||  substr ($text, -2) eq '--') {
+				my @arr = split /\n/, $text;
 
-				while ($phrase =~ /[\.|\,|\?|\!]$/) {
-					chop $phrase;
+				if ($#arr < 1) {
+					$reply = karmaSet ($chatid, trim (substr ($text, 0, -2)), substr ($text, -2));
+				} else {
+					$just_message_in_chat = 1;
 				}
+			}
 
-				$phrase = lc ($phrase);
+			if ($just_message_in_chat) {
+				my $str = $hailo->{$msg->chat->id}->learn_reply ($text);
 
-				if (lc ($reply) eq $phrase) {
-					$reply = randomCommonPhrase();
-				} elsif (lc ($reply) eq substr ($phrase, 0, -1)) {
-					# in case of trailing dot
-					$reply = randomCommonPhrase();
-				} elsif (substr (lc ($reply), 0, -1) eq $phrase) {
-					$reply = randomCommonPhrase();
+				if (defined ($str) && $str ne '') {
+					$reply = $str;
+					$phrase = trim $text;
+
+					while ($phrase =~ /[\.|\,|\?|\!]$/) {
+						chop $phrase;
+					}
+
+					$phrase = lc $phrase;
+
+					if (fmatch (lc ($reply), $phrase)) {
+						$reply = randomCommonPhrase ();
+					}
 				}
 			}
 		}
 
-		$msg->typing();
-		sleep 1;
-		logger sprintf ("Private chat bot reply to $vis_a_vi: %s", $reply);
-		$msg->reply ($reply);
+		if (defined $reply) {
+			$msg->typing ();
+			sleep 1;
+			carp sprintf ('[DEBUG] Private chat bot reply to %s: %s', $vis_a_vi, $reply) if $c->{debug};
+			$msg->reply ($reply);
+		}
 # group chat
 	} elsif (($msg->chat->type eq 'supergroup') or ($msg->chat->type eq 'group')) {
 		my $reply;
 
+		if (isCensored $msg) {
+			carp sprintf '[INFO] In public chat %s (%s) message from %s was censored', $chatname, $chatid, $vis_a_vi;
+			$self->deleteMessage ({chat_id => $chatid, message_id => $msg->{message_id}});
+		}
+
 		# detect and log messages without text, noop here
-		unless (defined ($msg->text)) {
-			logger sprintf('No text in message from %s', $vis_a_vi);
-
-			if ($msg->can ('document') && defined ($msg->document)) {
-				if (defined ($msg->document->{'file_name'})) {
-					my $docsize = 'unknown';
-					$docsize = $msg->document->{'file_size'} if (defined ($msg->document->{'file_size'}));
-					my $type = 'unknown';
-					$type = $msg->document->{'mime_type'} if (defined ($msg->document->{'mime_type'}));
-					logger sprintf ('In public chat %s (%s) %s send document type %s named %s, size %s bytes', $chatname, $chatid, $vis_a_vi, $type, $msg->document->{'file_name'}, $docsize);
-				} else {
-					logger sprintf ('In public chat %s (%s) %s send unknown document', $chatname, $chatid, $vis_a_vi);
-				}
-			} elsif ($msg->can ('sticker') && defined ($msg->sticker)) {
-				my $set_name = 'unknown';
-				$set_name = $msg->sticker->set_name if ($msg->sticker->can ('set_name') && defined ($msg->sticker->set_name));
-				my $emoji = 'unknown';
-				$emoji = $msg->sticker->emoji if ($msg->sticker->can ('emoji') && defined ($msg->sticker->emoji));
-				logger sprintf ('In public chat %s (%s) %s reacted with sticker %s from pack %s', $chatname, $chatid, $vis_a_vi, $emoji, $set_name);
-			} elsif ($msg->can ('photo') && defined ($msg->photo)) {
-				# actually it is an array! duh, hate arrays!
-				logger sprintf ('In public chat %s (%s) %s send photo', $chatname, $chatid, $vis_a_vi);
-			} else {
-				logger Dumper ($msg);
-			}
-
+		unless (defined $msg->text) {
+			carp sprintf ('[INFO] No text in message from %s', $vis_a_vi);
 			return;
 		}
 
 		# we have text here! so potentially we can chit-chat
 		my $text = $msg->text;
-		logger sprintf ('In public chat %s (%s) %s say: %s', $chatname, $chatid, $vis_a_vi, $text);
-		my $qname = quotemeta ($c->{telegrambot}->{name});
-		my $qtname = quotemeta ($c->{telegrambot}->{tname});
-		my $csign = quotemeta ($c->{telegrambot}->{csign});
+		carp sprintf ('[DEBUG] In public chat %s (%s) %s say: %s', $chatname, $chatid, $vis_a_vi, $text) if $c->{debug};
 
 		# are they quote something, maybe, us?
 		if (defined ($msg->reply_to_message) &&
 		            defined ($msg->reply_to_message->from) &&
 		                    defined ($msg->reply_to_message->from->username) &&
 		                            ($msg->reply_to_message->from->username eq $myusername)) {
-			logger sprintf ('In public chat %s (%s) %s quote us!', $chatname, $chatid, $vis_a_vi);
-			# remove our name from users reply, just in case
-			my $pat1 = quotemeta ('@' . $myusername);
-			my $pat2 = quotemeta ($myfullname);
-			$phrase = $text;
-			$phrase =~ s/$pat1//g;
-			$phrase =~ s/$pat2//g;
+			carp sprintf ('[DEBUG] In public chat %s (%s) %s quote us!', $chatname, $chatid, $vis_a_vi) if $c->{debug};
+
+			# do not answer back if someone quote our new member greet
+			if ((substr ($msg->reply_to_message->text, 0, 9) eq 'Дратути, ') &&
+			    (substr ($msg->reply_to_message->text, -61) eq 'Представьтес, пожалуйста, и расскажите, что вас сюда привело.')) {
+				return;
+			} else {
+				# remove our name from users reply, just in case
+				my $pat1 = quotemeta ('@' . $myusername);
+				my $pat2 = quotemeta $myfullname;
+				$phrase = $text;
+				$phrase =~ s/$pat1//g;
+				$phrase =~ s/$pat2//g;
 
 			# figure out reply :)
-			$reply = $hailo->{$msg->chat->id}->learn_reply ($phrase);
-		# simple commands
-		# TODO: Process commands in separate sub, they are same for public and private chats.
-		# TODO: Log commands and answers
-		} elsif (substr ($text, 0, 1) eq $c->{telegrambot}->{csign}) {
-			if (substr ($text, 1) eq 'help') {
-				unless ($can_talk) {
-					return ;
-				}
-
-				my $send_args;
-				$send_args->{text} = << 'MYHELP';
-```
-!help | !помощь       - список команд
-!w город | !п город   - погода в указанном городе
-!ping | !пинг         - попинговать бота
-!lat | !лат           - сгенерировать фразу из крылатых латинских выражений
-!karma | !карма фраза - посмотреть карму фразы
-фраза-- | фраза++     - убавить или добавить карму фразе
-```
-Но на самом деле я бот больше для общения, чем для исполнения команд.
-Поговоришь со мной?
-MYHELP
-				$send_args->{parse_mode} = 'Markdown';
-				$send_args->{chat_id} = $chatid;
-				Teapot::Bot::Brain::sendMessage ($self, $send_args);
-				return;
-			} elsif (substr ($text, 1) eq 'ping') {
-				$reply = 'Pong.';
-			} elsif (substr ($text, 1) eq 'пинг') {
-				$reply = 'Понг.';
-			} elsif (substr ($text, 1) eq 'pong') {
-				$reply = 'Wat?';
-			} elsif (substr ($text, 1) eq 'понг') {
-				$reply = 'Шта?';
-			} elsif (substr ($text, 1, 2) eq 'w ' || substr ($text, 1, 2) eq 'п ') {
-				my $city = substr ($text, 3);
-				$reply = weather ($city);
-			} elsif (length ($text) == 4 && (substr ($text, 1, 3) eq 'lat' || substr ($text, 1, 3) eq 'лат')) {
-				$reply = latAnswer();
-			} elsif ((length($text) > 8) || (substr ($text, 1, 6) eq 'karma ') || (substr ($text, 1, 6) eq 'карма ')) {
-				my $mytext = substr ($text, 7);
-				$mytext = trim ($mytext);
-				$reply = karmaGet ($chatid, $mytext);
-			} elsif ((length($text) > 8) || (substr ($text, 1, 6) eq 'karma ') || (substr ($text, 1, 6) eq 'карма ')) {
-				$reply = 'Простите, что? Карма пустоты?';
+				$reply = $hailo->{$msg->chat->id}->learn_reply ($phrase) if (length ($phrase) > 3);
 			}
+		# simple commands
+		} elsif (substr ($text, 0, 1) eq $csign) {
+			$reply = command ($self, $msg, $text, $chatid);
 		} elsif (
-				($text eq $qname) or
-				($text eq sprintf ('%s', $qtname)) or
-				($text eq sprintf ("@%s_bot", $qname)) or # :(
-				($text eq sprintf ('%s ', $qtname))
+				($text eq $myusername) or
+				($text eq '@' . $myusername) or
+				($text eq '@' . $myusername . ' ') or
+				($text eq $myfullname) or
+				($text eq $myfullname . ' ')
 			) {
 				$reply = 'Чего?';
 		} else {
+			my $qname = quotemeta ('@' . $myusername);
+			my $qtname = quotemeta $myfullname;
+
 			# phrase directed to bot
 			if ((lc ($text) =~ /^${qname}[\,|\:]? (.+)/) or (lc ($text) =~ /^${qtname}[\,|\:]? (.+)/)){
 				$phrase = $1;
@@ -384,11 +284,12 @@ MYHELP
 			} elsif ((lc ($text) =~ /.+ ${qtname}[\,|\!|\?|\.| ]/) or (lc ($text) =~ / $qtname$/)) {
 				$phrase = $text;
 				$reply = $hailo->{$msg->chat->id}->reply ($phrase);
-			} elsif ((substr ($text, -2) eq '++') && (substr ($text, -2) eq '--')) {
-				my @arr = split(/\n/, $text);
+			# karma adjustment
+			} elsif (substr ($text, -2) eq '++'  ||  substr ($text, -2) eq '--') {
+				my @arr = split /\n/, $text;
 
 				if ($#arr < 1) {
-					$reply = kermaSet ($chatid, $phrase, substr ($text, -2));
+					$reply = karmaSet ($chatid, trim (substr ($text, 0, -2)), substr ($text, -2));
 				} else {
 					# just message in chat
 					$hailo->{$msg->chat->id}->learn ($text);
@@ -399,35 +300,26 @@ MYHELP
 			}
 		}
 
-		if (defined ($reply) && $reply ne '' && $can_talk) {
+		if (defined ($reply) && $reply ne '') {
 			# work a bit more on input phrase
-			$phrase = trim ($phrase);
+			$phrase = trim $phrase;
 
 			while ($phrase =~ /[\.|\,|\?|\!]$/) {
 				chop $phrase;
 			}
 
-			$phrase = lc ($phrase);
+			$phrase = lc $phrase;
 
-			if (lc ($reply) eq $phrase) {
-				$reply = randomCommonPhrase();
-			} elsif (lc ($reply) eq substr ($phrase, 0, -1)) {
-				# in case of trailing dot
-				$reply = randomCommonPhrase();
-			} elsif (substr(lc ($reply), 0, -1) eq $phrase) {
-				$reply = randomCommonPhrase();
+			if (fmatch (lc ($reply), $phrase)) {
+				$reply = randomCommonPhrase ();
 			}
 
-			$msg->typing();
-			sleep (int (rand (2)));
-			logger sprintf ('In public chat %s (%s) bot reply to %s: %s', $chatname, $chatid, $vis_a_vi, $reply);
+			$msg->typing ();
+			sleep (irand 2);
+			carp sprintf ('[DEBUG] In public chat %s (%s) bot reply to %s: %s', $chatname, $chatid, $vis_a_vi, $reply) if $c->{debug};
 			$msg->reply ($reply);
 		} else {
-			if ($can_talk) {
-				logger sprintf ('In public chat %s (%s) bot is not required to reply to %s', $chatname, $chatid, $vis_a_vi);
-			} else {
-				logger sprintf ('In public chat %s (%s) bot can\'t talk, but reply to %s is: %s', $chatname, $chatid, $vis_a_vi, $reply);
-			}
+			carp sprintf ('[DEBUG] In public chat %s (%s) bot is not required to reply to %s', $chatname, $chatid, $vis_a_vi) if $c->{debug};
 		}
 
 # should be channel, so we can't talk
@@ -440,13 +332,18 @@ MYHELP
 
 # setup our bot
 sub init {
-	unless (-d $c->{telegrambot}->{braindir}) {
-		mkpath ($c->{telegrambot}->{braindir}, 0, 0755); ## no critic (ValuesAndExpressions::ProhibitLeadingZeros)
+	my $self = shift;
+	my $braindir = $c->{telegrambot}->{braindir};
+
+	unless (-d $braindir) {
+		make_path ($braindir, 0, 0755) or do { ## no critic (ValuesAndExpressions::ProhibitLeadingZeros)
+			cluck "Unable to create $braindir: $OS_ERROR";
+			exit 1;
+		};
 	}
 
-	my $self = shift;
 	$self->add_listener (\&__on_msg);
-	# $self->add_repeating_task(900, \&__cron);
+	$self->add_repeating_task (900, \&__cron);
 	return;
 }
 

lib/telegramlib.pm

@@ -1,37 +0,0 @@
-package telegramlib;
-# store here functions that are not implemented in Teapot::Bot
-
-use 5.018;
-use strict;
-use warnings;
-use utf8;
-use open qw(:std :utf8);
-
-use botlib qw(trim);
-use Teapot::Bot::Brain;
-
-# module shit
-use vars qw/$VERSION/;
-use Exporter qw(import);
-our @EXPORT_OK = qw(visavi);
-
-$VERSION = '1.0';
-
-sub visavi {
-	my ($userid, $username, $fullname) = @_;
-	my $name = '';
-
-	if (defined ($username)) {
-		$name .= '@' . $username;
-		$name .= ', ' . $fullname if (defined ($fullname));
-	} else {
-		$name .= $fullname;
-	}
-
-	$name .= " ($userid)";
-	return $name;
-}
-
-1;
-
-# vim: ft=perl noet ai ts=4 sw=4 sts=4:

lib/util.pm

@@ -0,0 +1,83 @@
+package util;
+
+use 5.018;
+use strict;
+use warnings;
+use utf8;
+use open qw (:std :utf8);
+use English qw ( -no_match_vars );
+use Digest::SHA qw (sha1_base64);
+use Encode;
+use MIME::Base64;
+use Text::Fuzzy qw (distance_edits);
+use URI::URL;
+
+use version; our $VERSION = qw (1.0);
+use Exporter qw (import);
+our @EXPORT_OK = qw (trim urlencode fmatch utf2b64 utf2sha1);
+
+sub trim {
+	my $str = shift;
+
+	if ($str eq '') {
+		return $str;
+	}
+
+	while (substr ($str, 0, 1) =~ /^\s$/xms) {
+		$str = substr $str, 1;
+	}
+
+	while (substr ($str, -1, 1) =~ /^\s$/xms) {
+		chop $str;
+	}
+
+	return $str;
+}
+
+sub urlencode {
+	my $str = shift;
+	my $urlobj = url $str;
+	return $urlobj->as_string;
+}
+
+sub fmatch {
+	my $srcphrase = shift;
+	my $answer = shift;
+
+	my ($distance, undef) = distance_edits ($srcphrase, $answer);
+	my $srcphraselen = length $srcphrase;
+	my $distance_max = int ($srcphraselen - ($srcphraselen * (100 - (90 / ($srcphraselen ** 0.5))) * 0.01));
+
+	if ($distance >= $distance_max) {
+		return 0;
+	} else {
+		return 1;
+	}
+}
+
+sub utf2b64 {
+	my $string = shift;
+
+	if ($string eq '') {
+		return encode_base64 '';
+	}
+
+	my $bytes = encode_utf8 $string;
+	return encode_base64 $bytes;
+}
+
+sub utf2sha1 {
+	my $string = shift;
+
+	if ($string eq '') {
+		return sha1_base64 '';
+	}
+
+	my $bytes = encode_utf8 $string;
+	return sha1_base64 $bytes;
+}
+
+
+1;
+
+# vim: set ft=perl noet ai ts=4 sw=4 sts=4:

lib/weather.pm

@@ -0,0 +1,180 @@
+package weather;
+
+use 5.018;
+use strict;
+use warnings;
+use utf8;
+use open qw (:std :utf8);
+use English qw ( -no_match_vars );
+use Carp qw (carp cluck);
+use CHI;
+use CHI::Driver::BerkeleyDB;
+use DB_File;
+use Digest::MD5 qw (md5_base64);
+use File::Path qw (make_path);
+use Mojo::Log;
+use Mojo::UserAgent::Cached;
+use conf qw (loadConf);
+use util qw (trim urlencode);
+
+use version; our $VERSION = qw (1.0);
+use Exporter qw (import);
+our @EXPORT_OK = qw (weather);
+
+my $c = loadConf ();
+
+sub weather {
+	my $city = shift;
+	$city = trim $city;
+
+	return 'Мне нужно ИМЯ города.' if ($city eq '');
+	return 'Длинновато для названия города.' if (length ($city) > 80);
+
+	$city = ucfirst $city;
+	my $w = __weather ($city);
+	my $reply;
+
+	if ($w) {
+		if ($w->{temperature_min} == $w->{temperature_max}) {
+			$reply = sprintf (
+				"Погода в городе %s, %s:\n%s, ветер %s %s м/c, температура %s°C, ощущается как %s°C, относительная влажность %s%%, давление %s мм.рт.с",
+				$w->{name},
+				$w->{country},
+				ucfirst $w->{description},
+				$w->{wind_direction},
+				$w->{wind_speed},
+				$w->{temperature_min},
+				$w->{temperature_feelslike},
+				$w->{humidity},
+				$w->{pressure}
+			);
+		} else {
+			$reply = sprintf (
+				"Погода в городе %s, %s:\n%s, ветер %s %s м/c, температура %s-%s°C, ощущается как %s°C, относительная влажность %s%%, давление %s мм.рт.ст",
+				$w->{name},
+				$w->{country},
+				ucfirst $w->{description},
+				$w->{wind_direction},
+				$w->{wind_speed},
+				$w->{temperature_min},
+				$w->{temperature_max},
+				$w->{temperature_feelslike},
+				$w->{humidity},
+				$w->{pressure}
+			);
+		}
+	} else {
+		$reply = "Я не знаю, какая погода в $city";
+	}
+
+	return $reply;
+}
+
+sub __weather {
+	my $city = shift;
+	$city = urlencode $city;
+	my $appid = $c->{openweathermap}->{appid};
+	my $cachedir = $c->{openweathermap}->{cachedir};
+	my $now = time ();
+	my $fc;
+	my $w;
+
+	my $r;
+
+	# try 3 times and giveup
+	for (1..3) {
+		my $ua = Mojo::UserAgent::Cached->new;
+		$ua->local_dir ($cachedir);
+		$ua->cache_agent(
+				CHI->new (
+				driver             => 'BerkeleyDB',
+				root_dir           => $cachedir,
+				namespace          => __PACKAGE__,
+				expires_in         => '3 hours',
+				expires_on_backend => 1,
+			)
+		);
+		# just to make Mojo::UserAgent::Cached happy
+		$ua->logger (Mojo::Log->new (path => '/dev/null', level => 'error'));
+		$r = $ua->get (sprintf ('http://api.openweathermap.org/data/2.5/weather?q=%s&lang=ru&APPID=%s', $city, $appid))->result;
+
+		if ($r->is_success) {
+			last;
+		}
+
+		sleep 2;
+	}
+
+	# all 3 times can give error, so check it here
+	if ($r->is_success) {
+		$fc = eval {
+			return $r->json;
+		};
+
+		unless ($fc) {
+			cluck "[WARN] openweathermap returns corrupted json: $EVAL_ERROR";
+			return undef;
+		};
+	} else {
+		cluck sprintf 'Server return status %s with message: %s', $r->code, $r->message;
+		return undef;
+	}
+
+	# TODO: check all of this for existence
+	$w->{'name'} = $fc->{name};
+	$w->{'state'} = $fc->{state};
+	$w->{'country'} = $fc->{sys}->{country};
+	$w->{'longitude'} = $fc->{coord}->{lon};
+	$w->{'latitude'} = $fc->{coord}->{lat};
+	$w->{'temperature_min'} = int ($fc->{main}->{temp_min} - 273.15);
+	$w->{'temperature_max'} = int ($fc->{main}->{temp_max} - 273.15);
+	$w->{'temperature_feelslike'} = int ($fc->{main}->{feels_like} - 273.15);
+	$w->{'humidity'} = $fc->{main}->{humidity};
+	$w->{'pressure'} = int ($fc->{main}->{pressure} * 0.75006375541921);
+	$w->{'description'} = $fc->{weather}->[0]->{description};
+	$w->{'wind_speed'} = $fc->{wind}->{speed};
+	$w->{'wind_direction'} = 'разный';
+	my $dir = int ($fc->{wind}->{deg} + 0);
+
+	if ($dir == 0) {
+		$w->{'wind_direction'} = 'северный';
+	} elsif ($dir > 0   && $dir <= 30) {
+		$w->{'wind_direction'} = 'северо-северо-восточный';
+	} elsif ($dir > 30  && $dir <= 60) {
+		$w->{'wind_direction'} = 'северо-восточный';
+	} elsif ($dir > 60  && $dir <  90) {
+		$w->{'wind_direction'} = 'восточно-северо-восточный';
+	} elsif ($dir == 90) {
+		$w->{'wind_direction'} = 'восточный';
+	} elsif ($dir > 90  && $dir <= 120) {
+		$w->{'wind_direction'} = 'восточно-юго-восточный';
+	} elsif ($dir > 120 && $dir <= 150) {
+		$w->{'wind_direction'} = 'юговосточный';
+	} elsif ($dir > 150 && $dir <  180) {
+		$w->{'wind_direction'} = 'юго-юго-восточный';
+	} elsif ($dir == 180) {
+		$w->{'wind_direction'} = 'южный';
+	} elsif ($dir > 180 && $dir <= 210) {
+		$w->{'wind_direction'} = 'юго-юго-западный';
+	} elsif ($dir > 210 && $dir <= 240) {
+		$w->{'wind_direction'} = 'юго-западный';
+	} elsif ($dir > 240 && $dir <  270) {
+		$w->{'wind_direction'} = 'западно-юго-западный';
+	} elsif ($dir == 270) {
+		$w->{'wind_direction'} = 'западный';
+	} elsif ($dir > 270 && $dir <= 300) {
+		$w->{'wind_direction'} = 'западно-северо-западный';
+	} elsif ($dir > 300 && $dir <= 330) {
+		$w->{'wind_direction'} = 'северо-западный';
+	} elsif ($dir > 330 && $dir <  360) {
+		$w->{'wind_direction'} = 'северо-северо-западный';
+	} elsif ($dir == 360) {
+		$w->{'wind_direction'} = 'северный';
+	}
+
+	return $w;
+}
+
+1;
+
+# vim: set ft=perl noet ai ts=4 sw=4 sts=4:

lib/xkcd.pm

@@ -0,0 +1,32 @@
+package xkcd;
+
+use 5.018;
+use strict;
+use warnings;
+use utf8;
+use open qw (:std :utf8);
+use Mojo::UserAgent;
+
+use version; our $VERSION = qw (1.0);
+use Exporter qw (import);
+our @EXPORT_OK = qw (xkcd);
+
+sub xkcd {
+	my $ua  = Mojo::UserAgent->new->connect_timeout (5)->max_redirects (0);
+	my $r = $ua->get ('https://xkcd.ru/random/')->result;
+
+	if (
+		defined $r->content &&
+		defined $r->content->headers &&
+		defined $r->content->headers->location &&
+		$r->content->headers->location ne ''
+	) {
+		return sprintf '[xkcd.ru](https://xkcd.ru/i/%s_v1.png)', substr ($r->content->headers->location, 1, -1);
+	}
+
+	return 'Комикс-стрип нарисовать не так-то просто :(';
+}
+
+1;
+
+# vim: set ft=perl noet ai ts=4 sw=4 sts=4: