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

Use JSON::PP explicitly rather than implicitly
Fix error handling in canDeleteMessage
2022-02-03 02:03:50 +03:00 · 2022-02-03 02:00:06 +03:00 · 2022-02-03 00:42:13 +03:00 · 2022-02-03 00:29:26 +03:00 · 2022-01-29 18:10:56 +03:00 · 2022-01-29 18:06:23 +03:00
28 changed files with 2475 additions and 186 deletions
--- a/.gitignore
+++ b/.gitignore
@@ -11,5 +11,6 @@ data/gamestat/**
 data/image/**
 data/karma/**
 data/lat/**
+data/proverb/**
 data/telegrambot-brains/**
 vendor_perl/**
--- a/.perlcriticrc
+++ b/.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
-
--- a/Migration.txt
+++ b/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.
--- a/README.md
+++ b/README.md
@@ -1,29 +1,32 @@
 # 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
-generator.
+It is based on Perl modules [Telegram::Bot][1] and [Hailo][2] as conversation generator.

-I have to fork [Telegram::Bot][1] and update it according to features appeared
-in [Telegram Bot API v5][3]. Also, I decide to rename it to avoid collision in
-the future, now it is Teapot::Bot and is bundled with bot. When lib becomes
+I have to fork [Telegram::Bot][1] and update it according to features appeared in [Telegram Bot API v5][3]. Also,
+I decide to rename it to avoid collision in the future, now it is Teapot::Bot and is bundled with bot. When lib becomes
 mature enough, maybe I release it separately.

-Bot config located in **data/config.json**, sample config provided as
-**data/sample_config.json**.
+Bot config located in **data/config.json**, sample config provided as **data/sample_config.json**.

-Bot can be run via **bin/aleesa-telegram-bot** and acts as daemon (double fork()
-and detaches stdio).
+Bot can be run via **bin/aleesa-telegram-bot** and acts as daemon (double fork() and detaches stdio).

 ## Installation

-In order to run this application, you need to "bootstrap" it - download and build
-all required dependencies and libraries.
+Application have been tested on alpine linux x86_64 3.12, with perl-5.32.1 builtin.

-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.
+In order to run this application, you need to "bootstrap" it - download and build all required dependencies and
+libraries.
+
+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:

@@ -37,56 +40,49 @@ and all libraries should be downloaded, built, tested and installed.

 ## Running

-This bot does not [ultilize][4] webhooks, so in order to run it only well
-internet connection is requied, no public-available ip address is needed.
+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 thrird party services
-and API keys and secrets in order to work.
+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".
+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.
+Once key is created you should put it in **config.json** under openweathermap section as appid. Thats it.

 It is still impossible to disable this plugin, but "I'm working on it".

 #### Imgur

-This plugin "just exists" and is actually used nowhere around the code.
-Anyway, to make use of it besides registering apropriate handler in code, you
-should sign in imgur and get access token.
+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 authorise your app according to [this][10] manual. Or
-[this][11] one.
+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.
+There is helper script in **bin/flickr_init.pl** that helps to get all required keys and secrets from flickr api.

 Before using it bot must be bootstrapped via **`bootstrap.sh`**.

-[Login][11] and create an [app][12] in your flickr account. Then *logout* flickr account.
-(It is required in order to properly get "verfier" parameter later).
+[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.
+Put your [app key and secret][13] to **config.json**. Ensure that "verifier" parameter in Flickr-related part of config
+either absent or commented out.

-Run **bin/flickr_init.pl** first time and follow on screen instuctions - copy and
-paste given link to browser login to flickr account adn yo'll be redirected to
-example.com. Check address bar in browser to get so-called "verifier", put it in
-**config.json**. Then run **bin/flickr_init.pl** again to store API access token in db
-under data/image directory (in default config). You're done.
+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
--- a/README_RU.md
+++ b/README_RU.md
@@ -1,32 +1,38 @@
 # Aleesa-Telegram-bot - Болтливый бот для Telegram

+## Дисклеймер
+
+Эта версия бота за номером 3 (с мелочью) стабильная. Сие означает, что дальнейшего развития функций в этой версии не
+предполагается. Конечно, возможны исключения, но основной план - переключиться на 4-ю версию, куда планируется
+перенести большинство функций 3-й версии.
+
+Если у кого-то возникнут идеи относительно этой версии бота - ставьте PR, я только рад. Т.к. несмотря на то, что
+развитие этой версии "слегка" заморожено, поддерживать её планируется как минимум до выхода в свет 4-й версии бота.
+
 ## Что это такое

-Это бот основанный на перловых модулях [Telegram::Bot][1] для работы в
-мессенджере Telegram и [Hailo][2] для генерации "умной" беседы.
+Это бот, основанный на перловых модулях [Telegram::Bot][1] для работы в мессенджере Telegram и [Hailo][2] для генерации
+"умной" беседы.

-Для корректной работы пришлось форкнуть [Telegram::Bot][1] чтобы обновить
-интерфейс API до [Telegram Bot API v5][3]. Для избежания неоднозначностей модуль
-пришлось переименовать и теперь он идёт в составе бота. Возможно, когда модуль
-отлежится и будет похож на стабильный, он стнет самостоятельным и поселится на
-metacpan.org
+Для корректной работы, пришлось форкнуть [Telegram::Bot][1], чтобы обновить интерфейс API до [Telegram Bot API v5][3].
+Для избежания неоднозначностей, модуль пришлось переименовать и теперь он идёт в составе бота. Возможно, когда модуль
+отлежится и будет похож на стабильный, он стнет самостоятельным и поселится на metacpan.org

-Конфиг бота должен лежать в **data/config.json**, пример конфига расположен в
-**data/sample_config.json**.
+Конфиг бота должен лежать в **data/config.json**. Пример конфига расположен в **data/sample_config.json**.

-Бота можно запустить через **bin/aleesa-telegram-bot** и он взлетит как юниксовый
-демон (сделает двойной fork() и отцепится от stdio).
+Бота можно запустить через **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.
+Чтобы запустить приложение, его надо "забурстрапить" - загрузить и собрать все необходимые зависимости.

-После установки этих пакетов можно будет запустить:
+Понадобится 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

@@ -34,60 +40,54 @@ bash bootstrap.sh

 ```

-и по идее всё что нужно будет выкачено, собрано и разложено куда надо.
+и, по идее, всё что нужно будет выкачено, собрано и разложено куда надо.

 ## Запуск и работа

-Бот не использует [вебхуки][4], поэтому ничего дополнительного, кроме хорошего
-подключения к интернету ему не нужно.
+Бот не использует [вебхуки][4], поэтому ничего дополнительного, кроме хорошего подключения к интернету ему не нужно.

 ### Дополнительные настройки

-Некоторые "плагины" требуют регистрации в сторонних сервисах (API keys, secrets
-итд), чтобы бот не сыпал ошибками в логи (возможно, в дальнейшем возможно будет
-отключить эти плагины).
+Некоторые "плагины" требуют регистрации в сторонних сервисах (API keys, secrets итд), чтобы бот не сыпал ошибками в
+логи (возможно, в дальнейшем возможно будет отключить эти плагины).

 #### OpenWeatherMap

-Для работы погодного плагина надо [заргистрироваться][5], [залогиниться][6] и
-[создать][7] api key. Free plan предлагает всё необхдимое для работы "плагина".
+Для работы погодного плагина, надо [заргистрироваться][5], [залогиниться][6] и [создать][7] api key. Free plan
+предлагает всё необхдимое для работы "плагина".

-Когда api key будет создан, его нужно вписать в **config.json** "секцию"
-openweathermap в качестве appid. На этом всё.
+Когда api key будет создан, его нужно вписать в **config.json** "секцию" openweathermap в качестве appid. На этом всё.

 #### Imgur

-Этот плагин "просто есть" и его на самом деле ничто и никто не использует. И в
-этой связи все настройки плагина можно оставить "как есть" в примере конфига.
+Этот плагин "просто есть" и его на самом деле ничто и никто не использует. И в этой связи все настройки плагина можно
+оставить "как есть" в примере конфига.

-Тем не менее, если есть большое желание, то можно [залогиниться][8] и
-[зарегистрировать][9] бота как приложение, а потом разрешить приложению
-пользоваться API-шкой, как описано в [этом][10] или [этом][11] мануале.
+Тем не менее, если есть большое желание, то можно [залогиниться][8] и [зарегистрировать][9] бота как приложение, а
+потом разрешить приложению пользоваться API-шкой, как описано в [этом][10] или [этом][11] мануале.

 #### Flickr

-Этот "плагин" действительно используется для добычи ссылок на картинки в разных
-"картиночных" командах бота.
+Этот "плагин" действительно используется для добычи ссылок на картинки в разных "картиночных" командах бота.

-Есть скрипт, который поможет с регистрацией приложения в api Flickr -
-**bin/flickr_init.pl** он достанет все нужные ключи и секреты к ним.
+Есть скрипт, который поможет с регистрацией приложения в api Flickr - **bin/flickr_init.pl**, он достанет все нужные
+ключи и секреты к ним.

 До запуска этого скрипта, бот должен быть забутстраплен через **`bootstrap.sh`**.

-[Залогиньтесь][11] и создайте [app][12] in своём Flicker-овском аккаунте. Далее,
-*разлогиньтесь*, это нужно, чтобы потом проще было достать параметр verifier.
+[Залогиньтесь][11] и создайте [app][12] in своём Flicker-овском аккаунте. Далее, *разлогиньтесь*, это нужно, чтобы
+потом проще было достать параметр verifier.

-Запишите [app key и secret][13] в **config.json**. Удостоверьтесь, что параметр
-"verifier" в конфиге либо закоменчен либо отсутствует.
+Запишите [app key и secret][13] в **config.json**. Удостоверьтесь, что параметр "verifier" в конфиге либо закоменчен,
+либо отсутствует.

-Запустите **bin/flickr_init.pl** и следуте предлагаемым инструкциям - в итоге
-будет дана ссылка, которую надо скопипастить в браузер. По ссылке предложат
-залогиниться, далее надо будет разрешить приложению просматривать профиль и
-через один-два редиректа вы попадёте на example.com. Из адресной строки браузера
-надо скопировать параметр "verifier" и вписать его в **config.json**.
+Запустите **bin/flickr_init.pl** и следуте предлагаемым инструкциям - в итоге будет дана ссылка, которую надо
+скопипастить в браузер. По ссылке предложат залогиниться, далее надо будет разрешить приложению просматривать профиль
+и, через один-два редиректа, вы попадёте на example.com. Из адресной строки браузера надо скопировать параметр
+"verifier" и вписать его в **config.json**.

-Чтобы сохранить в бд плагина API access token для нормальной работы "плагина",
-второй раз запустите **bin/flickr_init.pl**. На этом всё.
+Чтобы сохранить в бд плагина API access token для нормальной работы "плагина", второй раз запустите
+**bin/flickr_init.pl**. На этом всё.

 [1]: https://metacpan.org/pod/Telegram::Bot
 [2]: https://metacpan.org/pod/Hailo
--- a/bin/cache_export.pl
+++ b/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;
+
--- a/bin/cache_import.pl
+++ b/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;
--- a/bin/proverb_seed.pl
+++ b/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;
--- a/73
+++ b/73
@@ -1,34 +1,39 @@
-requires 'Carp';
-requires 'CHI';
-requires 'CHI::Driver::BerkeleyDB';
-requires 'Cwd::utf8';
-requires 'DateTime';
-requires 'DB_File';
-requires 'SQLite_File';
-requires 'DBI';
-requires 'DBD::SQLite';
-requires 'Digest::HMAC_SHA1';
-requires 'Digest::MD5';
-requires 'Data::Dumper';
-requires 'Digest::SHA';
-requires 'File::Basename';
-requires 'File::Path';
-requires 'Hailo';
-requires 'HTML::TokeParser';
-requires 'IO::Socket::SSL';
-requires 'JSON';
-requires 'JSON::XS';
-requires 'List::Util';
-requires 'local::lib';
-requires 'Log::Any';
-requires 'Log::Any::Adapter';
-requires 'Log::Any::For::Std';
-requires 'Math::Random::Secure';
-requires 'Mojo::Base';
-requires 'Mojo::IOLoop';
-requires 'Mojo::UserAgent';
-requires 'Mojo::UserAgent::Cached';
-requires 'String::Random';
-requires 'Text::Fuzzy';
-requires 'URI::Encode::XS';
-requires 'URI::URL';
+## no critic (TestingAndDebugging::RequireUseStrict,Modules::RequireVersionVar)
+## no critic (TestingAndDebugging::RequireUseWarnings,Modules::RequireExplicitPackage)
+## no critic (Modules::RequireEndWithOne)
+requires 'Carp',                    '==1.50';
+requires 'CHI',                     '==0.61';
+requires 'CHI::Driver::BerkeleyDB', '==0.05';
+requires 'Cwd::utf8',               '==0.011';
+requires 'DateTime',                '==1.55';
+requires 'DB_File',                 '==1.856';
+requires 'SQLite_File',             '==0.1006';
+requires 'DBI',                     '==1.643';
+requires 'DBD::SQLite',             '==1.70';
+requires 'Digest::HMAC_SHA1',       '==1.04';
+requires 'Digest::MD5',             '==2.58';
+requires 'Data::Dumper',            '==2.183';
+requires 'Digest::SHA',             '==6.02';
+requires 'File::Basename',          '==2.85';
+requires 'File::Path',              '==2.18';
+requires 'Hailo',                   '==0.75';
+requires 'HTML::TokeParser',        '==3.76';
+requires 'IO::Socket::SSL',         '==2.074';
+requires 'JSON',                    '==4.05';
+requires 'JSON::PP',                '==4.07';
+requires 'JSON::XS',                '==4.03';
+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';
--- a/data/proverb_src/proverb.txt
+++ b/data/proverb_src/proverb.txt
--- a/data/sample_config.json
+++ b/data/sample_config.json
@@ -12,6 +12,11 @@
        "srcdir" : "data/fortune_src"
    },

+    "proverb" : {
+        "dir" : "data/proverb",
+        "srcdir" : "data/proverb_src"
+    },
+
    "friday" : {
        "dir" : "data/friday",
        "src" : "data/friday.txt"
--- a/lib/BotLib.pm
+++ b/lib/BotLib.pm
@@ -14,6 +14,7 @@ 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);
@@ -24,6 +25,7 @@ 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);
@@ -43,7 +45,7 @@ sub RandomCommonPhrase {
 		'Повтори свой вопрос, не поняла',
 		'Выйди и зайди нормально',
 		'Я подумаю',
-		'Даже не знаю что на это ответить',
+		'Даже не знаю, что на это ответить',
 		'Ты упал такие вопросы девочке задавать?',
 		'Можно и так, но не уверена',
 		'А как ты думаешь?',
@@ -69,11 +71,43 @@ sub Command {
 		$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 = 'Версия:  Нуль.Чего-то_там.Чего-то_там';
+		$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 ();
@@ -150,11 +184,11 @@ sub Command {
 		$msg->replyMd ($reply);
 		return;
 	} elsif (
-		substr ($text, 1) eq 'tits'  ||
-		substr ($text, 1) eq 'boobs'  ||
+		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 'boobies' ||
+		substr ($text, 1) eq 'сиси'    ||
 		substr ($text, 1) eq 'сисечки'
 	) {
 		if (PluginEnabled $chatid, 'oboobs') {
@@ -167,8 +201,8 @@ sub Command {
 		return;
 	} elsif (
 		substr ($text, 1) eq 'butt'  ||
-		substr ($text, 1) eq 'booty'  ||
-		substr ($text, 1) eq 'ass'  ||
+		substr ($text, 1) eq 'booty' ||
+		substr ($text, 1) eq 'ass'   ||
 		substr ($text, 1) eq 'попа'  ||
 		substr ($text, 1) eq 'попка'
 	) {
@@ -182,6 +216,8 @@ sub Command {
 		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);
@@ -202,15 +238,26 @@ sub Command {
 		sleep (irand (2) + 1);
 		$msg->replyMd ($reply);
 		return;
-	} elsif (substr ($text, 1) eq 'хэлп' || substr ($text, 1) eq 'хелп') {
+	} 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}рыбка      - порыбачить
@@ -224,10 +271,16 @@ ${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}карма фраза - посмотреть карму фразы
 фраза-- | фраза++           - убавить или добавить карму фразе
--- a/lib/BotLib/Admin.pm
+++ b/lib/BotLib/Admin.pm
@@ -206,6 +206,11 @@ 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,
--- a/lib/BotLib/Anek.pm
+++ b/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:
--- a/lib/BotLib/Archeologist.pm
+++ b/lib/BotLib/Archeologist.pm
@@ -90,7 +90,7 @@ sub Dig {
 	}

 	my $phrase = sprintf "Вы начали раскопки %s и усиленно роете лопатами, экскаватором...\n", $location[irand ($#location + 1)];
-	$phrase .= "Вам кажется что ваш совочек ударился обо что-то твердое. Может, это клад?!\n\n";
+	$phrase .= "Вам кажется, что ваш совочек ударился обо что-то твердое. Может, это клад?!\n\n";
 	my $artifact = getRandomArtifact();

 	if ($success_probability <= 25) {
--- a/lib/BotLib/Gamestat.pm
+++ b/lib/BotLib/Gamestat.pm
@@ -60,7 +60,7 @@ sub SeedArtifacts {
 	$tablename = lc ($tablename);

 	unless (-d $gamestatdir) {
-		make_path ($gamestatdir)  ||  die "Unable to create $dir: $OS_ERROR\n";
+		make_path ($gamestatdir)  ||  die "Unable to create $gamestatdir: $OS_ERROR\n";
 	}

 	my $dbh = DBI->connect ("dbi:SQLite:$dbfile", '', '');
--- a/lib/BotLib/Image.pm
+++ b/lib/BotLib/Image.pm
@@ -158,7 +158,7 @@ sub Obutts {
 	return $ret;
 }

-# It works but results are not particulary relevant, partially. about 20-30% miss
+# 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 = (
--- a/lib/BotLib/Image/Imgur.pm
+++ b/lib/BotLib/Image/Imgur.pm
@@ -76,7 +76,7 @@ sub Imgur {
 			$refresh_url => form {
 				refresh_token => $imgur_refresh_token,
 				client_id => $imgur_client_id,
-				clinent_secret => $imgur_client_secret,
+				client_secret => $imgur_client_secret,
 				grant_type => 'refresh_token',
 			}
 		);
--- a/lib/BotLib/Proverb.pm
+++ b/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:
--- a/lib/BotLib/Weather.pm
+++ b/lib/BotLib/Weather.pm
@@ -30,6 +30,15 @@ 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;

--- a/lib/Teapot/Bot/Brain.pm
+++ b/lib/Teapot/Bot/Brain.pm
@@ -458,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';
  }
--- a/lib/Teapot/Bot/Object/Base.pm
+++ b/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';

--- a/lib/Teapot/Bot/Object/Chat.pm
+++ b/lib/Teapot/Bot/Object/Chat.pm
@@ -17,6 +17,9 @@ has 'first_name';               # Optional.
 has 'last_name';                # Optional.
 has 'photo';                    # Teapot::Bot::Object::ChatPhoto. Optional. Returned only in getChat.
 has 'bio';                      # Optional. Bio of the other party in a private chat. Returned only in getChat.
+has 'has_private_forwards';     # Optional. True, if privacy settings of the other party in the private chat allows to
+                                # use tg://user?id=<user_id> links only in chats with the user.
+                                # Returned only in getChat.
 has 'description';              # Optional. Returned only in getChat.
 has 'invite_link';              # Optional. Returned only in getChat.
 has 'pinned_message';           # Teapot::Bot::Object::Message
@@ -25,6 +28,8 @@ has 'permissions';              # Teapot::Bot::Object::ChatPermissions. Optional
 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
@@ -32,8 +37,9 @@ has 'location';                 # Optional. Returned only in getChat.

 sub fields {
  return {
-          'scalar'                               => [qw/id type title username first_name last_name bio description
-                                                        invite_link slow_mode_delay message_auto_delete_time
+          'scalar'                               => [qw/id type title username first_name last_name bio
+                                                        has_private_forwards description invite_link slow_mode_delay
+                                                        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/],
--- a/lib/Teapot/Bot/Object/ChatInviteLink.pm
+++ b/lib/Teapot/Bot/Object/ChatInviteLink.pm
@@ -8,15 +8,19 @@ $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 is_primary is_revoked expire_date expire_date member_limit/],
+    '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/],
  };
 }
--- a/lib/Teapot/Bot/Object/ChatMember.pm
+++ b/lib/Teapot/Bot/Object/ChatMember.pm
@@ -83,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;
    }
@@ -91,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;
    }
@@ -100,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;
    }
--- a/lib/Teapot/Bot/Object/ChatPermissions.pm
+++ b/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') {
--- a/lib/Teapot/Bot/Object/Message.pm
+++ b/lib/Teapot/Bot/Object/Message.pm
@@ -52,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';
@@ -102,8 +104,8 @@ sub fields {
  return {
          'scalar'                                      => [qw/message_id date forward_from_message_id
                                                            forward_signature forward_sender_name
-                                                            forward_date edit_date media_group_id
-                                                            author_signature text caption
+                                                            forward_date is_automatic_forward edit_date has_protected_content
+                                                            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
@@ -155,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});
  }

@@ -168,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';
@@ -185,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});
  }

--- a/lib/TelegramBot.pm
+++ b/lib/TelegramBot.pm
@@ -5,19 +5,19 @@ 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 Log::Any qw ($log);
 use Math::Random::Secure qw (irand);
 use Mojo::Base 'Teapot::Bot::Brain';
 use BotLib::Admin qw (FortuneToggleList);
 use BotLib qw (RandomCommonPhrase Command Highlight BotSleep IsCensored);
 use BotLib::Conf qw (LoadConf);
 use BotLib::Fortune qw (Fortune);
+use BotLib::Image qw (Oboobs Obutts);
 use BotLib::Karma qw (KarmaSet);
 use BotLib::Util qw (trim fmatch);

@@ -115,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;
 				}
 			}

@@ -138,9 +150,9 @@ 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;
@@ -189,23 +201,41 @@ sub __on_msg {
 				} 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 '') {
-					$reply = $str;
-					$phrase = trim $text;
+					if (defined ($str) && $str ne '') {
+						$reply = $str;
+						$phrase = trim $text;

-					while ($phrase =~ /[\.|\,|\?|\!]$/) {
-						chop $phrase;
-					}
+						while ($phrase =~ /[\.|\,|\?|\!]$/) {
+							chop $phrase;
+						}

-					$phrase = lc $phrase;
+						$phrase = lc $phrase;

-					if (fmatch (lc ($reply), $phrase)) {
-						$reply = RandomCommonPhrase ();
+						if (fmatch (lc ($reply), $phrase)) {
+							$reply = RandomCommonPhrase ();
+						}
 					}
 				}
 			}
@@ -244,20 +274,31 @@ sub __on_msg {
 			$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 'Дратути, ') &&
-			    (substr ($msg->reply_to_message->text, -61) eq 'Представьтес, пожалуйста, и расскажите, что вас сюда привело.')) {
-				return;
-			} else {
-				# remove our name from users reply, just in case
-				my $pat1 = quotemeta ('@' . $myusername);
-				my $pat2 = quotemeta $myfullname;
-				$phrase = $text;
-				$phrase =~ s/$pat1//g;
-				$phrase =~ s/$pat2//g;
+			if (substr ($msg->reply_to_message->text, -61) eq 'Представьтес, пожалуйста, и расскажите, что вас сюда привело.') {
+				my @hello = (
+					'Дратути, ',
+					'Дарована, ',
+					'Доброе утро, день или вечер, ',
+					'Добро пожаловать в наше скромное коммунити, ',
+					'Наше вам с кисточкой тут, на канальчике, ',
+				);
+
+				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);
@@ -277,8 +318,12 @@ sub __on_msg {
 			if ((lc ($text) =~ /^${qname}[\,|\:]? (.+)/) or (lc ($text) =~ /^${qtname}[\,|\:]? (.+)/)){
 				$phrase = $1;

-				if ($phrase =~ /^кто +все +эти +люди *\?$/i) {
+				if ($phrase =~ /^ *кто +все +эти +люди *\?$/ui) {
 					$reply = 'Кто здесь?';
+				} elsif ($phrase =~ /^ *кто +я *?$/ui){
+					$reply = 'Где?';
+				} elsif ($phrase =~ /^ *кто +(здесь|тут) *\?$/ui) {
+					$reply = 'Здесь все: Никита, Стас, Гена, Турбо и Дюша Метёлкин.';
 				} else {
 					$reply = $hailo->{$msg->chat->id}->learn_reply ($phrase);
 				}
@@ -286,8 +331,12 @@ sub __on_msg {
 			} elsif ((lc ($text) =~ /.+ ${qname}[\,|\!|\?|\.| ]/) or (lc ($text) =~ / $qname$/)) {
 				$phrase = $text;

-				if ($phrase =~ /^кто +все +эти +люди *\?$/i) {
+				if ($phrase =~ /^ *кто +все +эти +люди *\?$/ui) {
 					$reply = 'Кто здесь?';
+				} elsif ($phrase =~ /^ *кто +я *?$/ui){
+					$reply = 'Где?';
+				} elsif ($phrase =~ /^ *кто +(здесь|тут) *\?$/ui) {
+					$reply = 'Здесь все: Никита, Стас, Гена, Турбо и Дюша Метёлкин.';
 				} else {
 					$reply = $hailo->{$msg->chat->id}->learn_reply ($phrase);
 				}
@@ -295,8 +344,12 @@ sub __on_msg {
 			} elsif ((lc ($text) =~ /.+ ${qtname}[\,|\!|\?|\.| ]/) or (lc ($text) =~ / $qtname$/)) {
 				$phrase = $text;

-				if ($phrase =~ /^кто +все +эти +люди *\?$/i) {
+				if ($phrase =~ /^ *кто +все +эти +люди *\?$/ui) {
 					$reply = 'Кто здесь?';
+				} elsif ($phrase =~ /^ *кто +я *?$/ui){
+					$reply = 'Где?';
+				} elsif ($phrase =~ /^ *кто +(здесь|тут) *\?$/ui) {
+					$reply = 'Здесь все: Никита, Стас, Гена, Турбо и Дюша Метёлкин.';
 				} else {
 					$reply = $hailo->{$msg->chat->id}->learn_reply ($phrase);
 				}
@@ -312,8 +365,12 @@ sub __on_msg {
 				}
 			# just message in chat
 			} else {
-				if ($text =~ /^кто +все +эти +люди *\?$/i) {
+				if ($text =~ /^ *кто +все +эти +люди *\?$/ui) {
 					$reply = 'Кто здесь?';
+				} elsif ($phrase =~ /^ *кто +я *?$/ui){
+					$reply = 'Где?';
+				} elsif ($phrase =~ /^ *кто +(здесь|тут) *\?$/ui) {
+					$reply = 'Здесь все: Никита, Стас, Гена, Турбо и Дюша Метёлкин.';
 				} else {
 					$hailo->{$msg->chat->id}->learn ($text);
 				}
Author	SHA1	Message	Date
eleksir	cec2f2f875	Use ->canTalk() instead of ::canTalk() in Message.pm as it is more reliable way to check this	2022-02-03 02:03:50 +03:00
eleksir	a4d0afab5d	Use JSON::PP explicitly rather than implicitly	2022-02-03 02:00:06 +03:00
eleksir	75d0e07c6d	Fix error handling in canDeleteMessage	2022-02-03 00:42:13 +03:00
eleksir	b503fec769	Fix error handling in canTalk()	2022-02-03 00:29:26 +03:00
eleksir	c9e664b4e5	Update readmes about runtime environment	2022-01-29 18:10:56 +03:00
eleksir	e552ecbf00	Pin versions in cpanfile	2022-01-29 18:06:23 +03:00
eleksir	ea634710f1	In newcommer greeting treat space-char-only first_name or last_name as non-existing	2022-01-29 17:32:25 +03:00
eleksir	e784a78979	Use all types of greet phrases to omit answer if newcommer respond to our greet with quotation	2022-01-29 17:21:04 +03:00
eleksir	b992698b9b	Add easter egg phrases in private and group conversations, fix previous addition of private phrases a bit	2021-12-25 15:41:20 +03:00
eleksir	8d21991af6	Put disclaimer about feature freeze and update help message with relevant software version text	2021-12-20 00:01:43 +03:00
eleksir	f223ba04ae	Extend weather command list, add !weather, !погода, !погадка, !погодка, also allow oboobs and obutts plugins in private conversation	2021-12-18 17:24:21 +03:00
eleksir	8d35bb2452	Update api with fields from v5.4 and v5.5	2021-12-07 20:11:56 +03:00
eleksir	71a2471725	Couple of grammar and coding style mistakes fixes here and there	2021-12-04 03:10:41 +03:00
eleksir	e93c9f9131	Use different hello-phrases to greet newcommers	2021-12-03 20:25:51 +03:00
eleksir	1abb95622a	Fix bunch of grammar mistakes	2021-10-17 01:14:38 +03:00
eleksir	bb399a5051	Add undocumented commands !kde and !кде	2021-10-12 10:54:30 +03:00
eleksir	c5014a8f77	Weather.pm: Hardcode popular russian short city names	2021-10-01 13:23:00 +03:00
eleksir	f83a2d3436	Anek.pm: fix rare case when fetched response is unparsable	2021-08-16 00:03:38 +03:00
eleksir	2134edd841	Implemented !proverb and !пословица commands	2021-08-11 16:54:21 +03:00
eleksir	3dd565c658	Implemented !coin !монетка !roll !dies !кости commands	2021-08-11 13:19:56 +03:00
eleksir	7147b785e7	Add !anek !анек !анекдот commands	2021-07-29 21:26:59 +03:00
eleksir	f1ad32d5ae	Add migration scripts and doc. 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.	2021-07-05 16:56:01 +03:00
eleksir	66f64da5c6	Fix incorrect error message when unable to create gamestatdir	2021-07-05 13:54:27 +03:00