Use ->canTalk() instead of ::canTalk() in Message.pm as it is more reliable way to check this

When I move bot from perl-5.30.0 to perl-5.32.1 I encounter with BDB0091
DB_VERSION_MISMATCH error And it looks like I have to export essential
data on older perl to some portable format and then import it on newer
perl environment.

.gitignore

@@ -1,12 +1,16 @@
 _Deparsed_XSubs.pm
 .idea/**
 .vscode/**
+.vstags
 aleesa-telegram-bot.pid
 data/cache/**
 data/config.json
 data/fortune/**
 data/friday/**
+data/gamestat/**
+data/image/**
 data/karma/**
-data/telegrambot-brains/**
 data/lat/**
+data/proverb/**
+data/telegrambot-brains/**
 vendor_perl/**

.perlcriticrc

@@ -52,7 +52,7 @@ verbose     = 8
 
 [-ValuesAndExpressions::ProhibitEmptyQuotes]
 # cause we consider following correct and useful:  my $var = '';
-# the recomended use of q{} looks too complex:     my $var = q{};
+# the recommended use of q{} looks too complex:     my $var = q{};
 
 [-ValuesAndExpressions::ProhibitNoisyQuotes]
 # Other people, other opinions: ","  is better readable than qw(,)
@@ -92,4 +92,3 @@ lib_sections    = NAME | VERSION | DESCRIPTION | AUTHOR | LICENSE AND COPYRIGHT
 
 [-ControlStructures::ProhibitDeepNests]
 # Have to use it, so fuckoff
-

Migration.txt

@@ -0,0 +1,30 @@
+Migration procedure.
+
+When you require to perform this procedure?
+- When perl version is changed
+- When migration to other OS or distribution occurs
+
+Why do i have to perform this procedure?
+- Some modules are vendored with bot
+- BDB can vary its on-disk format depending on dbd version that linked with
+  perl interpreter itself and its appropriate module.
+
+How can i guess that i miss to perform this procedure?
+Most notable symptom is 'BDB0091 DB_VERSION_MISMATCH' in logs and bot admin settings are lost.
+
+
+Procedure steps.
+
+On source system perform following steps:
+1. stop the bot, to unlock and close all files.
+2. make a backup
+3. prepare target system and copy bot to target system
+
+On target system perform these steps:
+1. remove vendor_perl dir in bot' directory
+2. run "bash bootstrap.sh" (no quotes) and wait until it successfully build and
+   install required modules.
+3. run perl bin/cache_import.pl script. It should create cache and exit
+   silently.
+
+Now it is possible to run bot without settings loss.

README.md

@@ -1,37 +1,99 @@
-# Aleesa-Telegram-bot - Simple Telegram chatty bot
+# Aleesa-Telegram-bot - Telegram chatty bot
+
+## Disclaimer
+
+This version - 3 (something) - considered stable. It means that further development of new features kind of frosen.
+Most effort will be targeted to future 4-th version development. If you have some ideas or fixes to this version
+feel free PR them, they will be merged as soon as being reviewed.
 
 ## About
 
-It is based on Perl modules [Telegram::Bot][1] and [Hailo][2] as conversation
+It is based on Perl modules [Telegram::Bot][1] and [Hailo][2] as conversation generator.
-generator.
 
-I have to fork [Telegram::Bot][1] and add some of new methods that are already
+I have to fork [Telegram::Bot][1] and update it according to features appeared in [Telegram Bot API v5][3]. Also,
-appear in [Telegram API][3], but author seems to abandon lib. Also, I decide to
+I decide to rename it to avoid collision in the future, now it is Teapot::Bot and is bundled with bot. When lib becomes
-rename it to avoid collision in the future, now it is Teapot::Bot and is bundled
+mature enough, maybe I release it separately.
-with bot. When lib become mature enough, maybe I release it separately.
 
-Bot config located in **data/config.json**, sample config provided as
+Bot config located in **data/config.json**, sample config provided as **data/sample_config.json**.
-**data/sample_config.json**.
 
-Bot can be run via **bin/aleesa-telegram-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
+Application have been tested on alpine linux x86_64 3.12, with perl-5.32.1 builtin.
-all required dependencies and libraries.
 
-You'll need "Development Tools" or similar group of packages, perl, perl-devel,
+In order to run this application, you need to "bootstrap" it - download and build all required dependencies and
-perl-local-lib, perl-app-cpanm, sqlite-devel, zlib-devel, openssl-devel,
+libraries.
-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 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 required, 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 third 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
+appropriate 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
+authorize 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 "verifier" 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 instructions - copy and paste given link to browser login to
+flickr account and you'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,104 @@
+# Aleesa-Telegram-bot - Болтливый бот для Telegram
+
+## Дисклеймер
+
+Эта версия бота за номером 3 (с мелочью) стабильная. Сие означает, что дальнейшего развития функций в этой версии не
+предполагается. Конечно, возможны исключения, но основной план - переключиться на 4-ю версию, куда планируется
+перенести большинство функций 3-й версии.
+
+Если у кого-то возникнут идеи относительно этой версии бота - ставьте PR, я только рад. Т.к. несмотря на то, что
+развитие этой версии "слегка" заморожено, поддерживать её планируется как минимум до выхода в свет 4-й версии бота.
+
+## Что это такое
+
+Это бот, основанный на перловых модулях [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).
+
+## Установка
+
+Приложение тестировалось на alpine linux x86_64 3.12, со встроенным perl-5.32.1.
+
+Чтобы запустить приложение, его надо "забурстрапить" - загрузить и собрать все необходимые зависимости.
+
+Понадобится 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

@@ -29,11 +29,12 @@ no Cwd;
 use Cwd::utf8 qw (chdir abs_path);
 use File::Basename qw (basename dirname);
 use File::Path qw (make_path);
+use Log::Any qw ($log);
 use Log::Any::Adapter;
 use Log::Any::For::Std;
 use POSIX qw (setgid setuid setsid);
-use conf qw (loadConf);
+use BotLib::Conf qw (LoadConf);
-use telegrambot qw (run_telegrambot);
+use TelegramBot qw (RunTelegramBot);
 
 sub daemonize;
 sub __fork;
@@ -43,7 +44,8 @@ local $OUTPUT_AUTOFLUSH = 1;
 my $runAsUid = $UID;
 
 my $piddir = '/var/run/' . basename (abs_path ($PROGRAM_NAME));
-my $C = loadConf ();
+my $C = LoadConf ();
+my $loglevel = $C->{'loglevel'} // 'notice';
 my $logfile;
 
 if (defined $C->{'log'}) {
@@ -92,7 +94,19 @@ if ($UID == 0) {
 }
 
 if (defined $logfile) {
-	Log::Any::Adapter->set ('File', $logfile);
+	Log::Any::Adapter->set ('File', $logfile, log_level => $loglevel);
+
+	# Some annoying CHI logging events come with category set to CHI::Driver and log_level set to debug.
+	# Until we use start using Log::Any native features and set whole loglevel accordingly, lets lower
+	# verbosity paticulary for CHI.
+	Log::Any::Adapter->set (
+		{
+			category => 'CHI::Driver'
+		},
+		'File',
+		$logfile,
+		log_level => 'warn'
+	);
 } else {
 	Log::Any::Adapter->set ('File', '/dev/null');
 }
@@ -104,14 +118,24 @@ daemonize ();
 my $apath = abs_path $PROGRAM_NAME;
 
 unless (defined $apath) {
-	die "[FATAL] Unable to get abs_path: $OS_ERROR\n";
+	$log->fatal ("[FATAL] Unable to get abs_path: $OS_ERROR\n");
+	exit 1;
 };
 
 # write pidfile
 my $pidfile = sprintf '%s/%s.pid', $piddir, basename $apath;
-warn "[INFO] Creating pidfile at $pidfile\n";
+$log->info ("[INFO] Creating pidfile at $pidfile");
-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";
+open my $MYPID, '>', $pidfile or do {
+	$log->fatal ("[FATAL] Error opening $pidfile: $OS_ERROR");
+	exit 1;
+};
+
+print {$MYPID} $PID or do {
+	$log->fatal ("[FATAL] Error writing to $pidfile: $OS_ERROR");
+	exit 1;
+};
+
 close $MYPID;                                        ## no critic (InputOutput::RequireCheckedSyscalls
 
 local $SIG{INT}  = \&__signal_handler;
@@ -121,7 +145,7 @@ local $SIG{TERM} = \&__signal_handler;
 $PROGRAM_NAME = abs_path $PROGRAM_NAME;              ## no critic (Variables::RequireLocalizedPunctuationVars)
 
 # run bot, at last
-run_telegrambot ();
+RunTelegramBot ();
 
 if (-f $pidfile) {
 	unlink $pidfile;
@@ -145,7 +169,8 @@ sub __fork {
 	my $pid = fork;
 
 	unless (defined $pid) {
-		die "[FATAL] Can't fork: $OS_ERROR\n";
+		$log->fatal ("[FATAL] Can't fork: $OS_ERROR");
+		exit 1;
 	}
 
 	if ($pid != 0) {
@@ -156,7 +181,7 @@ sub __fork {
 }
 
 sub __signal_handler {
-	warn "[INFO] Caught a signal $OS_ERROR\n";
+	$log->info ("[INFO] Caught a signal $OS_ERROR");
 
 	if (-f $pidfile) {
 		unlink $pidfile;

bin/cache_export.pl

@@ -0,0 +1,106 @@
+#!/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 CHI;
+use CHI::Driver::BerkeleyDB;
+use File::Basename qw (dirname);
+use File::Path qw (make_path);
+use JSON::XS;
+use Encode;
+
+use BotLib::Conf qw (LoadConf);
+
+my $c = LoadConf ();
+my $cachedir = $c->{cachedir};
+my $datadir = dirname $cachedir;
+my $export = 0;
+my $exportInst = 0;
+
+sub dumpCache {
+	my $namespace = shift;
+	my $cacheExportDir = sprintf '%s/cacheexport', $datadir;
+
+	unless (-d $cacheExportDir) {
+		make_path ($cacheExportDir)  ||  die "Unable to create $cacheExportDir: $OS_ERROR\n";
+	}
+
+	my $filename = sprintf '%s/%s', $cacheExportDir, $exportInst;
+
+	my $cache = CHI->new (
+		driver => 'BerkeleyDB',
+		root_dir => $cachedir,
+		namespace => $namespace
+	);
+
+	my $j;
+	my $writefile = 0;
+
+	foreach my $k ($cache->get_keys ()) {
+		$k = decode ('UTF-8', $k);
+		$j->{$k} = decode ('UTF-8', $cache->get ($k));
+		$writefile = 1;
+	}
+
+	if ($writefile) {
+		say "Dumping $namespace";  ## no critic (InputOutput::RequireCheckedSyscalls)
+		my $jsonencoder = JSON::XS->new->pretty ();
+		open (my $FILE, '>', $filename) or die "Unable to dump cache namespace $namespace to $filename: $OS_ERROR\n";
+		print $FILE $jsonencoder->encode ($j) or die "Unable to dump cache namespace $namespace to $filename: $OS_ERROR\n";;
+		close $FILE; ## no critic (InputOutput::RequireCheckedSyscalls)
+		my $EXPORTFD;
+
+		if ($export) {
+			open ($EXPORTFD, '>>', "$cacheExportDir/exportfiles.txt") or die "Unable to open for appending $cacheExportDir/exportfiles.txt: $OS_ERROR\n";
+		} else {
+			open ($EXPORTFD, '>', "$cacheExportDir/exportfiles.txt") or die "Unable to create $cacheExportDir/exportfiles.txt: $OS_ERROR\n";
+			$export = 1;
+		}
+
+		printf ($EXPORTFD "%s,%s\n", $namespace, $filename) or die "Unable to write to $cacheExportDir/exportfiles.txt: $OS_ERROR\n";
+		close $EXPORTFD; ## no critic (InputOutput::RequireCheckedSyscalls)
+		$exportInst++;
+	}
+
+	return;
+}
+
+opendir (my $DIR, $cachedir) or die "Unable to open $cachedir: $OS_ERROR\n";
+
+while (readdir $DIR) {
+	if (/^BotLib\+3a\+3aAdmin_censor_(.+)\.db$/) {
+		dumpCache ("BotLib::Admin_censor_$1");
+	} elsif (/^BotLib\+3a\+3aAdmin_fortune.db$/) {
+		dumpCache ('BotLib::Admin_fortune');
+	} elsif (/BotLib\+3a\+3aAdmin_plugin_(.+)\.db$/) {
+		dumpCache ("BotLib::Admin_plugin_$1");
+	} elsif (/BotLib\+3a\+3aAdmin_(.+)\.db$/) {
+		dumpCache ("BotLib::Admin_$1");
+	} elsif (/^BotLib\+3a\+3aImage\+3a\+3aFlickr\.db$/) {
+		dumpCache ('BotLib::Image::Flickr');
+	} elsif (/^BotLib\+3a\+3aKarma_(.+)\.db$/) {
+		dumpCache ("BotLib::Karma_$1");
+	}
+}
+
+closedir $DIR;
+exit 0;
+

bin/cache_import.pl

@@ -0,0 +1,86 @@
+#!/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 CHI;
+use CHI::Driver::BerkeleyDB;
+use File::Basename qw (dirname);
+use File::Path qw (make_path);
+use JSON::XS;
+use Encode;
+
+use BotLib::Conf qw (LoadConf);
+
+my $c = LoadConf ();
+my $cachedir = $c->{cachedir};
+my $datadir = dirname $cachedir;
+my $export = 0;
+
+sub createCache {
+	my $namespace = shift;
+	my $filename = shift;
+	say "Creating $namespace from $filename"; ## no critic (InputOutput::RequireCheckedSyscalls)
+
+	my $cache = CHI->new (
+		driver => 'BerkeleyDB',
+		root_dir => $cachedir,
+		namespace => $namespace
+	);
+
+	open my $FH, '<', $filename or die "Unable to open $filename: $OS_ERROR\n";
+	binmode $FH;
+	my $len = (stat $filename) [7];
+	my $json;
+	use bytes;
+	my $readlen = read $FH, $json, $len;
+	no bytes;
+
+	unless ($readlen) {
+		close $FH;                                   ## no critic (InputOutput::RequireCheckedSyscalls
+		die "Unable to read $filename: $OS_ERROR\n";
+	}
+
+	if ($readlen != $len) {
+		close $FH;                                   ## no critic (InputOutput::RequireCheckedSyscalls
+		die "File $filename is $len bytes on disk, but we read only $readlen bytes\n";
+	}
+
+	close $FH;                                       ## no critic (InputOutput::RequireCheckedSyscalls
+	my $j = JSON::XS->new->utf8->relaxed;
+	my $dump = $j->decode ($json);
+
+	foreach my $key (keys (%{$dump})) {
+		$cache->set ($key, $dump->{$key}, 'never');
+	}
+
+	return;
+}
+
+open (my $FH, '<', "$datadir/cacheexport/exportfiles.txt") or die "Unable to open $datadir/cacheexport/exportfiles.txt: $OS_ERROR\n";
+
+while (<$FH>) {
+	chomp;
+	my ($namespace, $filename) = split /\,/, $_, 2;
+	createCache ($namespace, $filename);
+}
+
+close $FH;  ## no critic (InputOutput::RequireCheckedSyscalls)
+exit 0;

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 BotLib::Image::Flickr qw (FlickrByTags);
+
+my $url = FlickrByTags ('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 BotLib::Image::Flickr qw (FlickrInit);
+
+if (FlickrInit ()) {
+	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 BotLib::Image::Flickr qw (FlickrTestLogin);
+
+if (FlickrTestLogin ()) {
+	exit 0;
+} else {
+	exit 1;
+}

bin/fortune_seed.pl

@@ -20,9 +20,7 @@ BEGIN {
 }
 
 use lib ("$workdir/lib", "$workdir/vendor_perl", "$workdir/vendor_perl/lib/perl5");
-use fortune qw (seed);
+use BotLib::Fortune qw (Seed);
-use Carp;
-local $SIG{__DIE__} = sub { Carp::confess @_ };
 
-seed ();
+Seed ();
 exit 0;

bin/friday_seed.pl

@@ -20,7 +20,7 @@ BEGIN {
 }
 
 use lib ("$workdir/lib", "$workdir/vendor_perl", "$workdir/vendor_perl/lib/perl5");
-use friday qw (seed);
+use BotLib::Friday qw (Seed);
 
-seed ();
+Seed ();
 exit 0;

bin/gamedata_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 BotLib::Gamestat qw (SeedArtifacts);
+
+SeedArtifacts ();
+exit 0;

bin/proverb_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 BotLib::Proverb qw (Seed);
+
+Seed ();
+exit 0;

bin/train_lat.pl

@@ -20,7 +20,7 @@ BEGIN {
 }
 
 use lib ("$workdir/lib", "$workdir/vendor_perl", "$workdir/vendor_perl/lib/perl5");
-use lat qw (train);
+use BotLib::Lat qw (Train);
 
-train ();
+Train ();
 exit 0;

cpanfile

@@ -1,25 +1,39 @@
-requires 'Carp';
+## no critic (TestingAndDebugging::RequireUseStrict,Modules::RequireVersionVar)
-requires 'Cwd::utf8';
+## no critic (TestingAndDebugging::RequireUseWarnings,Modules::RequireExplicitPackage)
-requires 'DB_File';
+## no critic (Modules::RequireEndWithOne)
-requires 'SQLite_File';
+requires 'Carp',                    '==1.50';
-requires 'Digest::MD5';
+requires 'CHI',                     '==0.61';
-requires 'Data::Dumper';
+requires 'CHI::Driver::BerkeleyDB', '==0.05';
-requires 'Digest::SHA';
+requires 'Cwd::utf8',               '==0.011';
-requires 'File::Basename';
+requires 'DateTime',                '==1.55';
-requires 'File::Path';
+requires 'DB_File',                 '==1.856';
-requires 'Hailo';
+requires 'SQLite_File',             '==0.1006';
-requires 'HTTP::Tiny';
+requires 'DBI',                     '==1.643';
-requires 'IO::Socket::SSL';
+requires 'DBD::SQLite',             '==1.70';
-requires 'JSON';
+requires 'Digest::HMAC_SHA1',       '==1.04';
-requires 'JSON::XS';
+requires 'Digest::MD5',             '==2.58';
-requires 'List::Util';
+requires 'Data::Dumper',            '==2.183';
-requires 'local::lib';
+requires 'Digest::SHA',             '==6.02';
-requires 'Log::Any';
+requires 'File::Basename',          '==2.85';
-requires 'Log::Any::Adapter';
+requires 'File::Path',              '==2.18';
-requires 'Log::Any::For::Std';
+requires 'Hailo',                   '==0.75';
-requires 'Math::Random::Secure';
+requires 'HTML::TokeParser',        '==3.76';
-requires 'Mojo::Base';
+requires 'IO::Socket::SSL',         '==2.074';
-requires 'Mojo::IOLoop';
+requires 'JSON',                    '==4.05';
-requires 'Mojo::UserAgent';
+requires 'JSON::PP',                '==4.07';
-requires 'Text::Fuzzy';
+requires 'JSON::XS',                '==4.03';
-requires 'URI::URL';
+requires 'List::Util',              '==1.60';
+requires 'local::lib',              '==2.000028';
+requires 'Log::Any',                '==1.710';
+requires 'Log::Any::Adapter',       '==1.710';
+requires 'Log::Any::For::Std',      '==0.05';
+requires 'Math::Random::Secure',    '==0.080001';
+requires 'Mojolicious',             '==9.22';
+requires 'Mojo::Base',              '0';
+requires 'Mojo::IOLoop',            '0';
+requires 'Mojo::UserAgent',         '0';
+requires 'Mojo::UserAgent::Cached', '==1.18';
+requires 'String::Random',          '==0.32';
+requires 'Text::Fuzzy',             '==0.29';
+requires 'URI::Encode::XS',         '==0.11';
+requires 'URI::URL',                '==5.10';

data/archeologic_artifacts.txt

@@ -0,0 +1,54 @@
+амулет Мерлина
+библиотеку Ивана Грозного
+деревянную плошку
+диплока
+доски Ноева Ковчега
+древний презерватив из бараньей кишки
+икону
+инсталятор Windows 3.11
+истлевший гроб
+каменный топор
+клад со златом-серебром
+кривой нож
+ледяную глыбу
+лунный грунт
+мамонта
+мамонтёнка
+метеорит
+мумию фараона Тутанхамона
+носки прапорщика (поставит в угол)
+обломки грузинской керамики
+птеродактиля
+рубль с Лениным
+рыцарские доспехи
+синий мох
+скелет
+скелет собаки по кличке Беня
+тиранозавтра
+тотем индейцев
+трубу с туркменским газом
+скорбь еврейского народа
+залежи активированного угля
+не очень новый завет
+мать леннарта поттеринга
+руководство "начинающему археологу"
+слово о полку игореве и дело о полку игореве, вместе с игорем
+телепрограмму канала A-one
+могилу искателя могил
+заплесневевший кусок хлеба
+преемник радиоприемника
+глушитель от ВАЗ-2106
+чувство удовлетворения
+крота
+воспоминания о былой любви
+грязистор
+египетское мумиё
+окаменелый камень
+кладку яиц рептилоида
+яму
+чеснок и стрелы
+доллар по 30
+несмазанные скрижали
+четырелобита
+чучело тролля
+целое ничего

data/fisher_artifacts.txt

@@ -0,0 +1,47 @@
+семикрылого чешуйчатого пятихуя
+разумного конденсатора
+сальмонеллу
+селёдку
+желтоперого тунца
+розовую сальмонеллу
+голавля
+барбуса
+окуня
+верхоплавку
+коричневую форель
+полярника
+плотву
+зубатку
+солнечную рыбу
+старую шину
+скользкую корягу
+лампу джина
+любовное послание в бутылке
+старое бревно
+резиновый сапог
+труп
+Лох-Несское чудовище
+старую рыбацкую приманку
+кусок Титаника
+обломок Атлантиды
+кита
+кальмара
+дельфина
+ската
+подводную лодку
+медузу
+морскую звезду
+электрического угря
+большую белую акулу
+аквалангиста
+монстра
+вируса
+сырую пачку сигарет
+водоросли
+якорь от лодки
+водяного
+русалку
+палтуса
+труп собаки по кличке Беня
+олигофрена Проню
+огеймера Фишкина

data/sample_config.json

@@ -1,31 +1,73 @@
 {
-    "user" : "nobody",
+    # Cachedir used not only for caches but for some settings and stats too.
-    "debug_log" : "/var/log/aleesa-telegram-bot/debug.log",
+    "cachedir" : "data/cache",
-    "admin" : {
+
-        "dir" : "data/admin"
+    "gamestat" : {
-    },
+        "dir" : "data",
-    "friday" : {
+        "gamestatdir" : "data/gamestat"
-        "dir" : "data/friday",
-        "src" : "data/friday.txt"
     },
+
     "fortune" : {
         "dir" : "data/fortune",
         "srcdir" : "data/fortune_src"
     },
-    "telegrambot" : {
+
-        "csign" : "!",
+    "proverb" : {
-        "token" : "get_it_from_botfather",
+        "dir" : "data/proverb",
-        "braindir": "data/telegrambot-brains"
+        "srcdir" : "data/proverb_src"
     },
-    "openweathermap" : {
+
-        "appid": "get_it_on_openweathermap.org",
+    "friday" : {
-        "cachedir" : "data/cache"
+        "dir" : "data/friday",
+        "src" : "data/friday.txt"
     },
+
+    "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"
+        }
+    },
+
     "lat" : {
-        "brain": "data/lat/lat.sqlite",
+        "brain": "data/lat/brain.sqlite",
         "src": "data/lat.txt"
     },
-    "karma" : {
+
-        "dir": "data/karma"
+    # Required for debugging reasons, if commented out or not exist, no debug logging appears at all.
-    }
+    "log" : "/var/log/aleesa-telegram-bot/aleesa.log",
+
+    # Verbosity can be trace, debug, info (inform), notice, warning (warn), error (err), critical (crit, fatal), alert, emergency.
+    # Currently implemented debug, info, notice, warn, error, fatal. Notice is default logging level.
+    "loglevel": "notice",
+
+    # Openwatermap plugin.
+    "openweathermap" : {
+        "appid" : "md5sum-like_string",
+    },
+
+    # 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. In case of this bot you can define what to use.
+        "csign" : "!",
+
+        "token" : "Long_string_given_by_@BotFather"
+    },
+
+    # Unprivileged user to run this bot from.
+    "user" : "unit",
 }

lib/BotLib.pm

@@ -0,0 +1,469 @@
+package BotLib;
+# store here utility functions that are not protocol-specified
+
+use 5.018;
+use strict;
+use warnings;
+use utf8;
+use open qw (:std :utf8);
+use English qw ( -no_match_vars );
+use Carp qw (carp);
+use Math::Random::Secure qw (irand);
+
+use BotLib::Conf qw (LoadConf);
+use BotLib::Admin qw (@ForbiddenMessageTypes GetForbiddenTypes AddForbiddenType
+                      DelForbiddenType ListForbidden FortuneToggle FortuneStatus
+                      PluginToggle PluginStatus PluginEnabled);
+use BotLib::Anek qw (Anek);
+use BotLib::Archeologist qw (Dig);
+use BotLib::Buni qw (Buni);
+use BotLib::Drink qw (Drink);
+use BotLib::Fisher qw (Fish);
+use BotLib::Fortune qw (Fortune);
+use BotLib::Friday qw (Friday);
+use BotLib::Image qw (Kitty Fox Oboobs Obutts Rabbit Owl Frog Horse Snail);
+use BotLib::Karma qw (KarmaSet KarmaGet);
+use BotLib::Lat qw (Lat);
+use BotLib::Monkeyuser qw (Monkeyuser);
+use BotLib::Proverb qw (Proverb);
+use BotLib::Util qw (trim);
+use BotLib::Weather qw (Weather);
+use BotLib::Xkcd qw (Xkcd);
+
+use version; our $VERSION = qw (1.0);
+use Exporter qw (import);
+our @EXPORT_OK = qw (RandomCommonPhrase Command Highlight BotSleep IsCensored);
+
+my $c = LoadConf ();
+my $csign = $c->{telegrambot}->{csign};
+
+sub RandomCommonPhrase {
+	my @myphrase = (
+		'Так, блядь...',
+		'*Закатывает рукава* И ради этого ты меня позвал?',
+		'Ну чего ты начинаешь, нормально же общались',
+		'Повтори свой вопрос, не поняла',
+		'Выйди и зайди нормально',
+		'Я подумаю',
+		'Даже не знаю, что на это ответить',
+		'Ты упал такие вопросы девочке задавать?',
+		'Можно и так, но не уверена',
+		'А как ты думаешь?',
+		'А ви, таки, почему интересуетесь?',
+	);
+
+	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 'coin' || substr ($text, 1) eq 'монетка') {
+		if (rand (101) < 0.016) {
+			$reply = 'ребро';
+		} else {
+			if (irand (2) == 0) {
+				if (irand (2) == 0) {
+					$reply = 'орёл';
+				} else {
+					$reply = 'аверс';
+				}
+			} else {
+				if (irand (2) == 0) {
+					$reply = 'решка';
+				} else {
+					$reply = 'реверс';
+				}
+			}
+		}
+	} elsif (substr ($text, 1) eq 'roll' || substr ($text, 1) eq 'dice' || substr ($text, 1) eq 'кости') {
+		$reply = sprintf 'На первой кости выпало %d, а на второй — %d.', irand (6) + 1, irand (6) + 1;
+	} elsif (substr ($text, 1) eq 'ver' || substr ($text, 1) eq 'version' || substr ($text, 1) eq 'версия') {
+		$reply = 'Версия:  Три.Чего-то_там.С_мелочью';
+	} elsif (substr ($text, 1) eq 'anek' || substr ($text, 1) eq 'анек' || substr ($text, 1) eq 'анекдот') {
+		$msg->typing ();
+		$reply = "```\n" . Anek () . "\n```";
+		sleep (irand (2) + 1);
+		$msg->replyMd ($reply);
+		return;
+	} 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, 7) eq 'погода ') {
+		my $city = substr $text, 7;
+		$reply = Weather $city;
+	} elsif ((substr ($text, 1, 8) eq 'погодка ') || (substr ($text, 1, 8) eq 'погадка ') || (substr ($text, 1, 8) eq 'weather ')){
+		my $city = substr $text, 8;
+		$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 'frog'  ||  substr ($text, 1) eq 'toad'  || substr ($text, 1) eq 'лягушка') {
+		$msg->typing ();
+		$reply = Frog ();
+		sleep (irand (2) + 1);
+		$msg->replyMd ($reply);
+		return;
+	} elsif (substr ($text, 1) eq 'horse'  ||  substr ($text, 1) eq 'лошадка') {
+		$msg->typing ();
+		$reply = Horse ();
+		sleep (irand (2) + 1);
+		$msg->replyMd ($reply);
+		return;
+	} elsif (substr ($text, 1) eq 'snail'  ||  substr ($text, 1) eq 'улитка') {
+		$msg->typing ();
+		$reply = Snail ();
+		sleep (irand (2) + 1);
+		$msg->replyMd ($reply);
+		return;
+	} elsif (substr ($text, 1) eq 'lat'  ||  substr ($text, 1) eq 'лат') {
+		$reply = Lat ();
+	} 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 'proverb'  ||  substr ($text, 1) eq 'пословица') {
+		$reply = Proverb ();
+	} 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 'хэлп' || substr ($text, 1) eq 'halp') {
+		$reply = 'HALP!!!11';
+	} elsif (substr ($text, 1) eq 'kde' || substr ($text, 1) eq 'кде') {
+		my @phrases = (
+			'Нет, я не буду поднимать вам плазму.',
+			'Повторяйте эту мантру по утрам не менее 5 раз: "Плазма не падает." И, возможно, она перестанет у вас падать.',
+			'Плазма не падает, она просто выходит отдохнуть.',
+			'Плазма это не агрегатное состояние, это суперпозиция. Во время работы она находится сразу в жидком, мягком и тёплом состояниях.',
+		);
+
+		$reply = $phrases[irand ($#phrases + 1)];
+	} elsif (substr ($text, 1) eq 'help'  ||  substr ($text, 1) eq 'помощь') {
+		$reply = << "MYHELP";
+```
+${csign}help | ${csign}помощь             - список команд
+${csign}anek | ${csign}анек | ${csign}анекдот    - рандомный анекдот с anekdot.ru
+${csign}buni                       - рандомный стрип hapi buni
+${csign}bunny | ${csign}rabbit | ${csign}кролик  - кролик
+${csign}cat | ${csign}кис                 - кошечка
+${csign}coin | ${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}frog | ${csign}лягушка            - лягушка
+${csign}horse | ${csign}лошадка           - лошадка
+${csign}lat | ${csign}лат                 - сгенерить фразу из крылатых латинских выражений
+${csign}monkeyuser                 - рандомный стрип MonkeyUser
+${csign}owl | ${csign}сова                - сова
+${csign}proverb | ${csign}пословица       - рандомная русская пословица
+${csign}ping | ${csign}пинг               - попинговать бота
+${csign}roll | ${csign}dice | ${csign}кости      - бросить кости
+${csign}snail | ${csign}улитка            - улитка
+${csign}ver | ${csign}version | ${csign}версия   - что-то про версию ПО
+${csign}w город | ${csign}п город         - погода в указанном городе
+${csign}weather город                     - погода в указанном городе
+${csign}погода город                      - погода в указанном городе
+${csign}погодка город                     - погода в указанном городе
+${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 = FortuneToggle ($chatid, 1);
+					} elsif ($args == 0) {
+						$reply = FortuneToggle ($chatid, 0);
+					}
+				} else {
+					$reply = FortuneStatus ($chatid);
+				}
+			} elsif ($cmd eq 'oboobs') {
+				if (defined $args) {
+					if ($args == 1) {
+						$reply = PluginToggle ($chatid, 'oboobs', 1);
+					} elsif ($args == 0) {
+						$reply = PluginToggle ($chatid, 'oboobs', 0);
+					}
+				} else {
+					$reply = PluginStatus ($chatid, 'oboobs');
+				}
+			} elsif ($cmd eq 'obutts') {
+				if (defined $args) {
+					if ($args == 1) {
+						$reply = PluginToggle ($chatid, 'obutts', 1);
+					} elsif ($args == 0) {
+						$reply = PluginToggle ($chatid, 'obutts', 0);
+					}
+				} else {
+					$reply = PluginStatus ($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;
+
+# vim: set ft=perl noet ai ts=4 sw=4 sts=4:

lib/BotLib/Admin.pm

@@ -0,0 +1,266 @@
+package BotLib::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 CHI;
+use CHI::Driver::BerkeleyDB;
+use BotLib::Conf qw (LoadConf);
+use BotLib::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 FortuneToggle FortuneToggleList FortuneStatus PluginToggle PluginStatus
+                     PluginEnabled);
+
+my $c = LoadConf ();
+my $cachedir = $c->{cachedir};
+# 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 GetForbiddenTypes {
+	my $chatid = shift;
+	my $messageTypes;
+
+	my $cache = CHI->new (
+		driver => 'BerkeleyDB',
+		root_dir => $cachedir,
+		namespace => __PACKAGE__ . '_' . 'censor' . '_' . utf2sha1 ($chatid)
+	);
+
+	foreach (@ForbiddenMessageTypes) {
+		my $type = $cache->get ($_);
+
+		if ($type) {
+			$messageTypes->{$_} = 1;
+		} else {
+			unless (defined $type) {
+				$cache->set ($_, 0, 'never');
+			}
+
+			$messageTypes->{$_} = 0;
+		}
+	}
+
+	return $messageTypes;
+}
+
+sub AddForbiddenType {
+	my $chatid = shift;
+	my $type = shift;
+
+	my $cache = CHI->new (
+		driver => 'BerkeleyDB',
+		root_dir => $cachedir,
+		namespace => __PACKAGE__ . '_' . 'censor' . '_' . utf2sha1 ($chatid)
+	);
+
+	$cache->set ($type, 1, 'never');
+	return;
+}
+
+sub DelForbiddenType {
+	my $chatid = shift;
+	my $type = shift;
+
+	my $cache = CHI->new (
+		driver => 'BerkeleyDB',
+		root_dir => $cachedir,
+		namespace => __PACKAGE__ . '_' . 'censor' . '_' . utf2sha1 ($chatid)
+	);
+
+	$cache->remove ($type);
+	return;
+}
+
+sub ListForbidden {
+	my $chatid = shift;
+	my @list;
+
+	my $cache = CHI->new (
+		driver => 'BerkeleyDB',
+		root_dir => $cachedir,
+		namespace => __PACKAGE__ . '_' . 'censor' . '_' . utf2sha1 ($chatid)
+	);
+
+	foreach (@ForbiddenMessageTypes) {
+		my $type = $cache->get ($_);
+
+		if ($type) {
+			push @list, sprintf 'Тип сообщения %s удаляется', $_;
+		} else {
+			unless (defined $type) {
+				$cache->set ($_, 0, 'never');
+			}
+
+			push @list, sprintf 'Тип сообщения %s не удаляется', $_;
+		}
+	}
+
+	return join "\n", @list;
+}
+
+sub FortuneToggle (@) {
+	my $chatid = shift;
+	my $action = shift // undef;
+	my $phrase = 'Фортунка с утра ';
+
+	my $cache = CHI->new (
+		driver => 'BerkeleyDB',
+		root_dir => $cachedir,
+		namespace => __PACKAGE__ . '_' . 'fortune'
+	);
+
+	my $state = $cache->get ($chatid);
+
+	if (defined $action) {
+		if ($action) {
+			$cache->set ($chatid, 1, 'never');
+			$phrase .= 'будет показываться.';
+		} else {
+			if (defined $state) {
+				$cache->remove ($chatid);
+			}
+
+			$phrase .= 'не будет показываться.';
+		}
+	} else {
+		if (defined $state && $state) {
+			$cache->remove ($chatid);
+			$phrase .= 'не будет показываться.';
+		} else {
+			$cache->set ($chatid, 1, 'never');
+			$phrase .= 'будет показываться.';
+		}
+	}
+
+	return $phrase;
+}
+
+sub FortuneStatus ($) {
+	my $chatid = shift;
+	my $phrase = 'Фортунка с утра ';
+
+	my $cache = CHI->new (
+		driver => 'BerkeleyDB',
+		root_dir => $cachedir,
+		namespace => __PACKAGE__ . '_' . 'fortune'
+	);
+
+	my $state = $cache->get ($chatid);
+
+	if (defined $state && $state) {
+		$phrase .= 'показывается.';
+	} else {
+		$phrase .= 'не показывается.';
+	}
+
+	return $phrase;
+}
+
+sub FortuneToggleList () {
+	my $cache = CHI->new (
+		driver => 'BerkeleyDB',
+		root_dir => $cachedir,
+		namespace => __PACKAGE__ . '_' . 'fortune'
+	);
+
+	return $cache->get_keys ();
+}
+
+sub PluginStatus (@) {
+	my $chatid = shift;
+	my $plugin = shift;
+	my $phrase = "Плагин $plugin ";
+
+	my $cache = CHI->new (
+		driver => 'BerkeleyDB',
+		root_dir => $cachedir,
+		namespace => __PACKAGE__ . '_' . 'plugin' . '_' . utf2sha1 ($chatid)
+	);
+
+	my $state = $cache->get ($plugin);
+
+	if ($state) {
+		$phrase .= 'включён.';
+	} else {
+		unless (defined $state) {
+			$cache->set ($plugin, 0, 'never');
+		}
+
+		$phrase .= 'выключен.';
+	}
+
+	return $phrase;
+}
+
+sub PluginEnabled (@) {
+	my $chatid = shift;
+	my $plugin = shift;
+
+	# seems that we have point to return always true if chat is private
+	if ($chatid > 0) {
+		return 1;
+	}
+
+	my $cache = CHI->new (
+		driver => 'BerkeleyDB',
+		root_dir => $cachedir,
+		namespace => __PACKAGE__ . '_' . 'plugin' . '_' . utf2sha1 ($chatid)
+	);
+
+	my $state = $cache->get ($plugin);
+
+	if (defined $state && $state) {
+		return 1;
+	} else {
+		return 0;
+	}
+}
+
+sub PluginToggle (@) {
+	my $chatid = shift;
+	my $plugin = shift;
+	my $action = shift // undef;
+	my $phrase = "Плагин $plugin ";
+
+	my $cache = CHI->new (
+		driver => 'BerkeleyDB',
+		root_dir => $cachedir,
+		namespace => __PACKAGE__ . '_' . 'plugin' . '_' . utf2sha1 ($chatid)
+	);
+
+	my $state = $cache->get ($plugin);
+
+	if (defined $action) {
+		if ($action) {
+			$cache->set ($plugin, 1, 'never');
+			$phrase .= 'включён';
+		} else {
+			$cache->set ($plugin, 0, 'never');
+			$phrase .= 'выключен';
+		}
+	} else {
+		if (defined ($state) && $state) {
+			$cache->set ($plugin, 0, 'never');
+			$phrase .= 'включён';
+		} else {
+			$cache->set ($plugin, 1, 'never');
+			$phrase .= 'выключен';
+		}
+	}
+
+	return $phrase;
+}
+
+1;
+
+# vim: set ft=perl noet ai ts=4 sw=4 sts=4:

lib/BotLib/Anek.pm

@@ -0,0 +1,88 @@
+package BotLib::Anek;
+
+use 5.018;
+use strict;
+use warnings;
+use utf8;
+use open qw (:std :utf8);
+use English qw ( -no_match_vars );
+use Encode;
+use HTML::TokeParser;
+use JSON::XS;
+use Log::Any qw ($log);
+use Mojo::UserAgent;
+
+use version; our $VERSION = qw (1.0);
+use Exporter qw (import);
+our @EXPORT_OK = qw (Anek);
+
+sub Anek {
+	my $r;
+	my $ret = 'Все рассказчики анекдотов отдыхают';
+	my $got_anek = 0;
+
+	for (1..3) {
+		for (1..3) {
+			my $ua  = Mojo::UserAgent->new->connect_timeout (3);
+			$ua->max_redirects(3);
+			$r = $ua->get ('https://www.anekdot.ru/rss/randomu.html')->result;
+
+			if ($r->is_success) {
+				last;
+			}
+
+			sleep 2;
+		}
+
+		if ($r->is_success) {
+			my $json;
+			my $response_text = decode ('UTF-8', $r->body);
+			my @text = split /\n/, $response_text;
+
+			while (my $str = pop @text) {
+				if ($str =~ /^var anekdot_texts \= JSON/) {
+					$str = (split /JSON\.parse\(\'/, $str, 2)[1];
+
+					if (defined $str && length ($str) > 10) {
+						$json = (split /\';\)/, $str, 2)[0];
+						last;
+					}
+				}
+			}
+
+			if (defined $json && length ($json) > 10) {
+				$json =~ s/\\"/"/g;
+				$json =~ s/\\\\"/\\"/g;
+				$json = substr $json, 0, -3;
+
+				my $anek = eval { ${JSON::XS->new->relaxed->decode ($json)}[0] };
+
+				if (defined $anek) {
+					my @anek = split /<br>/, $anek;
+					$ret = join "\n", @anek;
+
+					if (length ($ret) > 1) {
+						$got_anek = 1;
+					}
+				} else {
+					$log->warn (sprintf '[WARN] anekdot.ru server returns incorrect json, full response text message: %s', $response_text);
+				}
+			} else {
+				$log->warn (sprintf '[WARN] anekdot.ru server returns unexpected response text: %s', $r->body);
+			}
+
+		} else {
+			$log->warn (sprintf '[WARN] anekdot.ru server return status %s with message: %s', $r->code, $r->message);
+		}
+
+		if ($got_anek) {
+			last;
+		}
+	}
+
+	return $ret;
+}
+
+1;
+
+# vim: set ft=perl noet ai ts=4 sw=4 sts=4:

lib/BotLib/Archeologist.pm

@@ -0,0 +1,108 @@
+package BotLib::Archeologist;
+
+use 5.018;
+use strict;
+use warnings;
+use utf8;
+use open qw (:std :utf8);
+use English qw ( -no_match_vars );
+use DBI;
+use Log::Any qw ($log);
+use Math::Random::Secure qw (irand);
+
+use BotLib::Conf qw (LoadConf);
+
+use version; our $VERSION = qw (1.0);
+use Exporter qw (import);
+our @EXPORT_OK = qw (Dig);
+
+my $c = LoadConf ();
+my $gamestatdir = $c->{gamestat}->{gamestatdir};
+my $dbfile = sprintf '%s/gamestat.sqlite', $gamestatdir;
+
+
+sub getRandomArtifact {
+	my $dbh;
+	$dbh = DBI->connect ("dbi:SQLite:$dbfile", '', '') or do {
+		$log->error (sprintf '[ERROR] Unable to get random artifact, sqlite error: %s', $dbh->errstr);
+		return undef;
+	};
+
+	$dbh->{sqlite_unicode} = 1;
+
+	my $rows_affected = $dbh->do ('PRAGMA foreign_keys=ON') or do {
+		$log->error (sprintf '[ERROR] Unable to get random artifact, sqlite error: %s', $dbh->errstr);
+		return undef;
+	};
+
+	$rows_affected = $dbh->do ('PRAGMA journal_mode=WAL') or do {
+		$log->error (sprintf '[ERROR] Unable to get random artifact, sqlite error: %s', $dbh->errstr);
+		return undef;
+	};
+
+	my $ary_ref = $dbh->selectall_arrayref ('SELECT name FROM artifacts WHERE id > 0 AND id < 10000') or do {
+		$log->error (sprintf '[ERROR] Unable to get random artifact, sqlite error: %s', $dbh->errstr);
+		return undef;
+	};
+
+	$dbh->disconnect or $log->warn (sprintf '[WARN] Unable to close gamestat db, sqlite error: %s', $dbh->errstr);
+
+	return $ary_ref->[irand ($#{ $ary_ref } + 1)]->[0];
+}
+
+sub Dig {
+	my $name = shift;
+
+	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";
+	my $artifact = getRandomArtifact();
+
+	if ($success_probability <= 25) {
+		$phrase .= sprintf '%s стал лучшим археологом, выкопав %s! возраст артефакта - %s лет!', $name, $artifact, $artifact_age;
+	} else {
+		$phrase .= sprintf "Поздравляю, %s! Вы только что выкопали %s, возраст - %s лет!\n", $name, $artifact, $artifact_age;
+		$phrase .= sprintf 'Извини, %s, но на артефакт это не тянет! Однако, попытка хорошая!', $name;
+	}
+
+	return $phrase;
+}
+
+1;
+
+# vim: set ft=perl noet ai ts=4 sw=4 sts=4:

lib/BotLib/Buni.pm

@@ -0,0 +1,60 @@
+package BotLib::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 Log::Any qw ($log);
+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);
+		$ua->max_redirects(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 {
+		$log->warn (sprintf '[WARN] Bunicomic 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/BotLib/Conf.pm

@@ -1,4 +1,4 @@
-package conf;
+package BotLib::Conf;
 # loads config
 
 use 5.018;
@@ -11,9 +11,9 @@ use JSON::XS;
 
 use version; our $VERSION = qw (1.0);
 use Exporter qw (import);
-our @EXPORT_OK = qw (loadConf);
+our @EXPORT_OK = qw (LoadConf);
 
-sub loadConf {
+sub LoadConf {
 	my $c = 'data/config.json';
 	open my $CH, '<', $c or die "[FATAL] No conf at $c: $OS_ERROR\n";
 	my $len = (stat $c) [7];

lib/BotLib/Drink.pm

@@ -0,0 +1,115 @@
+package BotLib::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 Log::Any qw ($log);
+use Mojo::Log;
+use Mojo::UserAgent::Cached;
+use POSIX qw (strftime);
+use BotLib::Conf qw (LoadConf);
+
+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);
+my $c = LoadConf ();
+my $cachedir = $c->{cachedir};
+
+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           => $cachedir,
+				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 {
+		$log->warn (sprintf '[WARN] Kakoysegodnyaprazdnik 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/BotLib/Fisher.pm

@@ -1,4 +1,4 @@
-package fisher;
+package BotLib::Fisher;
 
 use 5.018;
 use strict;
@@ -6,66 +6,54 @@ use warnings;
 use utf8;
 use open qw (:std :utf8);
 use English qw ( -no_match_vars );
+use DBI;
+use Log::Any qw ($log);
 use Math::Random::Secure qw (irand);
 
+use BotLib::Conf qw (LoadConf);
+
 use version; our $VERSION = qw (1.0);
 use Exporter qw (import);
-our @EXPORT_OK = qw (fish);
+our @EXPORT_OK = qw (Fish);
+
+my $c = LoadConf ();
+my $gamestatdir = $c->{gamestat}->{gamestatdir};
+my $dbfile = sprintf '%s/gamestat.sqlite', $gamestatdir;
 
 
-sub fish {
+sub getRandomArtifact {
+	my $dbh;
+	$dbh = DBI->connect ("dbi:SQLite:$dbfile", '', '') or do {
+		$log->error (sprintf '[ERROR] Unable to get random artifact, sqlite error: %s', $dbh->errstr);
+		return undef;
+	};
+
+	$dbh->{sqlite_unicode} = 1;
+
+	my $rows_affected = $dbh->do ('PRAGMA foreign_keys=ON') or do {
+		$log->error (sprintf '[ERROR] Unable to get random artifact, sqlite error: %s', $dbh->errstr);
+		return undef;
+	};
+
+	$rows_affected = $dbh->do ('PRAGMA journal_mode=WAL') or do {
+		$log->error (sprintf '[ERROR] Unable to get random artifact, sqlite error: %s', $dbh->errstr);
+		return undef;
+	};
+
+	my $ary_ref = $dbh->selectall_arrayref ('SELECT name FROM artifacts WHERE id > 9999 AND id < 20000') or do {
+		$log->error (sprintf '[ERROR] Unable to get random artifact, sqlite error: %s', $dbh->errstr);
+		return undef;
+	};
+
+	$dbh->disconnect or $log->warn (sprintf '[WARN] Unable to close gamestat db, sqlite error: %s', $dbh->errstr);
+
+	return $ary_ref->[irand ($#{ $ary_ref } + 1)]->[0];
+}
+
+
+sub Fish {
 	my $name = shift;
 
-	my @artifact = (
-		'семикрылого чешуйчатого пятихуя',
-		'разумного конденсатора',
-		'сальмонеллу',
-		'селёдку',
-		'желтоперого тунца',
-		'розовую сальмонеллу',
-		'голавля',
-		'барбуса',
-		'окуня',
-		'верхоплавку',
-		'коричневую форель',
-		'полярника',
-		'плотву',
-		'зубатку',
-		'солнечную рыбу',
-		'старую шину',
-		'скользкую корягу',
-		'лампу джина',
-		'любовное послание в бутылке',
-		'старое бревно',
-		'резиновый сапог',
-		'труп',
-		'Лох-Несское чудовище',
-		'старую рыбацкую приманку',
-		'кусок Титаника',
-		'обломок Атлантиды',
-		'кита',
-		'кальмара',
-		'дельфина',
-		'ската',
-		'подводную лодку',
-		'медузу',
-		'морскую звезду',
-		'электрического угря',
-		'большую белую акулу',
-		'аквалангиста',
-		'монстра',
-		'вируса',
-		'сырую пачку сигарет',
-		'водоросли',
-		'якорь от лодки',
-		'водяного',
-		'русалку',
-		'палтуса',
-		'труп собаки по кличке Беня',
-		'олигофрена Проню',
-		'огеймера Фишкина',
-	);
-
 	my @location = (
 		'в поток',
 		'в озеро',
@@ -117,7 +105,8 @@ sub fish {
 		return $phrase;
 	}
 
-	$phrase .= sprintf "Поздравляю, %s! Вы только что поймали %s! аж на %d кило!\n\n", $name, $artifact[irand ($#artifact + 1)], $weight;
+	my $artifact = getRandomArtifact ();
+	$phrase .= sprintf "Поздравляю, %s! Вы только что поймали %s! аж на %d кило!\n\n", $name, $artifact, $weight;
 
 	if ($success_probability <= 25) {
 		$phrase .= sprintf 'Ё-мое!!! А это ведь новый рекорд! Продолжай в том же духе, %s!', $name;

lib/BotLib/Fortune.pm

@@ -1,4 +1,4 @@
-package fortune;
+package BotLib::Fortune;
 # Any fortune_mod sources are suitable. Text file with "\n%\n" sentence delimeter.
 
 use 5.018;
@@ -9,19 +9,20 @@ use open qw (:std :utf8);
 use English qw ( -no_match_vars );
 use Carp qw (cluck croak);
 use File::Path qw (make_path);
+use Log::Any qw ($log);
 use Math::Random::Secure qw (irand);
 use SQLite_File;
-use conf qw (loadConf);
+use BotLib::Conf qw (LoadConf);
 
 use version; our $VERSION = qw (1.0);
 use Exporter qw (import);
-our @EXPORT_OK = qw (seed fortune);
+our @EXPORT_OK = qw (Seed Fortune);
 
-my $c = loadConf ();
+my $c = LoadConf ();
 my $dir = $c->{fortune}->{dir};
 my $srcdir = $c->{fortune}->{srcdir};
 
-sub seed () {
+sub Seed () {
 	unless (-d $dir) {
 		make_path ($dir)  ||  croak "Unable to create $dir: $OS_ERROR";
 	}
@@ -65,11 +66,11 @@ sub seed () {
 }
 
 # just return answer
-sub fortune () {
+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";
+		$log->error ("[ERROR] Unable to tie to $backingfile: $OS_ERROR");
 		return '';
 	};
 

lib/BotLib/Friday.pm

@@ -1,4 +1,4 @@
-package friday;
+package BotLib::Friday;
 # for friday data stolen from https://raw.githubusercontent.com/isida/vi/master/data/friday.txt
 
 use 5.018;
@@ -9,20 +9,21 @@ use open qw (:std :utf8);
 use English qw ( -no_match_vars );
 use Carp qw (cluck croak);
 use File::Path qw (make_path);
+use Log::Any qw ($log);
 use Math::Random::Secure qw (irand);
 use SQLite_File;
-use conf qw (loadConf);
+use BotLib::Conf qw (LoadConf);
 
 use version; our $VERSION = qw (1.0);
 use Exporter qw (import);
-our @EXPORT_OK = qw (seed friday);
+our @EXPORT_OK = qw (Seed Friday);
 
-my $c = loadConf ();
+my $c = LoadConf ();
 my $dir = $c->{friday}->{dir};
 my $srcfile = $c->{friday}->{src};
 my @dow = qw (monday tuesday wednesday thursday friday saturday sunday);
 
-sub seed () {
+sub Seed () {
 	unless (-d $dir) {
 		make_path ($dir)  ||  croak "Unable to create $dir: $OS_ERROR";
 	}
@@ -75,12 +76,12 @@ sub seed () {
 }
 
 # just return answer
-sub friday () {
+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";
+		$log->error ("[ERROR] Unable to tie to $backingfile: $OS_ERROR\n");
 		return '';
 	};
 

lib/BotLib/Gamestat.pm

@@ -0,0 +1,115 @@
+package BotLib::Gamestat;
+# Stores and calculates player stats for games
+
+use 5.018;
+use strict;
+use warnings;
+use utf8;
+use open qw (:std :utf8);
+use DBI;
+use English qw ( -no_match_vars );
+use File::Path qw (make_path);
+use String::Random qw (random_string);
+
+use BotLib::Conf qw (LoadConf);
+use BotLib::Util qw (trim utf2sha1);
+
+use version; our $VERSION = qw (1.0);
+use Exporter qw (import);
+our @EXPORT_OK = qw (SeedArtifacts);
+
+
+my $c = LoadConf ();
+my $dir = $c->{gamestat}->{dir};
+my $gamestatdir = $c->{gamestat}->{gamestatdir};
+my $dbfile = sprintf '%s/gamestat.sqlite', $gamestatdir;
+
+# assume that there is not too much artifacts.
+sub SeedArtifacts {
+	open (my $AFH, '<', "$dir/archeologic_artifacts.txt") || die "No $dir/archeologic_artifacts.txt\n";
+	my @arch_artifacts;
+
+	while (my $artifact = <$AFH>) {
+		next if ($artifact =~ /^\s*$/);
+		$artifact = trim ($artifact);
+		push @arch_artifacts, $artifact;
+	}
+
+	close $AFH; ## no critic (InputOutput::RequireCheckedSyscalls)
+
+	open ($AFH, '<', "$dir/fisher_artifacts.txt") || die "No $dir/fisher_artifacts.txt\n";
+	my @fisher_artifacts;
+
+	while (my $artifact = <$AFH>) {
+		next if ($artifact =~ /^\s*$/);
+		$artifact = trim ($artifact);
+		push @fisher_artifacts, $artifact;
+	}
+
+	close $AFH; ## no critic (InputOutput::RequireCheckedSyscalls)
+	undef $AFH;
+
+	my $tablename = random_string ('..........');
+	$tablename = utf2sha1 ($tablename);
+
+	while ($tablename =~ /^\d/) {
+		$tablename = utf2sha1 ($tablename);
+	}
+
+	$tablename =~ s/[\/_\+]/a/g;
+	$tablename = lc ($tablename);
+
+	unless (-d $gamestatdir) {
+		make_path ($gamestatdir)  ||  die "Unable to create $gamestatdir: $OS_ERROR\n";
+	}
+
+	my $dbh = DBI->connect ("dbi:SQLite:$dbfile", '', '');
+	$dbh->{sqlite_unicode} = 1;
+	my $rows_affected = $dbh->do ('PRAGMA foreign_keys=ON') or die $dbh->errstr . "\n";
+	$rows_affected = $dbh->do ('PRAGMA journal_mode=WAL') or die $dbh->errstr . "\n";
+
+	# Open transaction
+	$dbh->begin_work or die $dbh->errstr . "\n";
+
+	my $query = <<"QUERY";
+CREATE TABLE IF NOT EXISTS $tablename (
+	id INT UNIQUE NOT NULL, -- artifact id
+	name TEXT PRIMARY KEY   -- artifact name
+);
+QUERY
+
+	$rows_affected = $dbh->do ($query) or die $dbh->errstr . "\n";
+	my $sth = $dbh->prepare ("REPLACE INTO $tablename(id,name) VALUES (?,?)") or die $dbh->errstr . "\n";
+
+	# Insert our archeological artifacts
+	my $counter = 0;
+
+	foreach my $artifact (@arch_artifacts) {
+		last if ($counter == 10000);
+		$sth->execute ($c, $artifact);
+		$counter++;
+	}
+
+	# Insert our fishing artifacts
+	$counter = 10000;
+
+	foreach my $artifact (@fisher_artifacts) {
+		last if ($counter == 20000);
+		$sth->execute ($c, $artifact);
+		$counter++;
+	}
+
+	# Add indexes
+	$rows_affected = $dbh->do ("CREATE INDEX IF NOT EXISTS myartifactid ON $tablename(id)") or die $dbh->errstr . "\n";
+
+	# Drop target table and replace it with our
+	$rows_affected = $dbh->do ('DROP TABLE IF EXISTS artifacts') or die $dbh->errstr . "\n";
+	$rows_affected = $dbh->do ("ALTER TABLE $tablename RENAME TO artifacts") or die $dbh->errstr . "\n";
+
+	# Close transaction
+	$dbh->commit or die $dbh->errstr . "\n";
+	$dbh->disconnect or warn (sprintf '[WARN] Unable to close gamestat db, sqlite error: %s', $dbh->errstr) . "\n";
+	return;
+}
+
+1;

lib/BotLib/Image.pm

@@ -0,0 +1,241 @@
+package BotLib::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 Log::Any qw ($log);
+use Math::Random::Secure qw (irand);
+use Mojo::UserAgent;
+use BotLib::Image::Flickr qw (FlickrByTags);
+use BotLib::Image::Imgur qw (Imgur);
+use BotLib::Util qw (urlencode);
+
+use version; our $VERSION = qw (1.0);
+use Exporter qw (import);
+our @EXPORT_OK = qw (Kitty Fox Oboobs Obutts Rabbit Owl Frog Horse Snail);
+
+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) {
+			$log->warn ("[WARN] Unable to decode JSON from thecatapi: $EVAL_ERROR");
+		} else {
+			if ($jcat->[0]->{url}) {
+				my @cats = ('龴ↀ◡ↀ龴', '=^..^=', '≧◔◡◔≦ ','^ↀᴥↀ^');
+				$ret = sprintf '[%s](%s)', $cats[irand ($#cats + 1)], $jcat->[0]->{url};
+			}
+		}
+	} else {
+		$log->warn (sprintf '[WARN] Thecatapi 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) {
+			$log->warn ("[WARN] Unable to decode JSON from randomfox: $EVAL_ERROR");
+		} else {
+			if ($jfox->{image}) {
+				$jfox->{image} =~ s/\\//xmsg;
+				$ret = sprintf '[-^^,--,~](%s)', $jfox->{image};
+			}
+		}
+	} else {
+		$log->warn (sprintf '[WARN] Randomfox 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) {
+			$log->warn ("[WARN] Unable to decode JSON from oboobs: $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 {
+		$log->warn (sprintf '[WARN] Oboobs 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) {
+			$log->warn ("[ERROR] Unable to decode JSON from obutts: $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 {
+		$log->warn (sprintf '[WARN] Obutts server return status %s with message: %s', $r->code, $r->message);
+	}
+
+	return $ret;
+}
+
+# It works but results are not particularly 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 = FlickrByTags ('animal,bunny');
+
+	if (defined $url) {
+		return sprintf '[(\_/)](%s)', $url;
+	} else {
+		return 'Нету кроликов, все разбежались.';
+	}
+}
+
+sub Owl {
+	my $url = FlickrByTags ('bird,owl');
+
+	if (defined $url) {
+		return sprintf '[{ O v O }](%s)', $url;
+	} else {
+		return 'Нету сов, все разлетелись.';
+	}
+}
+
+sub Frog {
+	# unable to find any one-line ascii art for frog :(
+	my @art = qw (frog toad лягушка);
+	my $url = FlickrByTags ('frog,toad,amphibian');
+
+	if (defined $url) {
+		return sprintf '[%s](%s)', $art [irand ($#art + 1)], $url;
+	} else {
+		return 'Нету лягушек, все свалили.';
+	}
+}
+
+sub Horse {
+	# unable to find any one-line ascii art for frog :(
+	my @art = qw (horse лошадь лошадка);
+	my $url = FlickrByTags ('horse,equine,mammal');
+
+	if (defined $url) {
+		return sprintf '[%s](%s)', $art [irand ($#art + 1)], $url;
+	} else {
+		return 'Нету коняшек, все разбежались.';
+	}
+}
+
+sub Snail {
+	# unable to find any one-line ascii art for frog :(
+	my @art = qw ('-'_@_ @╜ @_'-');
+	my $url = FlickrByTags ('snail,slug');
+
+	if (defined $url) {
+		return sprintf '[%s](%s)', $art [irand ($#art + 1)], $url;
+	} else {
+		return 'Нету улиток, все расползлись.';
+	}
+}
+1;
+
+# vim: set ft=perl noet ai ts=4 sw=4 sts=4:

lib/BotLib/Image/Flickr.pm

@@ -0,0 +1,599 @@
+package BotLib::Image::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 CHI;
+use CHI::Driver::BerkeleyDB;
+use Digest::HMAC_SHA1 qw (hmac_sha1);
+use Log::Any qw ($log);
+use Math::Random::Secure qw (irand);
+use MIME::Base64;
+use Mojo::UserAgent;
+use URI::Encode::XS qw (uri_encode);
+
+use BotLib::Conf qw (LoadConf);
+use BotLib::Util qw (urlencode);
+
+use Data::Dumper;
+
+use version; our $VERSION = qw (1.0);
+use Exporter qw (import);
+our @EXPORT_OK = qw (FlickrInit FlickrByTags FlickrByText FlickrTestLogin);
+
+my $c = LoadConf ();
+my $cachedir = $c->{cachedir};
+
+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->code == 302) {
+		return $r->content->headers->location;
+	} else {
+		printf "Something went wrong: %s %s\n", $r->code, $r->message;
+		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 {
+					$log->warn ("[WARN] Flickr api returns incorrect json: $r->message");
+					return undef;
+				}
+			} else {
+				$log->warn ("[WARN] Flickr api returns incorrect json: $r->message");
+				return undef;
+			}
+		} else {
+			$log->warn ("[WARN] Flickr api returns incorrect json: $r->message");
+			return undef;
+		}
+	} else {
+		$log->warn ("[WARN] Flickr api 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 {
+					$log->warn ("[WARN] Flickr api returns incorrect json: $r->message");
+					return undef;
+				}
+			} else {
+				$log->warn ("[WARN] Flickr api returns incorrect json: $r->message");
+				return undef;
+			}
+		} else {
+			$log->warn ("[WARN] Flickr api returns incorrect json: $r->message");
+			return undef;
+		}
+	} else {
+		$log->warn ("[WARN] Flickr api HTTP status code not 200: $r->code, $r->message");
+		return undef;
+	}
+}
+
+sub FlickrInit {
+	my $cache = CHI->new (
+		driver => 'BerkeleyDB',
+		root_dir => $cachedir,
+		namespace => __PACKAGE__
+	);
+
+	if (defined $flickr_verifier && $flickr_verifier) {
+		my $flickr_request_token = $cache->get ('flickr_request_token');
+		my $flickr_request_token_secret = $cache->get ('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 config db.';    ## no critic (InputOutput::RequireCheckedSyscalls)
+			say 'Please remove verifier settings from config.json and run this script again.';   ## no critic (InputOutput::RequireCheckedSyscalls)
+			return 0;
+		}
+
+		my %accessToken = flickrAccessToken ($flickr_request_token, $flickr_request_token_secret, $flickr_verifier);
+
+		if (defined ($accessToken{oauth_token}) && defined ($accessToken{oauth_token_secret})) {
+			# TODO: check set
+			$cache->set ('flickr_access_token', $accessToken{oauth_token}, 'never');
+			$cache->set ('flickr_access_token_secret', $accessToken{oauth_token_secret}, 'never');
+
+			say sprintf ( ## no critic (InputOutput::RequireCheckedSyscalls)
+				'Access token (%s) and access token secret (%s) are config db',
+				$accessToken{oauth_token},
+				$accessToken{oauth_token_secret},
+			);
+
+			return 1;
+		}
+	} else {
+		my %req = flickrRequestToken ();
+		if (defined ($req{oauth_token}) && defined ($req{oauth_token_secret}) && defined ($req{oauth_token})) {
+			# TODO: check set
+			$cache->set ('flickr_request_token', $req{oauth_token}, 'never');
+			$cache->set ('flickr_request_token_secret', $req{oauth_token_secret}, 'never');
+			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)
+				return 1;
+			}
+		}
+	}
+
+	return 0;
+}
+
+sub FlickrTestLogin {
+	my $text = shift;
+	my $cache = CHI->new (
+		driver => 'BerkeleyDB',
+		root_dir => $cachedir,
+		namespace => __PACKAGE__
+	);
+
+	my $flickr_access_token = $cache->get ('flickr_access_token');
+	my $flickr_access_token_secret = $cache->get ('flickr_access_token_secret');
+
+	if (flickrTestLogin ($flickr_access_token, $flickr_access_token_secret)) {
+		return 1;
+	} else {
+		return 0;
+	}
+}
+
+sub FlickrByTags {
+	my $text = shift;
+
+	my $cache = CHI->new (
+		driver => 'BerkeleyDB',
+		root_dir => $cachedir,
+		namespace => __PACKAGE__
+	);
+
+	my $flickr_access_token = $cache->get ('flickr_access_token');
+	my $flickr_access_token_secret = $cache->get ('flickr_access_token_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 {
+			$log->notice ('[NOTICE] Flickr api returns empty search result list');
+			return;
+		}
+	} else {
+		return;
+	}
+}
+
+sub FlickrByText {
+	my $text = shift;
+
+	my $cache = CHI->new (
+		driver => 'BerkeleyDB',
+		root_dir => $cachedir,
+		namespace => __PACKAGE__
+	);
+
+	my $flickr_access_token = $cache->get ('flickr_access_token');
+	my $flickr_access_token_secret = $cache->get ('flickr_access_token_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 {
+			$log->notice ('[NOTICE] Flickr api returns empty search result list');
+			return;
+		}
+	} else {
+		return;
+	}
+}
+
+1;

lib/BotLib/Image/Imgur.pm

@@ -0,0 +1,151 @@
+package Botlib::Image::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 CHI;
+use CHI::Driver::BerkeleyDB;
+use Log::Any qw ($log);
+use Math::Random::Secure qw (irand);
+use Mojo::UserAgent;
+
+use BotLib::Conf qw (LoadConf);
+
+use version; our $VERSION = qw (1.0);
+use Exporter qw (import);
+our @EXPORT_OK = qw (Imgur);
+
+my $c = LoadConf ();
+my $cachedir = $c->{cachedir};
+
+sub Imgur {
+	my $tag = shift;
+
+	my $refresh_url   = 'https://api.imgur.com/oauth2/token';
+	my $search_url    = 'https://api.imgur.com/3/gallery/search/';
+
+	my $imgur_client_id     = $c->{image}->{imgur}->{client_id} // do {
+		$log->error ('[ERROR] No client_id specified in config for imgur module');
+		return undef;
+	};
+	my $imgur_client_secret = $c->{image}->{imgur}->{client_secret} // do {
+		$log->error ('[ERROR] No client_secret specified in config for imgur module');
+		return undef;
+	};
+	my $imgur_access_token  = $c->{image}->{imgur}->{access_token} // do {
+		$log->error ('[ERROR] No access_token specified in config for imgur module');
+		return undef;
+	};
+	my $imgur_refresh_token = $c->{image}->{imgur}->{refresh_token} // do {
+		$log->warn ('[WARN] No refresh_token specified in config for imgur module');
+	};
+
+	# N.B. Both imgur_access_token and imgur_refresh_token time to time can change, so we need
+	#      some place where we can store new values
+	my $cache = CHI->new (
+		driver => 'BerkeleyDB',
+		root_dir => $cachedir,
+		namespace => __PACKAGE__
+	);
+
+	$imgur_access_token = $cache->get ('imgur_access_token');
+
+	# if there is no access_token in db - put there one from config
+	unless (defined $imgur_access_token) {
+		$cache->set ('imgur_access_token', $c->{image}->{imgur}->{access_token}, 'never');
+	}
+
+	$imgur_refresh_token = $cache->get ('imgur_refresh_token');
+
+	# if there is no refresh_token in db - put there one from config
+	unless (defined $imgur_refresh_token) {
+		$cache->set ('imgur_refresh_token', $c->{image}->{imgur}->{refresh_token}, 'never');
+	}
+
+	# 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,
+				client_secret => $imgur_client_secret,
+				grant_type => 'refresh_token',
+			}
+		);
+
+		unless ($r->is_success) {
+			$log->error ("[ERROR] Unable to refresh imgur token, please re-authorise app! or imgur experiencing api outage: $r->code $r->message");
+			return undef;
+		}
+
+		my $refresh = eval { return $r->json; };
+
+		if (defined $refresh) {
+			$imgur_refresh_token = $refresh->{refresh_token};
+			$cache->set ('refresh_token', $refresh->{refresh_token}, 'never');
+			$imgur_access_token = $refresh->{access_token};
+			$cache->set ('imgur_access_token', $refresh->{access_token}, 'never');
+		} else {
+			$log->warn ("[ERROR] Unable to refresh imgur access_token, unable to decode json: $EVAL_ERROR");
+			return undef;
+		}
+
+		# query api again
+		$r = $ua->get ($search_url . $tag => {Authorization => "Bearer $imgur_access_token"})->result;
+	}
+
+	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 {
+					$log->notice ('[NOTICE] Imgur api returned empty result.');
+					return undef;
+				}
+			} else {
+				$log->warn ("[WARN] Unable to get results from imgur api: $r->message");
+				return undef;
+			}
+		} else {
+			$log->warn ("[WARN] Unable to decode imgur api json: $EVAL_ERROR");
+			return undef;
+		}
+	} else {
+		$log->warn ("[WARN] Unable to get results from imgur api: $r->code, $r->message");
+		return undef;
+	}
+}
+
+1;

lib/BotLib/Karma.pm

@@ -0,0 +1,104 @@
+package BotLib::Karma;
+
+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 CHI;
+use CHI::Driver::BerkeleyDB;
+use Log::Any qw ($log);
+use BotLib::Conf qw (LoadConf);
+
+use version; our $VERSION = qw (1.0);
+use Exporter qw (import);
+our @EXPORT_OK = qw (KarmaSet KarmaGet);
+
+my $c = LoadConf ();
+my $cachedir = $c->{cachedir};
+my $max = 5;
+
+# swallow phrase and return answer
+sub KarmaSet (@) {
+	my $chatid = shift;
+	my $phrase = shift;
+	my $action = shift;
+
+	if (($phrase eq '') || ($phrase =~ /^ +$/)) {
+		$phrase = ' ';
+	}
+
+	my $cache = CHI->new (
+		driver => 'BerkeleyDB',
+		root_dir => $cachedir,
+		namespace => __PACKAGE__ . '_' . $chatid
+	);
+
+	my $score = $cache->get ($phrase);
+
+	if (defined $score) {
+		if ($action eq '++') {
+			$score++;
+		} else {
+			$score--;
+		}
+	} else {
+		if ($action eq '++') {
+			$score = 1;
+		} else {
+			$score = -1;
+		}
+	}
+
+	if ($cache->set ($phrase, $score, 'never') != $score) {
+		$log->error ('[ERROR] Cache error: unable to set karma.');
+	}
+
+	if ($score < -1 && (($score % (0 - $max)) + 1) == 0) {
+		if ($phrase eq ' ') {
+			return sprintf 'Зарегистрировано пробитие дна, карма пустоты составляет %d', $score;
+		} else {
+			return sprintf 'Зарегистрировано пробитие дна, карма %s составляет %d', $phrase, $score;
+		}
+	} else {
+		if ($phrase eq ' ') {
+			return sprintf 'Карма пустоты составляет %d', $score;
+		} else {
+			return sprintf 'Карма %s составляет %d', $phrase, $score;
+		}
+	}
+}
+
+# just return answer
+sub KarmaGet (@) {
+	my $chatid = shift;
+	my $phrase = shift;
+
+	if (($phrase eq '') || ($phrase =~ /^ +$/)) {
+		$phrase = ' ';
+	}
+
+	my $cache = CHI->new (
+		driver => 'BerkeleyDB',
+		root_dir => $cachedir,
+		namespace => __PACKAGE__ . '_' . $chatid
+	);
+
+	my $score = $cache->get ($phrase);
+
+	unless (defined $score) {
+		$score = 0;
+	}
+
+	if ($phrase eq ' ') {
+		return sprintf 'Карма пустоты составляет %d', $score;
+	} else {
+		return sprintf 'Карма %s составляет %d', $phrase, $score;
+	}
+}
+
+1;
+
+# vim: ft=perl noet ai ts=4 sw=4 sts=4:

lib/BotLib/Lat.pm

@@ -1,4 +1,4 @@
-package lat;
+package BotLib::Lat;
 # famous latin phases taken from https://ru.wikipedia.org/wiki/Список_крылатых_латинских_выражений
 
 use 5.018;
@@ -11,17 +11,18 @@ use Carp qw (cluck);
 use File::Basename qw (dirname);
 use File::Path qw (make_path);
 use Hailo;
-use conf qw (loadConf);
+use Log::Any qw ($log);
+use BotLib::Conf qw (LoadConf);
 
 use version; our $VERSION = qw (1.0);
 use Exporter qw (import);
-our @EXPORT_OK = qw (train latAnswer);
+our @EXPORT_OK = qw (Train Lat);
 
-my $c = loadConf ();
+my $c = LoadConf ();
 my $brain = $c->{lat}->{brain};
 my $srcfile = $c->{lat}->{src};
 
-sub train () {
+sub Train () {
 	my $braindir = dirname $brain;
 
 	unless (-d $braindir) {
@@ -45,16 +46,16 @@ sub train () {
 }
 
 # just return answer
-sub latAnswer () {
+sub Lat () {
 	my $braindir = dirname $brain;
 
 	unless (-d $braindir) {
-		cluck "[ERROR] No lat module data: $braindir is absent! Train lat first.";
+		$log->error ("[ERROR] No lat module data: $braindir is absent! Train lat first.");
 		return '';
 	}
 
 	unless (-f $brain) {
-		cluck "[ERROR] No lat module data: $brain is absent! Train lat first.";
+		$log->error ("[ERROR] No lat module data: $brain is absent! Train lat first.");
 		return '';
 	}
 

lib/BotLib/Monkeyuser.pm

@@ -0,0 +1,63 @@
+package BotLib::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 Log::Any qw ($log);
+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 {
+		$log->warn (sprintf '[WARN] MonkeyUser 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/BotLib/Proverb.pm

@@ -0,0 +1,88 @@
+package BotLib::Proverb;
+# 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 Log::Any qw ($log);
+use Math::Random::Secure qw (irand);
+use SQLite_File;
+use BotLib::Conf qw (LoadConf);
+use BotLib::Util qw (trim);
+
+use version; our $VERSION = qw (1.0);
+use Exporter qw (import);
+our @EXPORT_OK = qw (Seed Proverb);
+
+my $c = LoadConf ();
+my $dir = $c->{proverb}->{dir};
+my $srcdir = $c->{proverb}->{srcdir};
+
+sub Seed () {
+	unless (-d $dir) {
+		make_path ($dir)  ||  croak "Unable to create $dir: $OS_ERROR";
+	}
+
+	my $backingfile = sprintf '%s/proverb.sqlite', $dir;
+
+	if (-f $backingfile) {
+		unlink $backingfile   ||  croak "Unable to remove $backingfile: $OS_ERROR";
+	}
+
+	tie my @proverb, 'SQLite_File', $backingfile  ||  croak "Unable to tie to $backingfile: $OS_ERROR";
+	opendir (my $srcdirhandle, $srcdir)  ||  croak "Unable to open $srcdir: $OS_ERROR";
+
+	while (my $proverbfile = readdir ($srcdirhandle)) {
+		my $srcfile = sprintf '%s/%s', $srcdir, $proverbfile;
+
+		unless (-f $srcfile) {
+			next;
+		}
+
+		if ($proverbfile =~ m/^\.+$/) {
+			next;
+		}
+
+		open (my $fh, '<', $srcfile)  ||  croak "Unable to open $srcfile, $OS_ERROR";
+
+		while (readline $fh) {
+			chomp;
+			my $str = trim ($_);
+
+			if ($str ne '') {
+				push @proverb, $str;
+			}
+		}
+
+		close $fh;  ## no critic (InputOutput::RequireCheckedSyscalls, InputOutput::RequireCheckedOpen)
+	}
+
+	closedir $srcdirhandle;
+	untie @proverb;
+	return;
+}
+
+# just return answer
+sub Proverb () {
+	my $backingfile = sprintf '%s/proverb.sqlite', $dir;
+
+	tie my @array, 'SQLite_File', $backingfile  ||  do {
+		$log->error ("[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/BotLib/Util.pm

@@ -1,4 +1,4 @@
-package util;
+package BotLib::Util;
 
 use 5.018;
 use strict;
@@ -77,7 +77,6 @@ sub utf2sha1 {
 	return sha1_base64 $bytes;
 }
 
-
 1;
 
 # vim: set ft=perl noet ai ts=4 sw=4 sts=4:

lib/BotLib/Weather.pm

@@ -1,4 +1,4 @@
-package weather;
+package BotLib::Weather;
 
 use 5.018;
 use strict;
@@ -7,21 +7,22 @@ use utf8;
 use open qw (:std :utf8);
 use English qw ( -no_match_vars );
 use Carp qw (carp cluck);
-use DB_File;
+use CHI;
-use Digest::MD5 qw (md5_base64);
+use CHI::Driver::BerkeleyDB;
-use File::Path qw (make_path);
+use Log::Any qw ($log);
-use HTTP::Tiny;
+use Mojo::Log;
-use JSON::XS;
+use Mojo::UserAgent::Cached;
-use conf qw (loadConf);
+use BotLib::Conf qw (LoadConf);
-use util qw (trim urlencode);
+use BotLib::Util qw (trim urlencode);
 
 use version; our $VERSION = qw (1.0);
 use Exporter qw (import);
-our @EXPORT_OK = qw (weather);
+our @EXPORT_OK = qw (Weather);
 
-my $c = loadConf ();
+my $c = LoadConf ();
+my $cachedir = $c->{cachedir};
 
-sub weather {
+sub Weather {
 	my $city = shift;
 	$city = trim $city;
 
@@ -29,12 +30,22 @@ sub weather {
 	return 'Длинновато для названия города.' if (length ($city) > 80);
 
 	$city = ucfirst $city;
+
+	if ($city eq 'Мск' || $city eq 'Default' || $city eq 'Dc' || $city eq 'Msk' || $city eq 'Dc-universe') {
+		$city = 'Москва';
+	} elsif ($city eq 'Спб' || $city eq 'Spb') {
+		$city = 'Санкт-Петербург';
+	} elsif ($city eq 'Ект' || $city eq 'Ебург' || $city eq 'Ёбург' || $city eq 'Екат' || $city eq 'Ekt' || $city eq 'Eburg' || $city eq 'Ekat') {
+		$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 мм.рт.с",
+			$reply = sprintf (
+				"Погода в городе %s, %s:\n%s, ветер %s %s м/c, температура %s°C, ощущается как %s°C, относительная влажность %s%%, давление %s мм.рт.ст",
 				$w->{name},
 				$w->{country},
 				ucfirst $w->{description},
@@ -45,8 +56,23 @@ sub weather {
 				$w->{humidity},
 				$w->{pressure}
 			);
+		} elsif ($w->{temperature_min} < 0 && $w->{temperature_max} <= 0) {
+			$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_max},
+				$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 мм.рт.ст",
+			$reply = sprintf (
+				"Погода в городе %s, %s:\n%s, ветер %s %s м/c, температура от %s до %s°C, ощущается как %s°C, относительная влажность %s%%, давление %s мм.рт.ст",
 				$w->{name},
 				$w->{country},
 				ucfirst $w->{description},
@@ -69,77 +95,52 @@ sub weather {
 sub __weather {
 	my $city = shift;
 	$city = urlencode $city;
-	my $id = md5_base64 $city;
 	my $appid = $c->{openweathermap}->{appid};
-	my $cachedir = $c->{openweathermap}->{cachedir};
-	my $cachetimefile = $cachedir . '/openweathermap.Id-Timestamp.db';
-	my $cachedatafile = $cachedir . '/openweathermap.Id-Data.db';
 	my $now = time ();
 	my $fc;
 	my $w;
 
-	unless (-d $cachedir) {
+	my $r;
-		make_path ($cachedir)  ||  do {
+
-			cluck "[ERROR] Unable to create $cachedir: $OS_ERROR";
+	# try 3 times and giveup
-			return;
+	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;
 		};
-	}
 
-	# attach to cache data
+		unless ($fc) {
-	tie my %cachetime, 'DB_File', $cachetimefile or do {
+			$log->warn ("[WARN] openweathermap returns corrupted json: $EVAL_ERROR");
-		carp "[ERROR] Something nasty happen when cachetime ties to its data: $OS_ERROR";
-		return undef;
-	};
-
-	tie my %cachedata, 'DB_File', $cachedatafile or do {
-		carp "[ERROR] 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) {
-			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));
-
-			if ($r->{success}) {
-				last;
-			}
-
-			sleep 2;
-		}
-
-		# all 3 times can give error, so check it here
-		if ($r->{success}) {
-			$fc = eval {
-				decode_json $r->{content};
-			};
-
-			if ($EVAL_ERROR) {
-				cluck "[WARN] openweathermap returns corrupted json: $EVAL_ERROR";
-				untie %cachetime;
-				untie %cachedata;
-				return undef;
-			};
-
-			$cachetime{$id} = $now;
-			$cachedata{$id} = encode_json $fc;
-		} else {
-			cluck sprintf 'Server return status %s with message: %s', $r->{status}, $r->{reason};
-			untie %cachetime;
-			untie %cachedata;
 			return undef;
-		}
+		};
+	} else {
+		$log->warn (sprintf '[WARN] Server return status %s with message: %s', $r->code, $r->message);
+		return undef;
 	}
 
-	untie %cachetime;
-	untie %cachedata;
-
 	# TODO: check all of this for existence
 	$w->{'name'} = $fc->{name};
 	$w->{'state'} = $fc->{state};

lib/BotLib/Xkcd.pm

@@ -0,0 +1,47 @@
+package BotLib::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 $location;
+	my $status = 400;
+	my $c = 0;
+
+	do {
+		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 ''
+		) {
+			$location = substr $r->content->headers->location, 1, -1;
+			$location = sprintf 'https://xkcd.ru/i/%s_v1.png', $location;
+			$r = $ua->head ($location)->result;
+		}
+
+		$c++;
+		$status = $r->code;
+	} while ($c < 3 || $status >= 404);
+
+	if ($status == 200) {
+		return sprintf '[xkcd.ru](%s)', $location;
+	}
+
+	return 'Комикс-стрип нарисовать не так-то просто :(';
+}
+
+1;
+
+# vim: set ft=perl noet ai ts=4 sw=4 sts=4:

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;
@@ -17,6 +18,13 @@ use Log::Any;
 use Data::Dumper;
 
 use Teapot::Bot::Object::Message;
+use Teapot::Bot::Object::Poll;
+use Teapot::Bot::Object::PollAnswer;
+use Teapot::Bot::Object::ChatMemberUpdated;
+use Teapot::Bot::Object::User;
+use Teapot::Bot::Object::Chat;
+use Teapot::Bot::Object::ChatMember;
+use Teapot::Bot::Object::ChatInviteLink;
 
 $Teapot::Bot::Brain::VERSION = '0.022';
 
@@ -76,7 +84,7 @@ sub think {
   $self->init();
 
   $self->_add_getUpdates_handler;
-  Mojo::IOLoop->start until Mojo::IOLoop->is_running;
+  do { Mojo::IOLoop->start } until Mojo::IOLoop->is_running;
   return;
 }
 
@@ -131,6 +139,61 @@ sub getChatMember {
   }
 }
 
+sub banChatMember {
+  my $self = shift;
+  my $args = shift || {};
+
+  my $token = $self->token || croak 'No token supplied to banChatMember?';
+  my $send_args = {};
+
+  unless ($args->{chat_id}) {
+    cluck 'No chat_id supplied to banChatMember()';
+    return {'error' => 1};
+  }
+
+  unless ($args->{user_id}) {
+    cluck 'No user_id supplied to banChatMember()';
+    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}/banChatMember";
+  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 +222,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 || {};
@@ -276,7 +361,7 @@ sub deleteMessage {
 
   my $token = $self->token || croak 'No token supplied to deleteMessage()?';
 
-  if (Teapot::Bot::Object::ChatMember::canDeleteMessage($self, $args->{chat_id})) {
+  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);
   }
@@ -355,11 +440,11 @@ sub sendChatAction {
   elsif ($args->{action} eq 'upload_video') {
     $send_args->{action} = 'upload_video';
   }
-  elsif ($args->{action} eq 'record_audio') {
+  elsif ($args->{action} eq 'record_voice') {
-    $send_args->{action} = 'record_audio';
+    $send_args->{action} = 'record_voice';
   }
-  elsif ($args->{action} eq 'upload_audio') {
+  elsif ($args->{action} eq 'upload_voice') {
-    $send_args->{action} = 'upload_audio';
+    $send_args->{action} = 'upload_voice';
   }
   elsif ($args->{action} eq 'upload_document') {
     $send_args->{action} = 'upload_document';
@@ -373,6 +458,9 @@ sub sendChatAction {
   elsif ($args->{action} eq 'upload_video_note') {
     $send_args->{action} = 'upload_video_note';
   }
+  elsif ($args->{action} eq 'choose_sticker') {
+    $send_args->{action} = 'choose_sticker';
+  }
   else {
     $send_args->{action} = 'typing';
   }
@@ -384,6 +472,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;
@@ -402,11 +605,18 @@ sub _add_getUpdates_handler {
 
     $self->ua->get($updateURL => sub {
       my ($ua, $tx) = @_;
-      my $res = $tx->res->json;
+      my $res = eval { $tx->res->json; };
-      my $items = $res->{result};
+
-      foreach my $item (@{$items}) {
+      # it looks like we can catch an error here if timeout or something bad occurs,
-        $last_update_id = $item->{update_id};
+      # try not to die in this case or we risk to stuck with $http_active=1 forever
-        $self->_process_message($item);
+      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;
@@ -425,11 +635,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->{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->{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->{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->{edited_channel_post}, $self)             if $item->{edited_channel_post};
-    $update = Teapot::Bot::Object::Message->create_from_hash($item->{poll}, $self)                if $item->{poll};
+    # 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
@@ -440,7 +663,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;
@@ -577,6 +808,25 @@ of Chat User.
 
 On error returns hash reference with error set to 1
 
+=head2 banChatMember
+
+This is the wrapper around the C<banChatMember> API method. See
+L<https://core.telegram.org/bots/api#banchatmember>.
+
+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
@@ -588,6 +838,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>.
@@ -625,6 +884,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/Animation.pm

@@ -8,6 +8,7 @@ use Carp qw/croak/;
 $Teapot::Bot::Object::Animation::VERSION = '0.022';
 
 has 'file_id';
+has 'file_unique_id';
 has 'width';
 has 'height';
 has 'duration';
@@ -17,7 +18,8 @@ has 'mime_type';
 has 'file_size';
 
 sub fields {
-  return { scalar                           => [qw/file_id width height duration file_name mime_type file_size/],
+  return { 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/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 'performer'; # Optional. Performer of the audio as defined by sender or by audio tags
-has 'title';
+has 'title';     # Optional. Title of the audio as defined by sender or by audio tags
-has 'mime_type';
+has 'file_name'; # Optional. Original filename as defined by sender
-has 'file_size';
+has 'mime_type'; # Optional. MIME type of the file as defined by sender
-has 'thumb'; #PhotoSize
+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

@@ -5,6 +5,7 @@ use Mojo::Base -base;
 use List::Util qw/any/;
 use Carp qw/croak cluck/;
 use Data::Dumper;
+use JSON::PP ();
 
 $Teapot::Bot::Object::Base::VERSION = '0.022';
 
@@ -42,6 +43,28 @@ sub _field_is_array_of_arrays {
   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 ($array);
+    return $obj;
+  }
+
+  cluck "Dumping class: " . Dumper ($class);
+  cluck "Dumping array: " . Dumper ($array);
+
+# it's stub, return $obj
+  return $obj;
+}
 
 # create an object from a hash. Needs to deal with the nested types, and
 # arrays
@@ -57,6 +80,10 @@ sub create_from_hash {
   }
 
   unless (ref ($hash) eq 'HASH') {
+    if (ref ($hash) eq 'ARRAY') {
+      return create_from_array($class, $hash, $brain);
+    }
+
     cluck 'Not a hash ' . Dumper ($hash);
     return $obj;
   }

lib/Teapot/Bot/Object/Chat.pm

@@ -11,27 +11,36 @@ $Teapot::Bot::Object::Chat::VERSION = '0.022';
 
 has 'id';
 has 'type';
-has 'title';               # Optional.
+has 'title';                    # Optional.
-has 'username';            # Optional.
+has 'username';                 # Optional.
-has 'first_name';          # Optional.
+has 'first_name';               # Optional.
-has 'last_name';           # Optional.
+has 'last_name';                # Optional.
-has 'photo';               # Teapot::Bot::Object::ChatPhoto. Optional. Returned only in getChat.
+has 'photo';                    # Teapot::Bot::Object::ChatPhoto. Optional. Returned only in getChat.
-has 'description';         # Optional. Returned only in getChat.
+has 'bio';                      # Optional. Bio of the other party in a private chat. Returned only in getChat.
-has 'invite_link';         # Optional. Returned only in getChat.
+has 'has_private_forwards';     # Optional. True, if privacy settings of the other party in the private chat allows to
-has 'pinned_message';      # Teapot::Bot::Object::Message
+                                # use tg://user?id=<user_id> links only in chats with the user.
-has 'permissions';         # Teapot::Bot::Object::ChatPermissions. Optional. Default chat member permissions, for
+                                # Returned only in getChat.
-                           # groups and supergroups. Returned only in getChat.
+has 'description';              # Optional. Returned only in getChat.
-has 'slow_mode_delay';     # Optional. Returned only in getChat.
+has 'invite_link';              # Optional. Returned only in getChat.
-has 'sticker_set_name';    # Optional. Returned only in getChat.
+has 'pinned_message';           # Teapot::Bot::Object::Message
-has 'can_set_sticker_set'; # Optional. Returned only in getChat.
+has 'permissions';              # Teapot::Bot::Object::ChatPermissions. Optional. Default chat member permissions, for
-has 'linked_chat_id';      # Optional. greater than 32 bits, smaller than 52 bits
+                                # groups and supergroups. Returned only in getChat.
-has 'location';            # Optional. Returned only in getChat.
+has 'slow_mode_delay';          # Optional. Returned only in getChat.
+has 'message_auto_delete_time'; # Optional. The time after which all messages sent to the chat will be automatically
+                                # deleted; in seconds. Returned only in getChat.
+has 'has_protected_content';    # Optional. True, if messages from the chat can't be forwarded to other chats.
+                                # 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 
+          'scalar'                               => [qw/id type title username first_name last_name bio
-                                                        invite_link slow_mode_delay sticker_set_name 
+                                                        has_private_forwards description invite_link slow_mode_delay
-                                                        can_set_sticker_set linked_chat_id/],
+                                                        message_auto_delete_time has_protected_content
+                                                        sticker_set_name 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/],

lib/Teapot/Bot/Object/ChatInviteLink.pm

@@ -0,0 +1,61 @@
+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 'creates_join_request';
+has 'is_primary';
+has 'is_revoked';
+has 'name';
+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
+has 'pending_join_request_count';
+
+sub fields {
+  return {
+    'scalar'                    => [qw/invite_link creates_join_request is_primary is_revoked name expire_date
+                                       member_limit pending_join_request_count/],
+    '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/ChatMember.pm

@@ -7,34 +7,66 @@ use Carp qw(cluck);
 
 $Teapot::Bot::Object::ChatMember::VERSION = '0.022';
 
-has 'user';
+# ChatMemberOwner
-has 'status';
+has   'user';
-has 'custom_title';              # optional. Owner and administrators only.
+has   'status';
-has 'is_anonymous';              # Optional. Owner and administrators only.
+has   'custom_title';              # optional. Owner and administrators only.
+has   'is_anonymous';              # Optional. Owner and administrators only.
 
-has 'can_be_edited';             # optional. Administrators only.
+# ChatMemberAdministrator
-has 'can_post_messages';         # optional. Administrators only.
+# has 'user';
-has 'can_edit_messages';         # optional. Administrators only.
+# has 'status';
-has 'can_delete_messages';       # optional. Administrators only.
+has   'can_be_edited';             # optional. Administrators only.
-has 'can_restrict_members';      # optional. Administrators only.
+# has 'custom_title';              # optional. Owner and administrators only.
-has 'can_promote_members';       # optional. Administrators only.
+# has 'is_anonymous';              # Optional. Owner and administrators only.
-has 'can_change_info';           # optional. Administrators and restricted only.
+has   'can_manage_chat';           # Optional. Administrators only. True, if the administrator can access the chat event
-has 'can_invite_users';          # optional. Administrators and restricted only.
+                                 # log, chat statistics, message statistics in channels, see channel members, see
-has 'can_pin_messages';          # optional. Administrators and restricted only.
+                                 # anonymous administrators in supergroups and ignore slow mode. Implied by any other
-has 'is_member';                 # optional. Restricted only.
+                                 # administrator privilege
-has 'can_send_messages';         # optional. Restricted only.
+has   'can_post_messages';         # optional. Administrators only.
-has 'can_send_media_messages';   # optional. Restricted only.
+has   'can_edit_messages';         # optional. Administrators only.
-has 'can_send_polls';            # optional. Restricted only.
+has   'can_delete_messages';       # optional. Administrators only.
-has 'can_send_other_messages';   # optional. Restricted only.
+has   'can_manage_voice_chats';    # Optional. Administrators only. True, if the administrator can manage voice chats
-has 'can_add_web_page_previews'; # optional. Restricted only.
+has   'can_restrict_members';      # optional. Administrators only.
-has 'until_date';                # optional. Restricted and kicked only.
+has   'can_promote_members';       # optional. Administrators only.
+has   'can_change_info';           # optional. Administrators and restricted only.
+has   'can_invite_users';          # optional. Administrators and restricted only.
+has   'can_pin_messages';          # optional. Administrators and restricted only.
+
+# ChatMemberMember
+# has 'status';
+# has 'user';
+
+# ChatMemberRestricted
+# has 'status';
+# has 'user';
+has   'is_member';                 # optional. Restricted only.
+# has 'can_change_info';           # optional. Administrators and restricted only.
+# has 'can_invite_users';          # optional. Administrators and restricted only.
+# has 'can_pin_messages';          # optional. Administrators and restricted only.
+has   'can_send_messages';         # optional. Restricted only.
+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.
+
+# ChatMemberLeft
+# has 'status';
+# has 'user';
+
+# ChatMemberBanned
+# has 'status';
+# has 'user';
+# has 'until_date';                # optional. Restricted and kicked only.
 
 sub fields {
   return {
-          'scalar'                    => [qw/status custom_title is_anonymous can_be_edited can_post_messages can_edit_messages
+          'scalar'                    => [qw/status custom_title is_anonymous can_be_edited can_manage_chat can_post_messages
-                                             can_delete_messages can_restrict_members can_promote_members can_change_info
+                                             can_edit_messages can_delete_messages can_manage_voice_chats can_restrict_members
-                                             can_invite_users can_pin_messages is_member can_send_messages
+                                             can_promote_members can_change_info can_invite_users can_pin_messages is_member
-                                             can_send_media_messages can_send_polls can_send_other_messages can_add_web_page_previews until_date/],
+                                             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/],
         };
 }
@@ -51,7 +83,7 @@ sub canDeleteMessage {
     my $chatobj = $self->getChat ({ 'chat_id' => $chatid });
 
     # on api error, keep silence
-    unless ($chatobj) {
+    if ($chatobj == 0 || $chatobj->{error}) {
       cluck "Unable to get chat info for $chatid from telegram API";
       return 0;
     }
@@ -59,7 +91,7 @@ sub canDeleteMessage {
     my $myObj = $self->getMe ();
 
     # on api error, keep silence
-    unless ($chatobj) {
+    if ($myObj == 0 || $myObj->{error}) {
       cluck "Unable to get chat info for $chatid from telegram API";
       return 0;
     }
@@ -68,7 +100,7 @@ sub canDeleteMessage {
     my $me = $self->getChatMember ({ 'chat_id' => $chatid, 'user_id' => $myid });
 
     # on api error, keep silence
-    unless ($me) {
+    if ($me == 0 || $me->{error}) {
       cluck 'Unable to get chat info for bot itself from telegram API';
       return 0;
     }

lib/Teapot/Bot/Object/ChatMemberUpdated.pm

@@ -0,0 +1,67 @@
+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;
+use Teapot::Bot::Object::Voice;
+
+$Teapot::Bot::Object::ChatMemberUpdated::VERSION = '0.022';
+
+has 'chat';
+has 'from';
+has 'date';
+has 'old_chat_member';
+has 'new_chat_member';
+has 'text';            # Undocumented as of Bot API 5.2
+has 'voice';           # Undocumented as of Bot API 5.2
+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 text/],
+          'Teapot::Bot::Object::ChatMember'     => [qw/old_chat_member new_chat_member/],
+          'Teapot::Bot::Object::Voice'          => [qw/voice/],
+          '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

@@ -39,26 +39,26 @@ sub canTalk {
     my $chatobj = $self->_brain->getChat ({ 'chat_id' => $chatid });
 
     # on api error, keep silence
-    unless ($chatobj) {
+    if ($chatobj == 0 || $chatobj->{error}) {
       carp "Unable to get chat info for $chatid from telegram API";
-      return 0;
+      return $can_talk;
     }
 
     my $myObj = $self->_brain->getMe ();
 
     # on api error, keep silence
-    unless ($chatobj) {
+    if ($myObj == 0 || $myObj->{error}) {
       carp "Unable to get chat info for $chatid from telegram API";
-      return 0;
+      return $can_talk;
     }
 
     my $myid = $myObj->id;
     my $me = $self->_brain->getChatMember ({ 'chat_id' => $chatid, 'user_id' => $myid });
 
     # on api error, keep silence
-    unless ($me) {
+    if ($me == 0 || $me->{error}) {
       carp 'Unable to get chat info for bot itself from telegram API';
-      return 0;
+      return $can_talk;
     }
 
     if ($me->{'status'} eq 'administrator') {

lib/Teapot/Bot/Object/Contact.pm

@@ -9,10 +9,11 @@ has 'phone_number';
 has 'first_name';
 has 'last_name';
 has 'user_id';
+has 'vcard';
 
 sub fields {
   return {
-           scalar => [qw/phone_number first_name last_name user_id/],
+           scalar => [qw/phone_number first_name last_name user_id vcard/],
          };
 }
 

lib/Teapot/Bot/Object/Document.pm

@@ -8,6 +8,7 @@ use Teapot::Bot::Object::PhotoSize;
 $Teapot::Bot::Object::Document::VERSION = '0.022';
 
 has 'file_id';
+has 'file_unique_id';
 has 'thumb'; #PhotoSize
 has 'file_name';
 has 'mime_type';
@@ -15,7 +16,7 @@ has 'file_size';
 
 sub fields {
   return {
-            scalar                          => [qw/file_id file_name mime_type file_size/],
+            scalar                          => [qw/file_id file_unique_id file_name mime_type file_size/],
            'Teapot::Bot::Object::PhotoSize' => [qw/thumb/]
          };
 }

lib/Teapot/Bot/Object/Message.pm

@@ -29,6 +29,11 @@ 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::VoiceChatScheduled;
+use Teapot::Bot::Object::VoiceChatStarted;
+use Teapot::Bot::Object::VoiceChatEnded;
+use Teapot::Bot::Object::VoiceChatParticipantsInvited;
 
 use Data::Dumper;
 use Carp qw(cluck);
@@ -47,9 +52,11 @@ has 'forward_from_message_id';
 has 'forward_signature';
 has 'forward_sender_name';
 has 'forward_date';
+has 'is_automatic_forward';
 has 'reply_to_message'; # Message
 has 'via_bot'; # User
 has 'edit_date';
+has 'has_protected_content';
 has 'media_group_id';
 has 'author_signature';
 has 'text';
@@ -78,6 +85,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
@@ -86,14 +94,18 @@ has 'successful_payment'; # SuccessfulPayment
 has 'connected_website';
 has 'passport_data'; # PassportData
 has 'proximity_alert_triggered';
+has 'voice_chat_scheduled'; # Optional. Service message: voice chat scheduled
+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 {
   return {
           'scalar'                                      => [qw/message_id date forward_from_message_id
                                                             forward_signature forward_sender_name
-                                                            forward_date edit_date media_group_id
+                                                            forward_date is_automatic_forward edit_date has_protected_content
-                                                            author_signature text caption
+                                                            media_group_id author_signature text caption
                                                             new_chat_title delete_chat_photo
                                                             group_chat_created supergroup_chat_created
                                                             channel_chat_created migrate_to_chat_id
@@ -126,6 +138,11 @@ sub fields {
           '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::VoiceChatScheduled'   => [qw/voice_chat_scheduled/],
+          '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/],
   };
 }
 
@@ -140,7 +157,7 @@ sub reply {
 
   my $chatid = $self->chat->id;
 
-  if (Teapot::Bot::Object::ChatPermissions::canTalk($self, $chatid)) {
+  if (Teapot::Bot::Object::ChatPermissions->canTalk($self, $chatid)) {
     return $self->_brain->sendMessage({chat_id => $chatid, text => $text});
   }
 
@@ -153,7 +170,7 @@ sub replyMd {
 
   my $chatid = $self->chat->id;
 
-  if (Teapot::Bot::Object::ChatPermissions::canTalk ($self, $chatid)) {
+  if (Teapot::Bot::Object::ChatPermissions->canTalk ($self, $chatid)) {
     my $send_args;
     $send_args->{text} = $text;
     $send_args->{parse_mode} = 'Markdown';
@@ -170,7 +187,7 @@ sub typing {
 
   my $chatid = $self->chat->id;
 
-  if (Teapot::Bot::Object::ChatPermissions::canTalk ($self, $chatid)) {
+  if (Teapot::Bot::Object::ChatPermissions->canTalk ($self, $chatid)) {
     return $self->_brain->sendChatAction({chat_id => $chatid});
   }
 

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/PhotoSize.pm

@@ -7,12 +7,13 @@ use Carp qw/croak/;
 $Teapot::Bot::Object::PhotoSize::VERSION = '0.022';
 
 has 'file_id';
+has 'file_unique_id';
 has 'width';
 has 'height';
 has 'file_size';
 
 sub fields {
-  return { scalar => [qw/file_id width height file_size/] };
+  return { scalar => [qw/file_id file_unique_id width height file_size/] };
 }
 
 1;

lib/Teapot/Bot/Object/PollAnswer.pm

@@ -1,9 +1,9 @@
-package Teapot::Bot::Object::PollOption;
+package Teapot::Bot::Object::PollAnswer;
 # ABSTRACT: The base class for Telegram 'PollOption' type objects
 
 use Mojo::Base 'Teapot::Bot::Object::Base';
 
-$Teapot::Bot::Object::PollOption::VERSION = '0.022';
+$Teapot::Bot::Object::PollAnswer::VERSION = '0.022';
 
 has 'poll_id';
 has 'user';
@@ -30,17 +30,17 @@ __END__
 
 =head1 NAME
 
-Teapot::Bot::Object::PollOption - The base class for Telegram 'PollOption' type objects
+Teapot::Bot::Object::PollAnswer - The base class for Telegram 'PollAnswer' type objects
 
 =head1 VERSION
 
 version 0.022
 
 =head1 DESCRIPTION
-The base class for Telegram 'PollOption' type objects.
+The base class for Telegram 'PollAnswer' type objects.
 
-See L<https://core.telegram.org/bots/api#polloption> for details of the
+See L<https://core.telegram.org/bots/api#pollanswer> for details of the
-attributes available for L<Teapot::Bot::Object::PollOption> objects.
+attributes available for L<Teapot::Bot::Object::PollAnswer> objects.
 
 =head1 AUTHOR
 
@@ -48,7 +48,7 @@ Sergei Fedosov <eleksir@gmail.com>
 
 =head1 LICENSE AND COPYRIGHT
 
-This software is copyright (c) 2020 Sergei Fedosov <eleksir@gmail.com>.
+This software is copyright (c) 2021 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.

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 'thumb';     # Optional. Video thumbnail
-has 'mime_type';
+has 'file_name'; # Optional. Original filename as defined by sender
-has 'file_size';
+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/VideoNote.pm

@@ -8,6 +8,7 @@ use Teapot::Bot::Object::PhotoSize;
 $Teapot::Bot::Object::VideoNote::VERSION = '0.022';
 
 has 'file_id';
+has 'file_unique_id';
 has 'length';
 has 'duration';
 has 'mime_type';
@@ -16,7 +17,7 @@ has 'file_size';
 
 sub fields {
   return {
-           scalar                           => [qw/file_id length duration mime_type file_size/],
+           scalar                           => [qw/file_id file_unique_id length duration mime_type file_size/],
            'Teapot::Bot::Object::PhotoSize' => [qw/thumb /],
          };
 }

lib/Teapot/Bot/Object/Voice.pm

@@ -6,12 +6,13 @@ use Mojo::Base 'Teapot::Bot::Object::Base';
 $Teapot::Bot::Object::Voice::VERSION = '0.022';
 
 has 'file_id';
+has 'file_unique_id';
 has 'duration';
 has 'mime_type';
 has 'file_size';
 
 sub fields {
-  return { scalar => [qw/file_id duration mime_type file_size/] };
+  return { scalar => [qw/file_id file_unique_id duration mime_type file_size/] };
 }
 
 1;

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 'duration';
+
+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/VoiceChatScheduled.pm

@@ -0,0 +1,48 @@
+package Teapot::Bot::Object::VoiceChatScheduled;
+# ABSTRACT: The base class for Telegram message 'VoiceChatEnded' type.
+
+use Mojo::Base 'Teapot::Bot::Object::Base';
+
+$Teapot::Bot::Object::VoiceChatScheduled::VERSION = '0.022';
+
+# This object represents a service message about a voice chat started in the chat. Currently holds no information.
+has 'start_date';
+
+sub fields {
+  return { scalar => [qw/start_date/] };
+}
+
+1;
+
+__END__
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+Teapot::Bot::Object::VoiceChatScheduled - The base class for Telegram message 'VoiceChatScheduled' type
+
+=head1 VERSION
+
+version 0.022
+
+=head1 DESCRIPTION
+The base class for Telegram message 'VoiceChatScheduled' type.
+
+See L<https://core.telegram.org/bots/api#voicechatscheduled> for details of the
+attributes available for L<Teapot::Bot::Object::VoiceChatScheduled> 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/TelegramBot.pm

@@ -1,30 +1,31 @@
-package telegrambot;
+package TelegramBot;
 # main bot gears are here
 
 use 5.018;
 use strict;
 use warnings;
 use utf8;
-use Data::Dumper;
 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 Log::Any qw ($log);
 use Math::Random::Secure qw (irand);
 use Mojo::Base 'Teapot::Bot::Brain';
-use admin qw (fortune_toggle_list);
+use BotLib::Admin qw (FortuneToggleList);
-use botlib qw (randomCommonPhrase command highlight botsleep isCensored);
+use BotLib qw (RandomCommonPhrase Command Highlight BotSleep IsCensored);
-use conf qw (loadConf);
+use BotLib::Conf qw (LoadConf);
-use fortune qw (fortune);
+use BotLib::Fortune qw (Fortune);
-use karma qw (karmaSet);
+use BotLib::Image qw (Oboobs Obutts);
-use util qw (trim fmatch);
+use BotLib::Karma qw (KarmaSet);
+use BotLib::Util qw (trim fmatch);
 
 use version; our $VERSION = qw (1.0);
 use Exporter qw (import);
-our @EXPORT_OK = qw (run_telegrambot);
+our @EXPORT_OK = qw (RunTelegramBot);
 
-my $c = loadConf ();
+my $c = LoadConf ();
 my $hailo;
 my $myid;
 my $myusername;
@@ -47,9 +48,9 @@ sub __cron {
 	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 ()) {
+		foreach my $enabledfortunechat (FortuneToggleList ()) {
 			my $send_args;
-			$send_args->{text} = sprintf "%s\n```\n%s\n```\n", $intro[irand ($#intro + 1)], trim (fortune ());
+			$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);
@@ -65,14 +66,14 @@ sub __on_msg {
 	my $chatid;
 	my $chatname = 'Noname chat';
 	# user sending message info
-	my ($userid, $username, $fullname, $highlight, $vis_a_vi) = highlight $msg;
+	my ($userid, $username, $fullname, $highlight, $vis_a_vi) = BotLib::Highlight ($msg);
 	my $csign = $c->{telegrambot}->{csign};
 
 	unless ($myid) {
 		my $myObj = $self->getMe ();
 
 		unless ($myObj) {
-			carp '[ERROR] Unable to get chatid, API Error?';
+			$log->error ('[ERROR] Unable to get chatid, API Error?');
 			return;
 		}
 
@@ -105,7 +106,7 @@ sub __on_msg {
 			}
 		}
 	} else {
-		carp '[INFO] Unable to get chatid';
+		$log->warn ('[INFO] Unable to get chatid');
 		return;
 	}
 
@@ -114,21 +115,33 @@ sub __on_msg {
 	# Newcommer event, greet our new member and suggest to introduce themself.
 	if ($msg->can ('new_chat_members') && defined ($msg->new_chat_members)) {
 		my @members;
+		my @introduce = (
+			'Дратути',
+			'Дарована',
+			'Доброе утро, день или вечер',
+			'Добро пожаловать в наше скромное коммунити',
+			'Наше вам с кисточкой тут, на канальчике',
+		);
 
 		foreach my $member (@{$msg->new_chat_members}) {
 			my $member_str = '';
 
-			if ($member->can ('first_name') && defined ($member->first_name)) {
+			# avoid naming people by spacing symbols, or empty names
+			if ($member->can ('first_name') && defined ($member->first_name) && $member->first_name !~ /^\s+$/ui) {
 				$member_str .= $member->first_name;
 
-				if ($member->can ('last_name') && defined ($member->last_name)) {
+				if ($member->can ('last_name') && defined ($member->last_name) && $member->last_name !~ /^\s+$/ui) {
 					$member_str .= ' ' . $member->last_name;
 				}
 			} else {
-				if ($member->can ('last_name') && defined ($member->last_name)) {
+				if ($member->can ('last_name') && defined ($member->last_name) && $member->last_name !~ /^\s+$/ui) {
 					$member_str .= ' ' . $member->last_name;
-				} else {
+				# username must be uniq and should contain only english letters and numbers, so...
+				} elsif ($member->can ('username') && defined ($member->username)) {
 					$member_str .= '@' . $member->username;
+				# fallback to id if uose trying to be smartass and use only spacing chars in it's firstname and/or lastname
+				} else {
+					$member_str .= $member->id;
 				}
 			}
 
@@ -137,12 +150,12 @@ sub __on_msg {
 
 		if ($#members > 1) {
 			my $lastone = pop @members;
-			$phrase = sprintf 'Дратути, %s и %s. Представьтес, пожалуйста, и расскажите, что вас сюда привело.', join (', ', @members), $lastone;
+			$phrase = sprintf '%s, %s и %s. Представьтес, пожалуйста, и расскажите, что вас сюда привело.', $introduce[irand ($#introduce + 1)], join (', ', @members), $lastone;
 		} else {
-			$phrase = sprintf 'Дратути, %s. Представьтес, пожалуйста, и расскажите, что вас сюда привело.', $members[0];
+			$phrase = sprintf '%s, %s. Представьтес, пожалуйста, и расскажите, что вас сюда привело.', $introduce[irand ($#introduce + 1)], $members[0];
 		}
 
-		botsleep $msg;
+		BotSleep $msg;
 		$msg->replyMd ($phrase);
 		return;
 	}
@@ -158,9 +171,9 @@ sub __on_msg {
 		);
 
 		if ($chatid < 0) {
-			carp "[INFO] Initialized brain for public chat $chatname ($chatid): $brainname";
+			$log->info ("[INFO] Initialized brain for public chat $chatname ($chatid): $brainname");
 		} else {
-			carp "[INFO] Initialized brain for private chat $chatname ($chatid): $brainname";
+			$log->info ("[INFO] Initialized brain for private chat $chatname ($chatid): $brainname");
 		}
 	}
 
@@ -171,11 +184,11 @@ sub __on_msg {
 		}
 
 		my $text = $msg->text;
-		carp sprintf ('[DEBUG] Private chat %s say to bot: %s', $vis_a_vi, $text) if $c->{debug};
+		$log->debug (sprintf ('[DEBUG] Private chat %s say to bot: %s', $vis_a_vi, $text));
 		my $reply = 'Давайте ещё пообщаемся, а то я ещё не научилась от вас плохому.';
 
 		if (substr ($text, 0, 1) eq $csign) {
-			$reply = command ($self, $msg, $text, $userid);
+			$reply = Command ($self, $msg, $text, $userid);
 		} else {
 			my $just_message_in_chat = 0;
 
@@ -184,27 +197,45 @@ sub __on_msg {
 				my @arr = split /\n/, $text;
 
 				if ($#arr < 1) {
-					$reply = karmaSet ($chatid, trim (substr ($text, 0, -2)), substr ($text, -2));
+					$reply = KarmaSet ($chatid, trim (substr ($text, 0, -2)), substr ($text, -2));
 				} else {
 					$just_message_in_chat = 1;
 				}
+			} else {
+				$just_message_in_chat = 1;
 			}
 
 			if ($just_message_in_chat) {
-				my $str = $hailo->{$msg->chat->id}->learn_reply ($text);
+				if ($text =~ /^ *кто +все +эти +люди *\?$/ui) {
+					$reply = 'Какие "люди"? Мы здесь вдвоём, только ты и я.';
+				} elsif ($text =~ /^ *кто +я *\?$/ui) {
+					$reply = 'Где?';
+				} elsif ($text =~ /^ *кто +(здесь|тут) *\?$/ui) {
+					$reply = 'Ты да я, да мы с тобой.';
+				} elsif ($text =~ /покажи +(сиськи|сиси|титьки) *$/ui) {
+					$reply = Oboobs ();
+				} elsif ($text =~ /show +(titts|tities|boobs) *$/i) {
+					$reply = Oboobs ();
+				} elsif ($text =~ /покажи +(попку|попу) *$/ui) {
+					$reply = Obutts ();
+				} elsif ($text =~ /show +(ass|butt|butty) *$/i) {
+					$reply = Obutts ();
+				} else {
+					my $str = $hailo->{$msg->chat->id}->learn_reply ($text);
 
-				if (defined ($str) && $str ne '') {
+					if (defined ($str) && $str ne '') {
-					$reply = $str;
+						$reply = $str;
-					$phrase = trim $text;
+						$phrase = trim $text;
 
-					while ($phrase =~ /[\.|\,|\?|\!]$/) {
+						while ($phrase =~ /[\.|\,|\?|\!]$/) {
-						chop $phrase;
+							chop $phrase;
-					}
+						}
 
-					$phrase = lc $phrase;
+						$phrase = lc $phrase;
 
-					if (fmatch (lc ($reply), $phrase)) {
+						if (fmatch (lc ($reply), $phrase)) {
-						$reply = randomCommonPhrase ();
+							$reply = RandomCommonPhrase ();
+						}
 					}
 				}
 			}
@@ -213,53 +244,64 @@ sub __on_msg {
 		if (defined $reply) {
 			$msg->typing ();
 			sleep 1;
-			carp sprintf ('[DEBUG] Private chat bot reply to %s: %s', $vis_a_vi, $reply) if $c->{debug};
+			$log->debug (sprintf ('[DEBUG] Private chat bot reply to %s: %s', $vis_a_vi, $reply));
 			$msg->reply ($reply);
 		}
 # group chat
 	} elsif (($msg->chat->type eq 'supergroup') or ($msg->chat->type eq 'group')) {
 		my $reply;
 
-		if (isCensored $msg) {
+		if (IsCensored $msg) {
-			carp sprintf '[INFO] In public chat %s (%s) message from %s was censored', $chatname, $chatid, $vis_a_vi;
+			$log->info (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) {
-			carp sprintf ('[INFO] No text in message from %s', $vis_a_vi);
+			$log->debug (sprintf ('[DEBUG] No text in message from %s', $vis_a_vi));
 			return;
 		}
 
 		# we have text here! so potentially we can chit-chat
 		my $text = $msg->text;
-		carp sprintf ('[DEBUG] In public chat %s (%s) %s say: %s', $chatname, $chatid, $vis_a_vi, $text) if $c->{debug};
+		$log->debug (sprintf ('[DEBUG] In public chat %s (%s) %s say: %s', $chatname, $chatid, $vis_a_vi, $text));
 
 		# 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)) {
-			carp sprintf ('[DEBUG] In public chat %s (%s) %s quote us!', $chatname, $chatid, $vis_a_vi) if $c->{debug};
+			$log->debug (sprintf ('[DEBUG] In public chat %s (%s) %s quote us!', $chatname, $chatid, $vis_a_vi));
 
 			# do not answer back if someone quote our new member greet
-			if ((substr ($msg->reply_to_message->text, 0, 9) eq 'Дратути, ') &&
+			if (substr ($msg->reply_to_message->text, -61) eq 'Представьтес, пожалуйста, и расскажите, что вас сюда привело.') {
-			    (substr ($msg->reply_to_message->text, -61) eq 'Представьтес, пожалуйста, и расскажите, что вас сюда привело.')) {
+				my @hello = (
-				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;
+				foreach my $hi (@hello) {
+					if (substr ($msg->reply_to_message->text, 0, length $hi) eq $hi) {
+						return;
+					}
+				}
+			}
+
+			# 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) if (length ($phrase) > 3);
+			$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);
+			$reply = Command ($self, $msg, $text, $chatid);
 		} elsif (
 				($text eq $myusername) or
 				($text eq '@' . $myusername) or
@@ -275,28 +317,63 @@ sub __on_msg {
 			# phrase directed to bot
 			if ((lc ($text) =~ /^${qname}[\,|\:]? (.+)/) or (lc ($text) =~ /^${qtname}[\,|\:]? (.+)/)){
 				$phrase = $1;
-				$reply = $hailo->{$msg->chat->id}->learn_reply ($phrase);
+
+				if ($phrase =~ /^ *кто +все +эти +люди *\?$/ui) {
+					$reply = 'Кто здесь?';
+				} elsif ($phrase =~ /^ *кто +я *?$/ui){
+					$reply = 'Где?';
+				} elsif ($phrase =~ /^ *кто +(здесь|тут) *\?$/ui) {
+					$reply = 'Здесь все: Никита, Стас, Гена, Турбо и Дюша Метёлкин.';
+				} else {
+					$reply = $hailo->{$msg->chat->id}->learn_reply ($phrase);
+				}
 			# bot mention by name
 			} elsif ((lc ($text) =~ /.+ ${qname}[\,|\!|\?|\.| ]/) or (lc ($text) =~ / $qname$/)) {
 				$phrase = $text;
-				$reply = $hailo->{$msg->chat->id}->reply($phrase);
+
+				if ($phrase =~ /^ *кто +все +эти +люди *\?$/ui) {
+					$reply = 'Кто здесь?';
+				} elsif ($phrase =~ /^ *кто +я *?$/ui){
+					$reply = 'Где?';
+				} elsif ($phrase =~ /^ *кто +(здесь|тут) *\?$/ui) {
+					$reply = 'Здесь все: Никита, Стас, Гена, Турбо и Дюша Метёлкин.';
+				} else {
+					$reply = $hailo->{$msg->chat->id}->learn_reply ($phrase);
+				}
 			# bot mention by telegram name
 			} elsif ((lc ($text) =~ /.+ ${qtname}[\,|\!|\?|\.| ]/) or (lc ($text) =~ / $qtname$/)) {
 				$phrase = $text;
-				$reply = $hailo->{$msg->chat->id}->reply ($phrase);
+
+				if ($phrase =~ /^ *кто +все +эти +люди *\?$/ui) {
+					$reply = 'Кто здесь?';
+				} elsif ($phrase =~ /^ *кто +я *?$/ui){
+					$reply = 'Где?';
+				} elsif ($phrase =~ /^ *кто +(здесь|тут) *\?$/ui) {
+					$reply = 'Здесь все: Никита, Стас, Гена, Турбо и Дюша Метёлкин.';
+				} else {
+					$reply = $hailo->{$msg->chat->id}->learn_reply ($phrase);
+				}
 			# karma adjustment
 			} elsif (substr ($text, -2) eq '++'  ||  substr ($text, -2) eq '--') {
 				my @arr = split /\n/, $text;
 
 				if ($#arr < 1) {
-					$reply = karmaSet ($chatid, trim (substr ($text, 0, -2)), 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);
 				}
 			# just message in chat
 			} else {
-				$hailo->{$msg->chat->id}->learn ($text);
+				if ($text =~ /^ *кто +все +эти +люди *\?$/ui) {
+					$reply = 'Кто здесь?';
+				} elsif ($phrase =~ /^ *кто +я *?$/ui){
+					$reply = 'Где?';
+				} elsif ($phrase =~ /^ *кто +(здесь|тут) *\?$/ui) {
+					$reply = 'Здесь все: Никита, Стас, Гена, Турбо и Дюша Метёлкин.';
+				} else {
+					$hailo->{$msg->chat->id}->learn ($text);
+				}
 			}
 		}
 
@@ -311,15 +388,15 @@ sub __on_msg {
 			$phrase = lc $phrase;
 
 			if (fmatch (lc ($reply), $phrase)) {
-				$reply = randomCommonPhrase ();
+				$reply = RandomCommonPhrase ();
 			}
 
 			$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};
+			$log->debug (sprintf ('[DEBUG] In public chat %s (%s) bot reply to %s: %s', $chatname, $chatid, $vis_a_vi, $reply));
 			$msg->reply ($reply);
 		} else {
-			carp sprintf ('[DEBUG] In public chat %s (%s) bot is not required to reply to %s', $chatname, $chatid, $vis_a_vi) if $c->{debug};
+			$log->debug (sprintf ('[DEBUG] In public chat %s (%s) bot is not required to reply to %s', $chatname, $chatid, $vis_a_vi));
 		}
 
 # should be channel, so we can't talk
@@ -337,7 +414,7 @@ sub init {
 
 	unless (-d $braindir) {
 		make_path ($braindir, 0, 0755) or do { ## no critic (ValuesAndExpressions::ProhibitLeadingZeros)
-			cluck "Unable to create $braindir: $OS_ERROR";
+			$log->fatal ("[FATAL] Unable to create $braindir: $OS_ERROR");
 			exit 1;
 		};
 	}
@@ -347,10 +424,10 @@ sub init {
 	return;
 }
 
-sub run_telegrambot {
+sub RunTelegramBot {
 	while (sleep 3) {
 		eval {                                       ## no critic (ErrorHandling::RequireCheckingReturnValueOfEval)
-			telegrambot->new->think;
+			TelegramBot->new->think;
 		}
 	}
 

lib/admin.pm

@@ -1,282 +0,0 @@
-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 getForbiddenTypes addForbiddenType delForbiddenType listForbidden fortune_toggle fortune_toggle_list fortune_status);
-
-my $c = loadConf ();
-my $dir = $c->{admin}->{dir};
-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/chats.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/chats.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/chats.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;
-}
-
-
-1;
-
-# vim: set ft=perl noet ai ts=4 sw=4 sts=4:

lib/archeologist.pm

@@ -1,126 +0,0 @@
-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

@@ -1,292 +0,0 @@
-package botlib;
-# store here utility functions that are not protocol-specified
-
-use 5.018;
-use strict;
-use warnings;
-use utf8;
-use open qw (:std :utf8);
-use English qw ( -no_match_vars );
-use Carp qw (carp);
-use Math::Random::Secure qw (irand);
-
-use conf qw (loadConf);
-use admin qw (@forbiddenMessageTypes getForbiddenTypes addForbiddenType delForbiddenType listForbidden fortune_toggle fortune_status);
-use archeologist qw (dig);
-use fisher qw (fish);
-use fortune qw (fortune);
-use fox qw (fox);
-use friday qw (friday);
-use karma qw (karmaSet karmaGet);
-use kitty qw (kitty);
-use lat qw (latAnswer);
-use util qw (trim);
-use weather qw (weather);
-
-use version; our $VERSION = qw (1.0);
-use Exporter qw (import);
-our @EXPORT_OK = qw (randomCommonPhrase command highlight botsleep isCensored);
-
-my $c = loadConf ();
-my $csign = $c->{telegrambot}->{csign};
-
-sub randomCommonPhrase {
-	my @myphrase = (
-		'Так, блядь...',
-		'*Закатывает рукава* И ради этого ты меня позвал?',
-		'Ну чего ты начинаешь, нормально же общались',
-		'Повтори свой вопрос, не поняла',
-		'Выйди и зайди нормально',
-		'Я подумаю',
-		'Даже не знаю что на это ответить',
-		'Ты упал такие вопросы девочке задавать?',
-		'Можно и так, но не уверена',
-		'А как ты думаешь?',
-		'А ви, таки, почему интересуетесь?',
-	);
-
-	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 'cat'  ||  substr ($text, 1) eq 'кис') {
-		$reply = kitty ();
-		$msg->typing ();
-		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 'fox'  ||  substr ($text, 1) eq 'лис') {
-		$reply = fox ();
-		$msg->typing ();
-		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 'dig' || substr ($text, 1) eq 'копать') {
-		$reply = dig $highlight;
-		$msg->typing ();
-		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 'рыбалка' ) {
-		$reply = fish $highlight;
-		$msg->typing ();
-		sleep (irand (2) + 1);
-		$msg->replyMd ($reply);
-		return;
-	} elsif (substr ($text, 1) eq 'help'  ||  substr ($text, 1) eq 'помощь') {
-		$reply = << "MYHELP";
-```
-${csign}help | ${csign}помощь             - список команд
-${csign}cat | ${csign}кис                 - кошечка
-${csign}dig | ${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}ping | ${csign}пинг               - попинговать бота
-${csign}ver | ${csign}version | ${csign}версия   - что-то про версию ПО
-${csign}w город | ${csign}п город         - погода в указанном городе
-${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 фортунка      - показываем ли с утра фортунку для чата
-```
-Типы сообщений:
-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);
-				}
-			}
-		}
-	}
-
-	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;
-
-# vim: set ft=perl noet ai ts=4 sw=4 sts=4:

lib/fox.pm

@@ -1,55 +0,0 @@
-package fox;
-
-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 JSON::XS;
-use HTTP::Tiny;
-use Math::Random::Secure qw (irand);
-
-use version; our $VERSION = qw (1.0);
-use Exporter qw (import);
-our @EXPORT_OK = qw (fox);
-
-sub fox {
-	my $r;
-	my $ret = 'Нету лисичек, все разбежались.';
-
-	for (1..3) {
-		my $http = HTTP::Tiny->new (timeout => 3);
-		$r = $http->get ('https://randomfox.ca/floof/');
-
-		if ($r->{success}) {
-			last;
-		}
-
-		sleep 2;
-	}
-
-	if ($r->{success}) {
-		my $jfox = eval {
-			decode_json ($r->{content})
-		};
-
-		if ($EVAL_ERROR) {
-			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->{status}, $r->{reason};
-	}
-
-	return $ret;
-}
-
-1;
-
-# vim: set ft=perl noet ai ts=4 sw=4 sts=4:

lib/karma.pm

@@ -1,137 +0,0 @@
-package karma;
-
-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::SHA qw (sha1_base64);
-use DB_File;
-use File::Path qw (make_path);
-use conf qw (loadConf);
-
-use version; our $VERSION = qw (1.0);
-use Exporter qw (import);
-our @EXPORT_OK = qw (karmaSet karmaGet);
-
-my $c = loadConf ();
-my $karmadir = $c->{karma}->{dir};
-my $max = 5;
-
-# swallow phrase and return answer
-sub karmaSet (@) {
-	my $chatid = shift;
-	my $phrase = shift;
-	my $action = shift;
-	my $score = 0;
-	# 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 || do {
-		cluck "[ERROR] Something nasty happen when cachedata ties to its data: $OS_ERROR";
-		return sprintf 'Карма %s составляет 0', $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 '++') {
-			$score = $karma{$sha1_phrase} + 1;
-			$karma{$sha1_phrase} = $score;
-		} else {
-			$score = $karma{$sha1_phrase} - 1;
-			$karma{$sha1_phrase} = $score;
-		}
-	} else {
-		if ($action eq '++') {
-			$karma{$sha1_phrase} = 1;
-			$score = 1;
-		} else {
-			$karma{$sha1_phrase} = -1;
-			$score = -1;
-		}
-	}
-
-	untie %karma;
-
-	if ($score < -1 && (($score % (0 - $max)) + 1) == 0) {
-		if ($phrase eq '') {
-			return sprintf 'Зарегистрировано пробитие дна, карма пустоты составляет %d', $score;
-		} else {
-			return sprintf 'Зарегистрировано пробитие дна, карма %s составляет %d', $phrase, $score;
-		}
-	} else {
-		if ($phrase eq '') {
-			return sprintf 'Карма пустоты составляет %d', $score;
-		} else {
-			return sprintf 'Карма %s составляет %d', $phrase, $score;
-		}
-	}
-}
-
-# just return answer
-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;
-		};
-	}
-
-	# init hash, store phrase and score
-	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;
-	};
-
-	# 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;
-
-	unless (defined $score) {
-		$score = 0;
-	}
-
-	if ($phrase eq '') {
-		return sprintf 'Карма пустоты составляет %d', $score;
-	} else {
-		return sprintf 'Карма %s составляет %d', $phrase, $score;
-	}
-}
-
-1;
-
-# vim: ft=perl noet ai ts=4 sw=4 sts=4:

lib/kitty.pm

@@ -1,55 +0,0 @@
-package kitty;
-
-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 JSON::XS;
-use HTTP::Tiny;
-use Math::Random::Secure qw (irand);
-
-use version; our $VERSION = qw (1.0);
-use Exporter qw (import);
-our @EXPORT_OK = qw (kitty);
-
-sub kitty {
-	my $r;
-	my $ret = 'Нету кошечек, все разбежались.';
-
-	for (1..3) {
-		my $http = HTTP::Tiny->new (timeout => 3);
-		$r = $http->get ('https://api.thecatapi.com/v1/images/search');
-
-		if ($r->{success}) {
-			last;
-		}
-
-		sleep 2;
-	}
-
-	if ($r->{success}) {
-		my $jcat = eval {
-			decode_json ($r->{content})
-		};
-
-		if ($EVAL_ERROR) {
-			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->{status}, $r->{reason};
-	}
-
-	return $ret;
-}
-
-1;
-
-# vim: set ft=perl noet ai ts=4 sw=4 sts=4: