Merge branch 'master' into update_teapot_bot_lib_to_api_v5.1

.gitignore

@@ -1,15 +1,13 @@
 _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/lat/**
 data/telegrambot-brains/**
+data/lat/**
+data/image/**
 vendor_perl/**

README_RU.md

@@ -81,10 +81,9 @@ openweathermap в качестве appid. На этом всё.
 "verifier" в конфиге либо закоменчен либо отсутствует.
 
 Запустите **bin/flickr_init.pl** и следуте предлагаемым инструкциям - в итоге
-будет дана ссылка, которую надо скопипастить в браузер. По ссылке предложат
-залогиниться, далее надо будет разрешить приложению просматривать профиль и
-через один-два редиректа вы попадёте на example.com. Из адресной строки браузера
-надо скопировать параметр "verifier" и вписать его в **config.json**.
+будет дана ссылка, которую надо скопипастить в браузер и через один-два
+редиректа вы попадёте на example.com. Из адресной строки браузера надо
+скопировать параметр "verifier" и вписать его в **config.json**.
 
 Чтобы сохранить в бд плагина API access token для нормальной работы "плагина",
 второй раз запустите **bin/flickr_init.pl**. На этом всё.

bin/aleesa-telegram-bot

@@ -29,12 +29,11 @@ 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 BotLib::Conf qw (LoadConf);
-use TelegramBot qw (RunTelegramBot);
+use conf qw (loadConf);
+use telegrambot qw (run_telegrambot);
 
 sub daemonize;
 sub __fork;
@@ -44,8 +43,7 @@ local $OUTPUT_AUTOFLUSH = 1;
 my $runAsUid = $UID;
 
 my $piddir = '/var/run/' . basename (abs_path ($PROGRAM_NAME));
-my $C = LoadConf ();
-my $loglevel = $C->{'loglevel'} // 'notice';
+my $C = loadConf ();
 my $logfile;
 
 if (defined $C->{'log'}) {
@@ -94,19 +92,7 @@ if ($UID == 0) {
 }
 
 if (defined $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'
-	);
+	Log::Any::Adapter->set ('File', $logfile);
 } else {
 	Log::Any::Adapter->set ('File', '/dev/null');
 }
@@ -118,24 +104,14 @@ daemonize ();
 my $apath = abs_path $PROGRAM_NAME;
 
 unless (defined $apath) {
-	$log->fatal ("[FATAL] Unable to get abs_path: $OS_ERROR\n");
-	exit 1;
+	die "[FATAL] Unable to get abs_path: $OS_ERROR\n";
 };
 
 # write pidfile
 my $pidfile = sprintf '%s/%s.pid', $piddir, basename $apath;
-$log->info ("[INFO] Creating pidfile at $pidfile");
-
-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;
-};
-
+warn "[INFO] Creating pidfile at $pidfile\n";
+open my $MYPID, '>', $pidfile or die "[FATAL] Error opening $pidfile: $OS_ERROR\n";
+print {$MYPID} $PID or die "[FATAL] Error writing to $pidfile: $OS_ERROR\n";
 close $MYPID;                                        ## no critic (InputOutput::RequireCheckedSyscalls
 
 local $SIG{INT}  = \&__signal_handler;
@@ -145,7 +121,7 @@ local $SIG{TERM} = \&__signal_handler;
 $PROGRAM_NAME = abs_path $PROGRAM_NAME;              ## no critic (Variables::RequireLocalizedPunctuationVars)
 
 # run bot, at last
-RunTelegramBot ();
+run_telegrambot ();
 
 if (-f $pidfile) {
 	unlink $pidfile;
@@ -169,8 +145,7 @@ sub __fork {
 	my $pid = fork;
 
 	unless (defined $pid) {
-		$log->fatal ("[FATAL] Can't fork: $OS_ERROR");
-		exit 1;
+		die "[FATAL] Can't fork: $OS_ERROR\n";
 	}
 
 	if ($pid != 0) {
@@ -181,7 +156,7 @@ sub __fork {
 }
 
 sub __signal_handler {
-	$log->info ("[INFO] Caught a signal $OS_ERROR");
+	warn "[INFO] Caught a signal $OS_ERROR\n";
 
 	if (-f $pidfile) {
 		unlink $pidfile;

bin/flickr.pl

@@ -20,9 +20,9 @@ BEGIN {
 }
 
 use lib ("$workdir/lib", "$workdir/vendor_perl", "$workdir/vendor_perl/lib/perl5");
-use BotLib::Image::Flickr qw (FlickrByTags);
+use flickr qw (flickr_by_tags);
 
-my $url = FlickrByTags ('bird,owl');
+my $url = flickr_by_tags ('bird,owl');
 
 if ($url) {
 	say $url; ## no critic (InputOutput::RequireCheckedSyscalls)

bin/flickr_init.pl

@@ -20,9 +20,9 @@ BEGIN {
 }
 
 use lib ("$workdir/lib", "$workdir/vendor_perl", "$workdir/vendor_perl/lib/perl5");
-use BotLib::Image::Flickr qw (FlickrInit);
+use flickr qw (flickr_init);
 
-if (FlickrInit ()) {
+if (flickr_init ()) {
 	exit 0;
 } else {
 	exit 1;

bin/flickr_test.pl

@@ -20,9 +20,9 @@ BEGIN {
 }
 
 use lib ("$workdir/lib", "$workdir/vendor_perl", "$workdir/vendor_perl/lib/perl5");
-use BotLib::Image::Flickr qw (FlickrTestLogin);
+use flickr qw (flickr_test_login);
 
-if (FlickrTestLogin ()) {
+if (flickr_test_login ()) {
 	exit 0;
 } else {
 	exit 1;

bin/fortune_seed.pl

@@ -20,7 +20,9 @@ BEGIN {
 }
 
 use lib ("$workdir/lib", "$workdir/vendor_perl", "$workdir/vendor_perl/lib/perl5");
-use BotLib::Fortune qw (Seed);
+use 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 BotLib::Friday qw (Seed);
+use friday qw (seed);
 
-Seed ();
+seed ();
 exit 0;

bin/gamedata_seed.pl

@@ -1,26 +0,0 @@
-#!/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/train_lat.pl

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

cpanfile

@@ -5,8 +5,6 @@ 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';
@@ -28,7 +26,6 @@ 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';

data/archeologic_artifacts.txt

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

data/fisher_artifacts.txt

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

data/sample_config.json

@@ -1,10 +1,7 @@
 {
-    # Cachedir used not only for caches but for some settings and stats too.
-    "cachedir" : "data/cache",
-
-    "gamestat" : {
-        "dir" : "data",
-        "gamestatdir" : "data/gamestat"
+    "admin" : {
+# store per-channel (per-conversation) settings
+        "dir" : "data/admin"
     },
 
     "fortune" : {
@@ -18,51 +15,51 @@
     },
 
     "image": {
+        "dir" : "data/image",
         "imgur" : {
-            # See README.md about these settings - auth'ed search settings.
+# 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.
+# see README.md about these settings - auth'ed search settings
             "consumer_key" : "md5-like_hash",
             "consumer_secret" : "some_hash-like_string",
             "verifier": "some_hash-like_string"
         }
     },
 
+    "karma": {
+        "dir": "data/karma"
+    },
+
     "lat" : {
         "brain": "data/lat/brain.sqlite",
         "src": "data/lat.txt"
     },
 
-    # Required for debugging reasons, if commented out or not exist, no debug logging appears at all.
-    "log" : "/var/log/aleesa-telegram-bot/aleesa.log",
+# required for debugging reasons, if commented out or not exist, no debug logging appears at all
+    "log" : "/var/log/aleesa-telegram-bot/debug.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.
+# openwatermap plugin
     "openweathermap" : {
         "appid" : "md5sum-like_string",
+# result cache, stores data for 4 hours
+        "cachedir" : "data/cache",
     },
 
-    # Stuff for telegram itself.
+# stuff for telegram itself
     "telegrambot" : {
-
-        # Directory with per-conversation "brains".
+# 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.
+# prefix-sign for all commands. in many irc-bots (eggdrop/windrop) it is "." (dot), in sulci it was "!"
+# in telegram commands begin with "/" on the start of first (and only) line.
         "csign" : "!",
-
         "token" : "Long_string_given_by_@BotFather"
     },
 
-    # Unprivileged user to run this bot from.
+# unprivileged user to run this bot from
     "user" : "unit",
 }

lib/BotLib/Admin.pm

@@ -1,261 +0,0 @@
-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;
-
-	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/Archeologist.pm

@@ -1,108 +0,0 @@
-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/Gamestat.pm

@@ -1,115 +0,0 @@
-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 $dir: $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/Karma.pm

@@ -1,104 +0,0 @@
-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/Xkcd.pm

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

@@ -18,13 +18,6 @@ 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';
 
@@ -139,20 +132,20 @@ sub getChatMember {
   }
 }
 
-sub banChatMember {
+sub kickChatMember {
   my $self = shift;
   my $args = shift || {};
 
-  my $token = $self->token || croak 'No token supplied to banChatMember?';
+  my $token = $self->token || croak 'No token supplied to kickChatMember?';
   my $send_args = {};
 
   unless ($args->{chat_id}) {
-    cluck 'No chat_id supplied to banChatMember()';
+    cluck 'No chat_id supplied to kickChatMember()';
     return {'error' => 1};
   }
 
   unless ($args->{user_id}) {
-    cluck 'No user_id supplied to banChatMember()';
+    cluck 'No user_id supplied to kickChatMember()';
     return {'error' => 1};
   }
 
@@ -161,7 +154,7 @@ sub banChatMember {
   $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 $url = "https://api.telegram.org/bot${token}/kickChatMember";
   my $api_response = $self->_post_request($url, $send_args);
 
   return;
@@ -361,7 +354,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);
   }
@@ -440,11 +433,11 @@ sub sendChatAction {
   elsif ($args->{action} eq 'upload_video') {
     $send_args->{action} = 'upload_video';
   }
-  elsif ($args->{action} eq 'record_voice') {
-    $send_args->{action} = 'record_voice';
+  elsif ($args->{action} eq 'record_audio') {
+    $send_args->{action} = 'record_audio';
   }
-  elsif ($args->{action} eq 'upload_voice') {
-    $send_args->{action} = 'upload_voice';
+  elsif ($args->{action} eq 'upload_audio') {
+    $send_args->{action} = 'upload_audio';
   }
   elsif ($args->{action} eq 'upload_document') {
     $send_args->{action} = 'upload_document';
@@ -805,10 +798,10 @@ of Chat User.
 
 On error returns hash reference with error set to 1
 
-=head2 banChatMember
+=head2 kickChatMember
 
-This is the wrapper around the C<banChatMember> API method. See
-L<https://core.telegram.org/bots/api#banchatmember>.
+This is the wrapper around the C<kickChatMember> API method. See
+L<https://core.telegram.org/bots/api#kickchatmember>.
 
 Takes chat_id, and user_id as arguments. And optionally until_date and
 revoke_messages.

lib/Teapot/Bot/Object/Animation.pm

@@ -8,7 +8,6 @@ use Carp qw/croak/;
 $Teapot::Bot::Object::Animation::VERSION = '0.022';
 
 has 'file_id';
-has 'file_unique_id';
 has 'width';
 has 'height';
 has 'duration';
@@ -18,8 +17,7 @@ has 'mime_type';
 has 'file_size';
 
 sub fields {
-  return { scalar                           => [qw/file_id file_unique_id width height duration file_name mime_type
-                                                   file_size/],
+  return { scalar                           => [qw/file_id width height duration file_name mime_type file_size/],
            'Teapot::Bot::Object::PhotoSize' => [qw/thumb/],
          };
 }

lib/Teapot/Bot/Object/Base.pm

@@ -54,14 +54,115 @@ sub create_from_array {
   }
 
   unless (ref ($array) eq 'ARRAY') {
-    cluck 'Not array ' . Dumper ($array);
+    cluck 'Not array ' . Dumper ($hash);
     return $obj;
   }
 
   cluck "Dumping class: " . Dumper ($class);
   cluck "Dumping array: " . Dumper ($array);
+ Dumping array: $VAR1 = [
+          [
+            {
+              'text' => 'Spotify',
+              'url' => 'https://open.spotify.com/track/44MxUoeZg6FXDlHMrSbVjX'
+            },
+            {
+              'text' => 'Tidal',
+              'url' => 'https://listen.tidal.com/track/159119367'
+            },
+            {
+              'url' => 'https://music.apple.com/us/album/_/1534782030?i=1534782031',
+              'text' => 'Apple'
+            }
+          ],
+          [
+            {
+              'text' => 'Deezer',
+              'url' => 'https://www.deezer.com/track/1112603372'
+            },
+            {
+              'text' => 'YouTube',
+              'url' => 'https://music.youtube.com/watch?v=KT1jJDh7ir0'
+            },
+            {
+              'url' => 'https://song.link/s/44MxUoeZg6FXDlHMrSbVjX',
+              'text' => 'eXtra'
+            }
+          ]
+        ];
+
+ Dumping array: $VAR1 = [
+          [
+            {
+              'callback_data' => 'l85882326|open.spotify.com/track/44MxUoeZg6FXDlHMrSbVjX',
+              'text' => 'Get links'
+            }
+          ]
+        ];
+
+# https://core.telegram.org/bots/api#inlinekeyboardmarkup
+# который содержит в себе тупо массив
+# Array of Array of Teapot::Bot::Object::InlineKeyboardButton
+
+# https://core.telegram.org/bots/api#userprofilephotos
+# аналогично предыдущему содержит
+# Array of Array of Teapot::Bot::Object::PhotoSize
+
+  # deal with each type of field
+  foreach my $type (keys %{ $class->fields }) {
+    my @fields_of_this_type = @{ $class->fields->{$type} };
+
+    foreach my $field (@fields_of_this_type) {
+      # ignore undefined fields (sic!)
+      next if (! defined $field);
+
+      # ignore fields for which we have no value in the hash
+      next if (! defined $hash->{$field} );
+
+      # warn "type: $type field $field\n";
+      if ($type eq 'scalar') {
+        if ($obj->_field_is_array($field)) {
+          # simple scalar array ref, so just copy it
+          my $val = $hash->{$field};
+          # deal with boolean stuff so we don't pollute our object
+          # with JSON
+          if (ref($val) eq 'JSON::PP::Boolean') {
+            $val = !!$val;
+          }
+          $obj->$field($val);
+        }
+        elsif ($obj->_field_is_array_of_arrays) {
+          croak 'Not yet implemented for scalars';
+        }
+        else {
+          my $val = $hash->{$field};
+          if (ref($val) eq 'JSON::PP::Boolean') {
+            $val = 0+$val;
+
+          }
+          $obj->$field($val);
+        }
+      }
+
+      else {
+        if ($obj->_field_is_array($field)) {
+          my @sub_array;
+          foreach my $data ( @{ $hash->{$field} } ) {
+            push @sub_array, $type->create_from_hash($data, $brain);
+          }
+          $obj->$field(\@sub_array);
+        }
+        elsif ($obj->_field_is_array_of_arrays) {
+          croak 'Not yet implemented for scalars';
+        }
+        else {
+          $obj->$field($type->create_from_hash($hash->{$field}, $brain));
+        }
+
+      }
+    }
+  }
 
-# it's stub, return $obj
   return $obj;
 }
 
@@ -79,7 +180,7 @@ sub create_from_hash {
   }
 
   unless (ref ($hash) eq 'HASH') {
-    if (ref ($hash) eq 'ARRAY') {
+    if (ref ($array) eq 'ARRAY') {
       return create_from_array($class, $hash, $brain);
     }
 

lib/Teapot/Bot/Object/Chat.pm

@@ -11,30 +11,27 @@ $Teapot::Bot::Object::Chat::VERSION = '0.022';
 
 has 'id';
 has 'type';
-has 'title';                    # Optional.
-has 'username';                 # Optional.
-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 'description';              # Optional. Returned only in getChat.
-has 'invite_link';              # Optional. Returned only in getChat.
-has 'pinned_message';           # Teapot::Bot::Object::Message
-has 'permissions';              # Teapot::Bot::Object::ChatPermissions. Optional. Default chat member permissions, for
-                                # groups and supergroups. 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 '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.
+has 'title';               # Optional.
+has 'username';            # Optional.
+has 'first_name';          # Optional.
+has 'last_name';           # Optional.
+has 'photo';               # Teapot::Bot::Object::ChatPhoto. Optional. 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
+has 'permissions';         # Teapot::Bot::Object::ChatPermissions. Optional. Default chat member permissions, for
+                           # groups and supergroups. Returned only in getChat.
+has 'slow_mode_delay';     # Optional. Returned only in getChat.
+has 'sticker_set_name';    # Optional. Returned only in getChat.
+has 'can_set_sticker_set'; # Optional. Returned only in getChat.
+has 'linked_chat_id';      # Optional. greater than 32 bits, smaller than 52 bits
+has 'location';            # Optional. Returned only in getChat.
 
 sub fields {
   return {
-          'scalar'                               => [qw/id type title username first_name last_name bio description
-                                                        invite_link slow_mode_delay message_auto_delete_time
-                                                        sticker_set_name can_set_sticker_set linked_chat_id/],
+          'scalar'                               => [qw/id type title username first_name last_name description 
+                                                        invite_link slow_mode_delay 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/ChatMember.pm

@@ -7,58 +7,32 @@ use Carp qw(cluck);
 
 $Teapot::Bot::Object::ChatMember::VERSION = '0.022';
 
-# ChatMemberOwner
-has   'user';
-has   'status';
-has   'custom_title';              # optional. Owner and administrators only.
-has   'is_anonymous';              # Optional. Owner and administrators only.
+has 'user';
+has 'status';
+has 'custom_title';              # optional. Owner and administrators only.
+has 'is_anonymous';              # Optional. Owner and administrators only.
 
-# ChatMemberAdministrator
-# has 'user';
-# has 'status';
-has   'can_be_edited';             # optional. Administrators only.
-# has 'custom_title';              # optional. Owner and administrators only.
-# has 'is_anonymous';              # Optional. Owner and administrators only.
-has   'can_manage_chat';           # Optional. Administrators only. True, if the administrator can access the chat event
+has 'can_be_edited';             # optional. Administrators only.
+has 'can_manage_chat'            # Optional. Administrators only. True, if the administrator can access the chat event
                                  # log, chat statistics, message statistics in channels, see channel members, see
                                  # anonymous administrators in supergroups and ignore slow mode. Implied by any other
                                  # administrator privilege
-has   'can_post_messages';         # optional. Administrators only.
-has   'can_edit_messages';         # optional. Administrators only.
-has   'can_delete_messages';       # optional. Administrators only.
-has   'can_manage_voice_chats';    # Optional. Administrators only. True, if the administrator can manage voice chats
-has   'can_restrict_members';      # optional. Administrators only.
-has   'can_promote_members';       # optional. Administrators only.
-has   'can_change_info';           # optional. Administrators and restricted only.
-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.
+has 'can_post_messages';         # optional. Administrators only.
+has 'can_edit_messages';         # optional. Administrators only.
+has 'can_delete_messages';       # optional. Administrators only.
+has 'can_manage_voice_chats'     # Optional. Administrators only. True, if the administrator can manage voice chats
+has 'can_restrict_members';      # optional. Administrators only.
+has 'can_promote_members';       # optional. Administrators only.
+has 'can_change_info';           # optional. Administrators and restricted only.
+has 'can_invite_users';          # optional. Administrators and restricted only.
+has 'can_pin_messages';          # optional. Administrators and restricted only.
+has 'is_member';                 # optional. 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.
 
 sub fields {
   return {

lib/Teapot/Bot/Object/ChatMemberUpdated.pm

@@ -6,7 +6,6 @@ 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';
 
@@ -15,8 +14,6 @@ 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.
 
@@ -24,9 +21,8 @@ sub fields {
   return {
           'Teapot::Bot::Object::Chat'           => [qw/chat/],
           'Teapot::Bot::Object::User'           => [qw/from/],
-          'scalar'                              => [qw/date text/],
+          'scalar'                              => [qw/date/],
           'Teapot::Bot::Object::ChatMember'     => [qw/old_chat_member new_chat_member/],
-          'Teapot::Bot::Object::Voice'          => [qw/voice/],
           'Teapot::Bot::Object::ChatInviteLink' => [qw/invite_link/]
         };
 }

lib/Teapot/Bot/Object/Contact.pm

@@ -9,11 +9,10 @@ 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 vcard/],
+           scalar => [qw/phone_number first_name last_name user_id/],
          };
 }
 

lib/Teapot/Bot/Object/Document.pm

@@ -8,7 +8,6 @@ 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';
@@ -16,7 +15,7 @@ has 'file_size';
 
 sub fields {
   return {
-            scalar                          => [qw/file_id file_unique_id file_name mime_type file_size/],
+            scalar                          => [qw/file_id file_name mime_type file_size/],
            'Teapot::Bot::Object::PhotoSize' => [qw/thumb/]
          };
 }

lib/Teapot/Bot/Object/Message.pm

@@ -30,7 +30,6 @@ 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;
@@ -92,7 +91,6 @@ 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
@@ -137,7 +135,6 @@ sub fields {
           '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/],

lib/Teapot/Bot/Object/PhotoSize.pm

@@ -7,13 +7,12 @@ 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 file_unique_id width height file_size/] };
+  return { scalar => [qw/file_id width height file_size/] };
 }
 
 1;

lib/Teapot/Bot/Object/PollAnswer.pm

@@ -1,9 +1,9 @@
-package Teapot::Bot::Object::PollAnswer;
+package Teapot::Bot::Object::PollOption;
 # ABSTRACT: The base class for Telegram 'PollOption' type objects
 
 use Mojo::Base 'Teapot::Bot::Object::Base';
 
-$Teapot::Bot::Object::PollAnswer::VERSION = '0.022';
+$Teapot::Bot::Object::PollOption::VERSION = '0.022';
 
 has 'poll_id';
 has 'user';
@@ -30,17 +30,17 @@ __END__
 
 =head1 NAME
 
-Teapot::Bot::Object::PollAnswer - The base class for Telegram 'PollAnswer' type objects
+Teapot::Bot::Object::PollOption - The base class for Telegram 'PollOption' type objects
 
 =head1 VERSION
 
 version 0.022
 
 =head1 DESCRIPTION
-The base class for Telegram 'PollAnswer' type objects.
+The base class for Telegram 'PollOption' type objects.
 
-See L<https://core.telegram.org/bots/api#pollanswer> for details of the
-attributes available for L<Teapot::Bot::Object::PollAnswer> objects.
+See L<https://core.telegram.org/bots/api#polloption> for details of the
+attributes available for L<Teapot::Bot::Object::PollOption> objects.
 
 =head1 AUTHOR
 
@@ -48,7 +48,7 @@ Sergei Fedosov <eleksir@gmail.com>
 
 =head1 LICENSE AND COPYRIGHT
 
-This software is copyright (c) 2021 Sergei Fedosov <eleksir@gmail.com>.
+This software is copyright (c) 2020 Sergei Fedosov <eleksir@gmail.com>.
 
 This is free software; you can redistribute it and/or modify it under
 the same terms as the Perl 5 programming language system itself.

lib/Teapot/Bot/Object/VideoNote.pm

@@ -8,7 +8,6 @@ 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';
@@ -17,7 +16,7 @@ has 'file_size';
 
 sub fields {
   return {
-           scalar                           => [qw/file_id file_unique_id length duration mime_type file_size/],
+           scalar                           => [qw/file_id length duration mime_type file_size/],
            'Teapot::Bot::Object::PhotoSize' => [qw/thumb /],
          };
 }

lib/Teapot/Bot/Object/Voice.pm

@@ -6,13 +6,12 @@ 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 file_unique_id duration mime_type file_size/] };
+  return { scalar => [qw/file_id duration mime_type file_size/] };
 }
 
 1;

lib/Teapot/Bot/Object/VoiceChatEnded.pm

@@ -6,7 +6,7 @@ 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';
+has 'duartion';
 
 sub fields {
   return { scalar => [qw/duration/] };

lib/Teapot/Bot/Object/VoiceChatScheduled.pm

@@ -1,48 +0,0 @@
-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/admin.pm

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

lib/archeologist.pm

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

lib/botlib.pm

@@ -1,4 +1,4 @@
-package BotLib;
+package botlib;
 # store here utility functions that are not protocol-specified
 
 use 5.018;
@@ -10,32 +10,30 @@ 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::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::Util qw (trim);
-use BotLib::Weather qw (Weather);
-use BotLib::Xkcd qw (Xkcd);
+use conf qw (loadConf);
+use admin qw (@forbiddenMessageTypes getForbiddenTypes addForbiddenType delForbiddenType listForbidden fortune_toggle fortune_status plugin_toggle plugin_status pluginEnabled);
+use archeologist qw (dig);
+use buni qw (buni);
+use drink qw (drink);
+use fisher qw (fish);
+use fortune qw (fortune);
+use friday qw (friday);
+use image qw (kitty fox oboobs obutts rabbit owl);
+use karma qw (karmaSet karmaGet);
+use lat qw (latAnswer);
+use monkeyuser qw (monkeyuse);
+use util qw (trim);
+use weather qw (weather);
+use xkcd qw (xkcd);
 
 use version; our $VERSION = qw (1.0);
 use Exporter qw (import);
-our @EXPORT_OK = qw (RandomCommonPhrase Command Highlight BotSleep IsCensored);
+our @EXPORT_OK = qw (randomCommonPhrase command highlight botsleep isCensored);
 
-my $c = LoadConf ();
+my $c = loadConf ();
 my $csign = $c->{telegrambot}->{csign};
 
-sub RandomCommonPhrase {
+sub randomCommonPhrase {
 	my @myphrase = (
 		'Так, блядь...',
 		'*Закатывает рукава* И ради этого ты меня позвал?',
@@ -53,13 +51,13 @@ sub RandomCommonPhrase {
 	return $myphrase[irand ($#myphrase + 1)];
 }
 
-sub Command {
+sub command {
 	my $self = shift;
 	my $msg = shift;
 	my $text = shift;
 	my $chatid = shift;
 	my $reply;
-	my ($userid, $username, $fullname, $highlight, $visavi) = Highlight ($msg);
+	my ($userid, $username, $fullname, $highlight, $visavi) = highlight ($msg);
 
 	if (substr ($text, 1) eq 'ping') {
 		$reply = 'Pong.';
@@ -73,45 +71,27 @@ sub Command {
 		$reply = 'Версия:  Нуль.Чего-то_там.Чего-то_там';
 	} elsif (length ($text) >= 2 && (substr ($text, 1, 2) eq 'w ' || substr ($text, 1, 2) eq 'п ')) {
 		my $city = substr $text, 3;
-		$reply = Weather $city;
+		$reply = weather $city;
 	} elsif (substr ($text, 1) eq 'buni') {
 		$msg->typing ();
-		$reply = Buni ();
+		$reply = buni ();
 		sleep (irand (2) + 1);
 		$msg->replyMd ($reply);
 		return;
 	} elsif (substr ($text, 1) eq 'monkeyuser') {
 		$msg->typing ();
-		$reply = Monkeyuser ();
+		$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 ();
+		$reply = kitty ();
 		sleep (irand (2) + 1);
 		$msg->replyMd ($reply);
 		return;
 	} elsif (substr ($text, 1) eq 'lat'  ||  substr ($text, 1) eq 'лат') {
-		$reply = Lat ();
+		$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 'карма'
@@ -126,27 +106,27 @@ sub Command {
 			$mytext = '';
 		}
 
-		$reply = KarmaGet ($chatid, $mytext);
+		$reply = karmaGet ($chatid, $mytext);
 	} elsif (substr ($text, 1) eq 'xkcd') {
 		$msg->typing ();
-		$reply = Xkcd ();
+		$reply = xkcd ();
 		sleep (irand (2) + 1);
 		$msg->replyMd ($reply);
 		return;
 	} elsif (substr ($text, 1) eq 'fox'  ||  substr ($text, 1) eq 'лис') {
 		$msg->typing ();
-		$reply = Fox ();
+		$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 ();
+		$reply = rabbit ();
 		$msg->replyMd ($reply);
 		return;
 	} elsif (substr ($text, 1) eq 'owl'  ||  substr ($text, 1) eq 'сова') {
 		$msg->typing ();
-		$reply = Owl ();
+		$reply = owl ();
 		$msg->replyMd ($reply);
 		return;
 	} elsif (
@@ -157,9 +137,9 @@ sub Command {
 		substr ($text, 1) eq 'сиси'  ||
 		substr ($text, 1) eq 'сисечки'
 	) {
-		if (PluginEnabled $chatid, 'oboobs') {
+		if (pluginEnabled $chatid, 'oboobs') {
 			$msg->typing ();
-			$reply = Oboobs ();
+			$reply = oboobs ();
 			sleep (irand (2) + 1);
 			$msg->replyMd ($reply);
 		}
@@ -172,38 +152,36 @@ sub Command {
 		substr ($text, 1) eq 'попа'  ||
 		substr ($text, 1) eq 'попка'
 	) {
-		if (PluginEnabled $chatid, 'obutts') {
+		if (pluginEnabled $chatid, 'obutts') {
 			$msg->typing ();
-			$reply = Obutts ();
+			$reply = obutts ();
 			sleep (irand (2) + 1);
 			$msg->replyMd ($reply);
 		}
 
 		return;
 	} elsif (substr ($text, 1) eq 'friday'  ||  substr ($text, 1) eq 'пятница') {
-		$reply = Friday ();
+		$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 ());
+		$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 ();
+		$reply = drink ();
 		sleep (irand (2) + 1);
 	} elsif (substr ($text, 1) eq 'dig' || substr ($text, 1) eq 'копать') {
 		$msg->typing ();
-		$reply = Dig $highlight;
+		$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;
+		$reply = fish $highlight;
 		sleep (irand (2) + 1);
 		$msg->replyMd ($reply);
 		return;
-	} elsif (substr ($text, 1) eq 'хэлп' || substr ($text, 1) eq 'хелп') {
-		$reply = 'HALP!!!11';
 	} elsif (substr ($text, 1) eq 'help'  ||  substr ($text, 1) eq 'помощь') {
 		$reply = << "MYHELP";
 ```
@@ -219,13 +197,10 @@ ${csign}f | ${csign}ф                     - рандомная фраза из
 ${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}ping | ${csign}пинг               - попинговать бота
-${csign}snail | ${csign}улитка            - улитка
 ${csign}ver | ${csign}version | ${csign}версия   - что-то про версию ПО
 ${csign}w город | ${csign}п город         - погода в указанном городе
 ${csign}xkcd                       - рандомный стрип с сайта xkcd.ru
@@ -280,50 +255,50 @@ MYADMIN
 					my ($msgType, $toggle) = split /\s/, $args, 2;
 
 					if (defined $toggle) {
-						foreach (@ForbiddenMessageTypes) {
+						foreach (@forbiddenMessageTypes) {
 							if ($msgType eq $_) {
 								if ($toggle == 1) {
-									AddForbiddenType ($chatid, $msgType);
+									addForbiddenType ($chatid, $msgType);
 									$reply = "Теперь сообщения с $msgType будут автоматически удаляться";
 								} elsif ($toggle == 0) {
-									DelForbiddenType ($chatid, $msgType);
+									delForbiddenType ($chatid, $msgType);
 									$reply = "Теперь сообщения с $msgType будут оставаться";
 								}
 							}
 						}
 					}
 				} else {
-					$reply = ListForbidden ($chatid);
+					$reply = listForbidden ($chatid);
 				}
 			} elsif ($cmd eq 'fortune' || $cmd eq 'фортунка') {
 				if (defined $args) {
 					if ($args == 1) {
-						$reply = FortuneToggle ($chatid, 1);
+						$reply = fortune_toggle ($chatid, 1);
 					} elsif ($args == 0) {
-						$reply = FortuneToggle ($chatid, 0);
+						$reply = fortune_toggle ($chatid, 0);
 					}
 				} else {
-					$reply = FortuneStatus ($chatid);
+					$reply = fortune_status ($chatid);
 				}
 			} elsif ($cmd eq 'oboobs') {
 				if (defined $args) {
 					if ($args == 1) {
-						$reply = PluginToggle ($chatid, 'oboobs', 1);
+						$reply = plugin_toggle ($chatid, 'oboobs', 1);
 					} elsif ($args == 0) {
-						$reply = PluginToggle ($chatid, 'oboobs', 0);
+						$reply = plugin_toggle ($chatid, 'oboobs', 0);
 					}
 				} else {
-					$reply = PluginStatus ($chatid, 'oboobs');
+					$reply = plugin_status ($chatid, 'oboobs');
 				}
 			} elsif ($cmd eq 'obutts') {
 				if (defined $args) {
 					if ($args == 1) {
-						$reply = PluginToggle ($chatid, 'obutts', 1);
+						$reply = plugin_toggle ($chatid, 'obutts', 1);
 					} elsif ($args == 0) {
-						$reply = PluginToggle ($chatid, 'obutts', 0);
+						$reply = plugin_toggle ($chatid, 'obutts', 0);
 					}
 				} else {
-					$reply = PluginStatus ($chatid, 'obutts');
+					$reply = plugin_status ($chatid, 'obutts');
 				}
 			}
 		}
@@ -332,7 +307,7 @@ MYADMIN
 	return $reply;
 }
 
-sub Highlight {
+sub highlight {
 	my $msg = shift;
 
 	my $fullname;
@@ -374,7 +349,7 @@ sub Highlight {
 	return ($userid, $username, $fullname, $highlight, $visavi);
 }
 
-sub BotSleep {
+sub botsleep {
 	# TODO: Parametrise this with fuzzy sleep time in seconds
 	my $msg = shift;
 	# let's emulate real human and delay answer
@@ -390,10 +365,10 @@ sub BotSleep {
 	return;
 }
 
-sub IsCensored {
+sub isCensored {
 	my $msg = shift;
 
-	my $forbidden = GetForbiddenTypes ($msg->chat->id);
+	my $forbidden = getForbiddenTypes ($msg->chat->id);
 
 	# voice messages are special
 	if (defined ($msg->voice) && defined ($msg->voice->duration) && ($msg->voice->duration > 0)) {

lib/buni.pm

@@ -1,4 +1,4 @@
-package BotLib::Buni;
+package buni;
 
 use 5.018;
 use strict;
@@ -8,20 +8,18 @@ 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);
+our @EXPORT_OK = qw (buni);
 
-sub 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) {
@@ -49,7 +47,7 @@ sub Buni {
 			} while ($#{$a[0]} > 1);
 		}
 	} else {
-		$log->warn (sprintf '[WARN] Bunicomic server return status %s with message: %s', $r->code, $r->message);
+		cluck sprintf 'Server return status %s with message: %s', $r->code, $r->message;
 	}
 
 	return $ret;

lib/conf.pm

@@ -1,4 +1,4 @@
-package BotLib::Conf;
+package 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/drink.pm

@@ -1,4 +1,4 @@
-package BotLib::Drink;
+package drink;
 
 use 5.018;
 use strict;
@@ -12,21 +12,17 @@ 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);
+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 {
+sub drink {
 	my $r;
 	my $ret = 'Не знаю праздников - вджобываю весь день на шахтах, как проклятая.';
 	my ($dayNum, $monthNum) = (localtime ())[3, 4];
@@ -63,7 +59,7 @@ sub Drink {
 		$ua->cache_agent(
 				CHI->new (
 				driver             => 'BerkeleyDB',
-				root_dir           => $cachedir,
+				root_dir           => 'data/cache',
 				namespace          => __PACKAGE__,
 				expires_at         => $expirationDate,
 				expires_on_backend => 1,
@@ -104,7 +100,7 @@ sub Drink {
 			$ret = join "\n", @holyday;
 		}
 	} else {
-		$log->warn (sprintf '[WARN] Kakoysegodnyaprazdnik server return status %s with message: %s', $r->code, $r->message);
+		cluck sprintf 'Server return status %s with message: %s', $r->code, $r->message;
 	}
 
 	return $ret;

lib/fisher.pm

@@ -1,4 +1,4 @@
-package BotLib::Fisher;
+package fisher;
 
 use 5.018;
 use strict;
@@ -6,54 +6,66 @@ 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);
-
-my $c = LoadConf ();
-my $gamestatdir = $c->{gamestat}->{gamestatdir};
-my $dbfile = sprintf '%s/gamestat.sqlite', $gamestatdir;
+our @EXPORT_OK = qw (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 {
+sub fish {
 	my $name = shift;
 
+	my @artifact = (
+		'семикрылого чешуйчатого пятихуя',
+		'разумного конденсатора',
+		'сальмонеллу',
+		'селёдку',
+		'желтоперого тунца',
+		'розовую сальмонеллу',
+		'голавля',
+		'барбуса',
+		'окуня',
+		'верхоплавку',
+		'коричневую форель',
+		'полярника',
+		'плотву',
+		'зубатку',
+		'солнечную рыбу',
+		'старую шину',
+		'скользкую корягу',
+		'лампу джина',
+		'любовное послание в бутылке',
+		'старое бревно',
+		'резиновый сапог',
+		'труп',
+		'Лох-Несское чудовище',
+		'старую рыбацкую приманку',
+		'кусок Титаника',
+		'обломок Атлантиды',
+		'кита',
+		'кальмара',
+		'дельфина',
+		'ската',
+		'подводную лодку',
+		'медузу',
+		'морскую звезду',
+		'электрического угря',
+		'большую белую акулу',
+		'аквалангиста',
+		'монстра',
+		'вируса',
+		'сырую пачку сигарет',
+		'водоросли',
+		'якорь от лодки',
+		'водяного',
+		'русалку',
+		'палтуса',
+		'труп собаки по кличке Беня',
+		'олигофрена Проню',
+		'огеймера Фишкина',
+	);
+
 	my @location = (
 		'в поток',
 		'в озеро',
@@ -105,8 +117,7 @@ sub Fish {
 		return $phrase;
 	}
 
-	my $artifact = getRandomArtifact ();
-	$phrase .= sprintf "Поздравляю, %s! Вы только что поймали %s! аж на %d кило!\n\n", $name, $artifact, $weight;
+	$phrase .= sprintf "Поздравляю, %s! Вы только что поймали %s! аж на %d кило!\n\n", $name, $artifact[irand ($#artifact + 1)], $weight;
 
 	if ($success_probability <= 25) {
 		$phrase .= sprintf 'Ё-мое!!! А это ведь новый рекорд! Продолжай в том же духе, %s!', $name;

lib/flickr.pm

@@ -1,4 +1,4 @@
-package BotLib::Image::Flickr;
+package flickr;
 
 use 5.018;
 use strict;
@@ -7,26 +7,25 @@ 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 File::Path qw (make_path);
 use Math::Random::Secure qw (irand);
 use MIME::Base64;
 use Mojo::UserAgent;
+use SQLite_File;
 use URI::Encode::XS qw (uri_encode);
 
-use BotLib::Conf qw (LoadConf);
-use BotLib::Util qw (urlencode);
+use conf qw (loadConf);
+use util qw (urlencode);
 
 use Data::Dumper;
 
 use version; our $VERSION = qw (1.0);
 use Exporter qw (import);
-our @EXPORT_OK = qw (FlickrInit FlickrByTags FlickrByText FlickrTestLogin);
+our @EXPORT_OK = qw (flickr_init flickr_by_tags flickr_by_text flickr_test_login);
 
-my $c = LoadConf ();
-my $cachedir = $c->{cachedir};
+my $c = loadConf ();
+my $dir = $c->{image}->{dir};
 
 my $flickr_consumer_key      = $c->{image}->{flickr}->{consumer_key};
 my $flickr_consumer_secret   = $c->{image}->{flickr}->{consumer_secret};
@@ -186,10 +185,10 @@ sub flickrAuthorization {
 	my $ua = Mojo::UserAgent->new->connect_timeout (5);
 	my $r = $ua->get ($url)->result;
 
-	if ($r->code == 302) {
-		return $r->content->headers->location;
+	if ($r->is_success) {
+		return $r->url;
 	} else {
-		printf "Something went wrong: %s %s\n", $r->code, $r->message;
+		say "Something went wrong: $r->code $r->message"; ## no critic (InputOutput::RequireCheckedSyscalls)
 		return;
 	}
 }
@@ -336,19 +335,19 @@ sub flickrSearchByText {
 				if (defined $response) {
 					return $response;
 				} else {
-					$log->warn ("[WARN] Flickr api returns incorrect json: $r->message");
+					cluck "Flickr api returns incorrect json: $r->message";
 					return undef;
 				}
 			} else {
-				$log->warn ("[WARN] Flickr api returns incorrect json: $r->message");
+				cluck "Flickr api returns incorrect json: $r->message";
 				return undef;
 			}
 		} else {
-			$log->warn ("[WARN] Flickr api returns incorrect json: $r->message");
+			cluck "Flickr api returns incorrect json: $r->message";
 			return undef;
 		}
 	} else {
-		$log->warn ("[WARN] Flickr api HTTP status code not 200: $r->code, $r->message");
+		cluck "HTTP status code not 200: $r->code, $r->message";
 		return undef;
 	}
 }
@@ -443,85 +442,105 @@ sub flickrSearchByTags {
 				if (defined $response) {
 					return $response;
 				} else {
-					$log->warn ("[WARN] Flickr api returns incorrect json: $r->message");
+					cluck "Flickr api returns incorrect json: $r->message";
 					return undef;
 				}
 			} else {
-				$log->warn ("[WARN] Flickr api returns incorrect json: $r->message");
+				cluck "Flickr api returns incorrect json: $r->message";
 				return undef;
 			}
 		} else {
-			$log->warn ("[WARN] Flickr api returns incorrect json: $r->message");
+			cluck "Flickr api returns incorrect json: $r->message";
 			return undef;
 		}
 	} else {
-		$log->warn ("[WARN] Flickr api HTTP status code not 200: $r->code, $r->message");
+		cluck "HTTP status code not 200: $r->code, $r->message";
 		return undef;
 	}
 }
 
-sub FlickrInit {
-	my $cache = CHI->new (
-		driver => 'BerkeleyDB',
-		root_dir => $cachedir,
-		namespace => __PACKAGE__
-	);
+sub flickr_init {
+	my $backingfile = sprintf '%s/secrets.sqlite', $dir;
+
+	unless (-d $dir) {
+		make_path ($dir) or do {
+			say "Unable to create $dir: $OS_ERROR"; ## no critic (InputOutput::RequireCheckedSyscalls)
+			return 0;
+		};
+	}
+
+	tie my %secret, 'SQLite_File', $backingfile  ||  do {
+		say "[ERROR] Unable to tie to $backingfile: $OS_ERROR"; ## no critic (InputOutput::RequireCheckedSyscalls)
+		return 0;
+	};
 
 	if (defined $flickr_verifier && $flickr_verifier) {
-		my $flickr_request_token = $cache->get ('flickr_request_token');
-		my $flickr_request_token_secret = $cache->get ('flickr_request_token_secret');
+		my $flickr_request_token = $secret{flickr_request_token};
+		my $flickr_request_token_secret = $secret{flickr_request_token_secret};
 
 		unless (defined $flickr_request_token || defined $flickr_request_token_secret) {
-			say 'Looks like there is no request token or request token secret in config db.';    ## no critic (InputOutput::RequireCheckedSyscalls)
-			say 'Please remove verifier settings from config.json and run this script again.';   ## no critic (InputOutput::RequireCheckedSyscalls)
+			say "Looks like there is no request token or request token secret in $backingfile"; ## no critic (InputOutput::RequireCheckedSyscalls)
+			say 'Please remove verifier settings from config.json and run this script again';   ## no critic (InputOutput::RequireCheckedSyscalls)
+			untie %secret;
 			return 0;
 		}
 
 		my %accessToken = flickrAccessToken ($flickr_request_token, $flickr_request_token_secret, $flickr_verifier);
 
 		if (defined ($accessToken{oauth_token}) && defined ($accessToken{oauth_token_secret})) {
-			# TODO: check set
-			$cache->set ('flickr_access_token', $accessToken{oauth_token}, 'never');
-			$cache->set ('flickr_access_token_secret', $accessToken{oauth_token_secret}, 'never');
+			$secret{flickr_access_token} = $accessToken{oauth_token};
+			$secret{flickr_access_token_secret} = $accessToken{oauth_token_secret};
 
 			say sprintf ( ## no critic (InputOutput::RequireCheckedSyscalls)
-				'Access token (%s) and access token secret (%s) are config db',
+				'Access token (%s) and access token secret (%s) are in %s',
 				$accessToken{oauth_token},
 				$accessToken{oauth_token_secret},
+				$backingfile
 			);
 
+			untie %secret;
 			return 1;
 		}
 	} else {
 		my %req = flickrRequestToken ();
 		if (defined ($req{oauth_token}) && defined ($req{oauth_token_secret}) && defined ($req{oauth_token})) {
-			# TODO: check set
-			$cache->set ('flickr_request_token', $req{oauth_token}, 'never');
-			$cache->set ('flickr_request_token_secret', $req{oauth_token_secret}, 'never');
+			$secret{flickr_request_token} = $req{oauth_token};
+			$secret{flickr_request_token_secret} = $req{oauth_token_secret};
 			my $confirm_url = flickrAuthorization ($req{oauth_token});
 
 			if (defined $confirm_url) {
 				say "Please open this url in your browser and grant access for this app:\n$confirm_url"; ## no critic (InputOutput::RequireCheckedSyscalls)
 				say 'Do not forget to put oauth_verifier to config.json file and re-run this script to get access token'; ## no critic (InputOutput::RequireCheckedSyscalls)
 				say 'Note that you should be logged off from flickr account.'; ## no critic (InputOutput::RequireCheckedSyscalls)
+				untie %secret;
 				return 1;
 			}
 		}
 	}
 
+	untie %secret;
 	return 0;
 }
 
-sub FlickrTestLogin {
+sub flickr_test_login {
 	my $text = shift;
-	my $cache = CHI->new (
-		driver => 'BerkeleyDB',
-		root_dir => $cachedir,
-		namespace => __PACKAGE__
-	);
+	my $backingfile = sprintf '%s/secrets.sqlite', $dir;
 
-	my $flickr_access_token = $cache->get ('flickr_access_token');
-	my $flickr_access_token_secret = $cache->get ('flickr_access_token_secret');
+	unless (-d $dir) {
+		make_path ($dir) or do {
+			say "Unable to create $dir: $OS_ERROR"; ## no critic (InputOutput::RequireCheckedSyscalls)
+			return 0;
+		};
+	}
+
+	tie my %secret, 'SQLite_File', $backingfile  ||  do {
+		say "[ERROR] Unable to tie to $backingfile: $OS_ERROR"; ## no critic (InputOutput::RequireCheckedSyscalls)
+		return 0;
+	};
+
+	my $flickr_access_token = $secret{flickr_access_token};
+	my $flickr_access_token_secret = $secret{flickr_access_token_secret};
+	untie %secret;
 
 	if (flickrTestLogin ($flickr_access_token, $flickr_access_token_secret)) {
 		return 1;
@@ -530,17 +549,25 @@ sub FlickrTestLogin {
 	}
 }
 
-sub FlickrByTags {
+sub flickr_by_tags {
 	my $text = shift;
+	my $backingfile = sprintf '%s/secrets.sqlite', $dir;
 
-	my $cache = CHI->new (
-		driver => 'BerkeleyDB',
-		root_dir => $cachedir,
-		namespace => __PACKAGE__
-	);
+	unless (-d $dir) {
+		make_path ($dir) or do {
+			say "Unable to create $dir: $OS_ERROR"; ## no critic (InputOutput::RequireCheckedSyscalls)
+			return 0;
+		};
+	}
 
-	my $flickr_access_token = $cache->get ('flickr_access_token');
-	my $flickr_access_token_secret = $cache->get ('flickr_access_token_secret');
+	tie my %secret, 'SQLite_File', $backingfile  ||  do {
+		say "[ERROR] Unable to tie to $backingfile: $OS_ERROR"; ## no critic (InputOutput::RequireCheckedSyscalls)
+		return 0;
+	};
+
+	my $flickr_access_token = $secret{flickr_access_token};
+	my $flickr_access_token_secret = $secret{flickr_access_token_secret};
+	untie %secret;
 
 	# NB: I honestly query random page (among number of pages) of results from api, but always got first page,
 	# no matter what is shown in response' "page" parameter. Looks like bug in API. Try to little bit mitigate
@@ -555,7 +582,7 @@ sub FlickrByTags {
 			$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');
+			cluck 'Flickr api returns empty search result list';
 			return;
 		}
 	} else {
@@ -563,17 +590,25 @@ sub FlickrByTags {
 	}
 }
 
-sub FlickrByText {
+sub flickr_by_text {
 	my $text = shift;
+	my $backingfile = sprintf '%s/secrets.sqlite', $dir;
 
-	my $cache = CHI->new (
-		driver => 'BerkeleyDB',
-		root_dir => $cachedir,
-		namespace => __PACKAGE__
-	);
+	unless (-d $dir) {
+		make_path ($dir) or do {
+			say "Unable to create $dir: $OS_ERROR"; ## no critic (InputOutput::RequireCheckedSyscalls)
+			return 0;
+		};
+	}
 
-	my $flickr_access_token = $cache->get ('flickr_access_token');
-	my $flickr_access_token_secret = $cache->get ('flickr_access_token_secret');
+	tie my %secret, 'SQLite_File', $backingfile  ||  do {
+		say "[ERROR] Unable to tie to $backingfile: $OS_ERROR"; ## no critic (InputOutput::RequireCheckedSyscalls)
+		return 0;
+	};
+
+	my $flickr_access_token = $secret{flickr_access_token};
+	my $flickr_access_token_secret = $secret{flickr_access_token_secret};
+	untie %secret;
 
 	# NB: I honestly query random page (among number of pages) of results from api, but always got first page,
 	# no matter what is shown in response' "page" parameter. Looks like bug in API. Try to little bit mitigate
@@ -588,7 +623,7 @@ sub FlickrByText {
 			$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');
+			cluck 'Flickr api returns empty search result list';
 			return;
 		}
 	} else {

lib/fortune.pm

@@ -1,4 +1,4 @@
-package BotLib::Fortune;
+package fortune;
 # Any fortune_mod sources are suitable. Text file with "\n%\n" sentence delimeter.
 
 use 5.018;
@@ -9,20 +9,19 @@ 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 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";
 	}
@@ -66,11 +65,11 @@ sub Seed () {
 }
 
 # just return answer
-sub Fortune () {
+sub fortune () {
 	my $backingfile = sprintf '%s/fortune.sqlite', $dir;
 
 	tie my @array, 'SQLite_File', $backingfile  ||  do {
-		$log->error ("[ERROR] Unable to tie to $backingfile: $OS_ERROR");
+		cluck "[ERROR] Unable to tie to $backingfile: $OS_ERROR";
 		return '';
 	};
 

lib/friday.pm

@@ -1,4 +1,4 @@
-package BotLib::Friday;
+package friday;
 # for friday data stolen from https://raw.githubusercontent.com/isida/vi/master/data/friday.txt
 
 use 5.018;
@@ -9,21 +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 BotLib::Conf qw (LoadConf);
+use 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";
 	}
@@ -76,12 +75,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 {
-		$log->error ("[ERROR] Unable to tie to $backingfile: $OS_ERROR\n");
+		cluck "[ERROR] Unable to tie to $backingfile: $OS_ERROR\n";
 		return '';
 	};
 

lib/image.pm

@@ -1,4 +1,4 @@
-package BotLib::Image;
+package image;
 
 use 5.018;
 use strict;
@@ -7,18 +7,23 @@ use utf8;
 use open qw (:std :utf8);
 use English qw ( -no_match_vars );
 use Carp qw (cluck);
-use Log::Any qw ($log);
+use File::Path qw (make_path);
 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 SQLite_File;
+use conf qw (loadConf);
+use flickr qw (flickr_by_tags);
+use imgur qw (imgur);
+use util qw (urlencode);
 
 use version; our $VERSION = qw (1.0);
 use Exporter qw (import);
-our @EXPORT_OK = qw (Kitty Fox Oboobs Obutts Rabbit Owl Frog Horse Snail);
+our @EXPORT_OK = qw (kitty fox oboobs obutts rabbit owl);
 
-sub Kitty {
+my $c = loadConf ();
+my $dir = $c->{image}->{dir};
+
+sub kitty {
 	my $r;
 	my $ret = 'Нету кошечек, все разбежались.';
 
@@ -39,21 +44,21 @@ sub Kitty {
 		};
 
 		unless (defined $jcat) {
-			$log->warn ("[WARN] Unable to decode JSON from thecatapi: $EVAL_ERROR");
+			cluck "[ERROR] Unable to decode JSON: $EVAL_ERROR";
 		} else {
 			if ($jcat->[0]->{url}) {
-				my @cats = ('龴ↀ◡ↀ龴', '=^..^=', '≧◔◡◔≦ ','^ↀᴥↀ^');
+				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);
+		cluck sprintf 'Server return status %s with message: %s', $r->code, $r->message;
 	}
 
 	return $ret;
 }
 
-sub Fox {
+sub fox {
 	my $r;
 	my $ret = 'Нету лисичек, все разбежались.';
 
@@ -74,7 +79,7 @@ sub Fox {
 		};
 
 		unless (defined $jfox) {
-			$log->warn ("[WARN] Unable to decode JSON from randomfox: $EVAL_ERROR");
+			cluck "[ERROR] Unable to decode JSON: $EVAL_ERROR";
 		} else {
 			if ($jfox->{image}) {
 				$jfox->{image} =~ s/\\//xmsg;
@@ -82,13 +87,13 @@ sub Fox {
 			}
 		}
 	} else {
-		$log->warn (sprintf '[WARN] Randomfox server return status %s with message: %s', $r->code, $r->message);
+		cluck sprintf 'Server return status %s with message: %s', $r->code, $r->message;
 	}
 
 	return $ret;
 }
 
-sub Oboobs {
+sub oboobs {
 	my $r;
 	my $ret = 'Нету cисичек, все разбежались.';
 
@@ -109,7 +114,7 @@ sub Oboobs {
 		};
 
 		unless (defined $joboobs) {
-			$log->warn ("[WARN] Unable to decode JSON from oboobs: $EVAL_ERROR");
+			cluck "[ERROR] Unable to decode JSON: $EVAL_ERROR";
 		} else {
 			if ($joboobs->[0]->{preview}) {
 				my @boobs = ('(. )( .)', '(  . Y .  )', '(o)(o)', '( @ )( @ )', '(.)(.)');
@@ -117,13 +122,13 @@ sub Oboobs {
 			}
 		}
 	} else {
-		$log->warn (sprintf '[WARN] Oboobs server return status %s with message: %s', $r->code, $r->message);
+		cluck sprintf 'Server return status %s with message: %s', $r->code, $r->message;
 	}
 
 	return $ret;
 }
 
-sub Obutts {
+sub obutts {
 	my $r;
 	my $ret = 'Нету попок, все разбежались.';
 
@@ -144,7 +149,7 @@ sub Obutts {
 		};
 
 		unless (defined $jobutts) {
-			$log->warn ("[ERROR] Unable to decode JSON from obutts: $EVAL_ERROR");
+			cluck "[ERROR] Unable to decode JSON: $EVAL_ERROR";
 		} else {
 			if ($jobutts->[0]->{preview}) {
 				my @butts = ('(__(__)', '(_!_)', '(__.__)');
@@ -152,7 +157,7 @@ sub Obutts {
 			}
 		}
 	} else {
-		$log->warn (sprintf '[WARN] Obutts server return status %s with message: %s', $r->code, $r->message);
+		cluck sprintf 'Server return status %s with message: %s', $r->code, $r->message;
 	}
 
 	return $ret;
@@ -169,7 +174,7 @@ sub rabbit_imgur {
 		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)]);
+	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);
 
@@ -180,9 +185,9 @@ sub rabbit_imgur {
 	}
 }
 
-sub Rabbit {
+sub rabbit {
 	# rabbit, but bunny
-	my $url = FlickrByTags ('animal,bunny');
+	my $url = flickr_by_tags ('animal,bunny');
 
 	if (defined $url) {
 		return sprintf '[(\_/)](%s)', $url;
@@ -191,8 +196,8 @@ sub Rabbit {
 	}
 }
 
-sub Owl {
-	my $url = FlickrByTags ('bird,owl');
+sub owl {
+	my $url = flickr_by_tags ('bird,owl');
 
 	if (defined $url) {
 		return sprintf '[{ O v O }](%s)', $url;
@@ -201,41 +206,6 @@ sub Owl {
 	}
 }
 
-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/imgur.pm

@@ -1,4 +1,4 @@
-package Botlib::Image::Imgur;
+package imgur;
 
 use 5.018;
 use strict;
@@ -7,63 +7,56 @@ 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 File::Path qw (make_path);
 use Math::Random::Secure qw (irand);
 use Mojo::UserAgent;
-
-use BotLib::Conf qw (LoadConf);
+use SQLite_File;
+use conf qw (loadConf);
 
 use version; our $VERSION = qw (1.0);
 use Exporter qw (import);
-our @EXPORT_OK = qw (Imgur);
+our @EXPORT_OK = qw (imgur);
 
-my $c = LoadConf ();
-my $cachedir = $c->{cachedir};
+my $c = loadConf ();
+my $dir = $c->{image}->{dir};
+my $imgur_client_id     = $c->{image}->{imgur}->{client_id};
+my $imgur_client_secret = $c->{image}->{imgur}->{client_secret};
+my $imgur_access_token  = $c->{image}->{imgur}->{access_token};;
+my $imgur_refresh_token = $c->{image}->{imgur}->{refresh_token};
 
-sub Imgur {
+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');
-	};
+	# load all tokens from api secrets db
+	my $backingfile = sprintf '%s/secrets.sqlite', $dir;
 
-	# 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');
+	unless (-d $dir) {
+		make_path ($dir) or do {
+			cluck "Unable to create $dir: $OS_ERROR";
+			return undef;
+		};
 	}
 
-	$imgur_refresh_token = $cache->get ('imgur_refresh_token');
+	tie my %secret, 'SQLite_File', $backingfile  ||  do {
+		cluck "[ERROR] Unable to tie to $backingfile: $OS_ERROR";
+		return undef;
+	};
+
+	# if there is no access_token in db - put there one from config
+	if (defined $secret{imgur_access_token}) {
+		$imgur_access_token = $secret{imgur_access_token};
+	} else {
+		$secret{imgur_access_token} = $imgur_access_token;
+	}
 
 	# if there is no refresh_token in db - put there one from config
-	unless (defined $imgur_refresh_token) {
-		$cache->set ('imgur_refresh_token', $c->{image}->{imgur}->{refresh_token}, 'never');
+	if (defined $secret{imgur_refresh_token}) {
+		$imgur_refresh_token = $secret{imgur_refresh_token};
+	} else {
+		$secret{imgur_refresh_token} = $imgur_refresh_token;
 	}
 
 	# query api
@@ -82,7 +75,8 @@ sub Imgur {
 		);
 
 		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");
+			cluck "Unable to refresh imgur token, please re-authorise app! or imgur experiencing api outage: $r->code $r->message";
+			untie %secret;
 			return undef;
 		}
 
@@ -90,11 +84,12 @@ sub Imgur {
 
 		if (defined $refresh) {
 			$imgur_refresh_token = $refresh->{refresh_token};
-			$cache->set ('refresh_token', $refresh->{refresh_token}, 'never');
+			$secret{imgur_refresh_token} = $refresh->{refresh_token};
 			$imgur_access_token = $refresh->{access_token};
-			$cache->set ('imgur_access_token', $refresh->{access_token}, 'never');
+			$secret{imgur_access_token} = $refresh->{access_token};
 		} else {
-			$log->warn ("[ERROR] Unable to refresh imgur access_token, unable to decode json: $EVAL_ERROR");
+			cluck "Unable to refresh imgur access_token, unable to decode json: $EVAL_ERROR";
+			untie %secret;
 			return undef;
 		}
 
@@ -102,6 +97,8 @@ sub Imgur {
 		$r = $ua->get ($search_url . $tag => {Authorization => "Bearer $imgur_access_token"})->result;
 	}
 
+	untie %secret;
+
 	if ($r->is_success) {
 		my $searchResult = eval { return $r->json; };
 		my @urls;
@@ -131,21 +128,21 @@ sub Imgur {
 				if ($#urls > 0) {
 					return $urls[irand ($#urls + 1)];
 				} else {
-					$log->notice ('[NOTICE] Imgur api returned empty result.');
+					cluck 'Imgur api returned empty result.';
 					return undef;
 				}
 			} else {
-				$log->warn ("[WARN] Unable to get results from imgur api: $r->message");
+				cluck "Unable to get results from imgur api: $r->message";
 				return undef;
 			}
 		} else {
-			$log->warn ("[WARN] Unable to decode imgur api json: $EVAL_ERROR");
+			cluck "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");
+		cluck "Unable to get results from imgur api: $r->code, $r->message";
 		return undef;
 	}
 }
 
-1;
+1;

lib/karma.pm

@@ -0,0 +1,137 @@
+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/lat.pm

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

lib/monkeyuser.pm

@@ -1,4 +1,4 @@
-package BotLib::Monkeyuser;
+package monkeyuser;
 
 use 5.018;
 use strict;
@@ -8,15 +8,14 @@ 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);
+our @EXPORT_OK = qw (monkeyuser);
 
-sub Monkeyuser {
+sub monkeyuser {
 	my $r;
 	my $ret = 'Нету Monkey User-ов, они все спрятались.';
 	my @link;
@@ -52,7 +51,7 @@ sub Monkeyuser {
 			$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});
+		cluck sprintf 'Server return status %s with message: %s', $r->{status}, $r->{reason};
 	}
 
 	return $ret;

lib/telegrambot.pm

@@ -1,4 +1,4 @@
-package TelegramBot;
+package telegrambot;
 # main bot gears are here
 
 use 5.018;
@@ -11,21 +11,20 @@ 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 BotLib::Admin qw (FortuneToggleList);
-use BotLib qw (RandomCommonPhrase Command Highlight BotSleep IsCensored);
-use BotLib::Conf qw (LoadConf);
-use BotLib::Fortune qw (Fortune);
-use BotLib::Karma qw (KarmaSet);
-use BotLib::Util qw (trim fmatch);
+use admin qw (fortune_toggle_list);
+use botlib qw (randomCommonPhrase command highlight botsleep isCensored);
+use conf qw (loadConf);
+use fortune qw (fortune);
+use karma qw (karmaSet);
+use util qw (trim fmatch);
 
 use version; our $VERSION = qw (1.0);
 use Exporter qw (import);
-our @EXPORT_OK = qw (RunTelegramBot);
+our @EXPORT_OK = qw (run_telegrambot);
 
-my $c = LoadConf ();
+my $c = loadConf ();
 my $hailo;
 my $myid;
 my $myusername;
@@ -48,9 +47,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 (FortuneToggleList ()) {
+		foreach my $enabledfortunechat (fortune_toggle_list ()) {
 			my $send_args;
-			$send_args->{text} = sprintf "%s\n```\n%s\n```\n", $intro[irand ($#intro + 1)], trim (Fortune ());
+			$send_args->{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);
@@ -66,14 +65,14 @@ sub __on_msg {
 	my $chatid;
 	my $chatname = 'Noname chat';
 	# user sending message info
-	my ($userid, $username, $fullname, $highlight, $vis_a_vi) = BotLib::Highlight ($msg);
+	my ($userid, $username, $fullname, $highlight, $vis_a_vi) = highlight $msg;
 	my $csign = $c->{telegrambot}->{csign};
 
 	unless ($myid) {
 		my $myObj = $self->getMe ();
 
 		unless ($myObj) {
-			$log->error ('[ERROR] Unable to get chatid, API Error?');
+			carp '[ERROR] Unable to get chatid, API Error?';
 			return;
 		}
 
@@ -106,7 +105,7 @@ sub __on_msg {
 			}
 		}
 	} else {
-		$log->warn ('[INFO] Unable to get chatid');
+		carp '[INFO] Unable to get chatid';
 		return;
 	}
 
@@ -143,7 +142,7 @@ sub __on_msg {
 			$phrase = sprintf 'Дратути, %s. Представьтес, пожалуйста, и расскажите, что вас сюда привело.', $members[0];
 		}
 
-		BotSleep $msg;
+		botsleep $msg;
 		$msg->replyMd ($phrase);
 		return;
 	}
@@ -159,9 +158,9 @@ sub __on_msg {
 		);
 
 		if ($chatid < 0) {
-			$log->info ("[INFO] Initialized brain for public chat $chatname ($chatid): $brainname");
+			carp "[INFO] Initialized brain for public chat $chatname ($chatid): $brainname";
 		} else {
-			$log->info ("[INFO] Initialized brain for private chat $chatname ($chatid): $brainname");
+			carp "[INFO] Initialized brain for private chat $chatname ($chatid): $brainname";
 		}
 	}
 
@@ -172,11 +171,11 @@ sub __on_msg {
 		}
 
 		my $text = $msg->text;
-		$log->debug (sprintf ('[DEBUG] Private chat %s say to bot: %s', $vis_a_vi, $text));
+		carp sprintf ('[DEBUG] Private chat %s say to bot: %s', $vis_a_vi, $text) if $c->{debug};
 		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;
 
@@ -185,7 +184,7 @@ 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;
 				}
@@ -205,7 +204,7 @@ sub __on_msg {
 					$phrase = lc $phrase;
 
 					if (fmatch (lc ($reply), $phrase)) {
-						$reply = RandomCommonPhrase ();
+						$reply = randomCommonPhrase ();
 					}
 				}
 			}
@@ -214,34 +213,34 @@ sub __on_msg {
 		if (defined $reply) {
 			$msg->typing ();
 			sleep 1;
-			$log->debug (sprintf ('[DEBUG] Private chat bot reply to %s: %s', $vis_a_vi, $reply));
+			carp sprintf ('[DEBUG] Private chat bot reply to %s: %s', $vis_a_vi, $reply) if $c->{debug};
 			$msg->reply ($reply);
 		}
 # group chat
 	} elsif (($msg->chat->type eq 'supergroup') or ($msg->chat->type eq 'group')) {
 		my $reply;
 
-		if (IsCensored $msg) {
-			$log->info (sprintf '[INFO] In public chat %s (%s) message from %s was censored', $chatname, $chatid, $vis_a_vi);
+		if (isCensored $msg) {
+			carp sprintf '[INFO] In public chat %s (%s) message from %s was censored', $chatname, $chatid, $vis_a_vi;
 			$self->deleteMessage ({chat_id => $chatid, message_id => $msg->{message_id}});
 		}
 
 		# detect and log messages without text, noop here
 		unless (defined $msg->text) {
-			$log->debug (sprintf ('[DEBUG] No text in message from %s', $vis_a_vi));
+			carp sprintf ('[INFO] No text in message from %s', $vis_a_vi);
 			return;
 		}
 
 		# we have text here! so potentially we can chit-chat
 		my $text = $msg->text;
-		$log->debug (sprintf ('[DEBUG] In public chat %s (%s) %s say: %s', $chatname, $chatid, $vis_a_vi, $text));
+		carp sprintf ('[DEBUG] In public chat %s (%s) %s say: %s', $chatname, $chatid, $vis_a_vi, $text) if $c->{debug};
 
 		# are they quote something, maybe, us?
 		if (defined ($msg->reply_to_message) &&
 		            defined ($msg->reply_to_message->from) &&
 		                    defined ($msg->reply_to_message->from->username) &&
 		                            ($msg->reply_to_message->from->username eq $myusername)) {
-			$log->debug (sprintf ('[DEBUG] In public chat %s (%s) %s quote us!', $chatname, $chatid, $vis_a_vi));
+			carp sprintf ('[DEBUG] In public chat %s (%s) %s quote us!', $chatname, $chatid, $vis_a_vi) if $c->{debug};
 
 			# do not answer back if someone quote our new member greet
 			if ((substr ($msg->reply_to_message->text, 0, 9) eq 'Дратути, ') &&
@@ -260,7 +259,7 @@ sub __on_msg {
 			}
 		# 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
@@ -276,47 +275,28 @@ sub __on_msg {
 			# phrase directed to bot
 			if ((lc ($text) =~ /^${qname}[\,|\:]? (.+)/) or (lc ($text) =~ /^${qtname}[\,|\:]? (.+)/)){
 				$phrase = $1;
-
-				if ($phrase =~ /^кто +все +эти +люди *\?$/i) {
-					$reply = 'Кто здесь?';
-				} else {
-					$reply = $hailo->{$msg->chat->id}->learn_reply ($phrase);
-				}
+				$reply = $hailo->{$msg->chat->id}->learn_reply ($phrase);
 			# bot mention by name
 			} elsif ((lc ($text) =~ /.+ ${qname}[\,|\!|\?|\.| ]/) or (lc ($text) =~ / $qname$/)) {
 				$phrase = $text;
-
-				if ($phrase =~ /^кто +все +эти +люди *\?$/i) {
-					$reply = 'Кто здесь?';
-				} else {
-					$reply = $hailo->{$msg->chat->id}->learn_reply ($phrase);
-				}
+				$reply = $hailo->{$msg->chat->id}->reply($phrase);
 			# bot mention by telegram name
 			} elsif ((lc ($text) =~ /.+ ${qtname}[\,|\!|\?|\.| ]/) or (lc ($text) =~ / $qtname$/)) {
 				$phrase = $text;
-
-				if ($phrase =~ /^кто +все +эти +люди *\?$/i) {
-					$reply = 'Кто здесь?';
-				} else {
-					$reply = $hailo->{$msg->chat->id}->learn_reply ($phrase);
-				}
+				$reply = $hailo->{$msg->chat->id}->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 {
-				if ($text =~ /^кто +все +эти +люди *\?$/i) {
-					$reply = 'Кто здесь?';
-				} else {
-					$hailo->{$msg->chat->id}->learn ($text);
-				}
+				$hailo->{$msg->chat->id}->learn ($text);
 			}
 		}
 
@@ -331,15 +311,15 @@ sub __on_msg {
 			$phrase = lc $phrase;
 
 			if (fmatch (lc ($reply), $phrase)) {
-				$reply = RandomCommonPhrase ();
+				$reply = randomCommonPhrase ();
 			}
 
 			$msg->typing ();
 			sleep (irand 2);
-			$log->debug (sprintf ('[DEBUG] In public chat %s (%s) bot reply to %s: %s', $chatname, $chatid, $vis_a_vi, $reply));
+			carp sprintf ('[DEBUG] In public chat %s (%s) bot reply to %s: %s', $chatname, $chatid, $vis_a_vi, $reply) if $c->{debug};
 			$msg->reply ($reply);
 		} else {
-			$log->debug (sprintf ('[DEBUG] In public chat %s (%s) bot is not required to reply to %s', $chatname, $chatid, $vis_a_vi));
+			carp sprintf ('[DEBUG] In public chat %s (%s) bot is not required to reply to %s', $chatname, $chatid, $vis_a_vi) if $c->{debug};
 		}
 
 # should be channel, so we can't talk
@@ -357,7 +337,7 @@ sub init {
 
 	unless (-d $braindir) {
 		make_path ($braindir, 0, 0755) or do { ## no critic (ValuesAndExpressions::ProhibitLeadingZeros)
-			$log->fatal ("[FATAL] Unable to create $braindir: $OS_ERROR");
+			cluck "Unable to create $braindir: $OS_ERROR";
 			exit 1;
 		};
 	}
@@ -367,10 +347,10 @@ sub init {
 	return;
 }
 
-sub RunTelegramBot {
+sub run_telegrambot {
 	while (sleep 3) {
 		eval {                                       ## no critic (ErrorHandling::RequireCheckingReturnValueOfEval)
-			TelegramBot->new->think;
+			telegrambot->new->think;
 		}
 	}
 

lib/util.pm

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

lib/weather.pm

@@ -1,4 +1,4 @@
-package BotLib::Weather;
+package weather;
 
 use 5.018;
 use strict;
@@ -9,20 +9,21 @@ use English qw ( -no_match_vars );
 use Carp qw (carp cluck);
 use CHI;
 use CHI::Driver::BerkeleyDB;
-use Log::Any qw ($log);
+use DB_File;
+use Digest::MD5 qw (md5_base64);
+use File::Path qw (make_path);
 use Mojo::Log;
 use Mojo::UserAgent::Cached;
-use BotLib::Conf qw (LoadConf);
-use BotLib::Util qw (trim urlencode);
+use conf qw (loadConf);
+use util qw (trim urlencode);
 
 use version; our $VERSION = qw (1.0);
 use Exporter qw (import);
-our @EXPORT_OK = qw (Weather);
+our @EXPORT_OK = qw (weather);
 
-my $c = LoadConf ();
-my $cachedir = $c->{cachedir};
+my $c = loadConf ();
 
-sub Weather {
+sub weather {
 	my $city = shift;
 	$city = trim $city;
 
@@ -36,7 +37,7 @@ sub Weather {
 	if ($w) {
 		if ($w->{temperature_min} == $w->{temperature_max}) {
 			$reply = sprintf (
-				"Погода в городе %s, %s:\n%s, ветер %s %s м/c, температура %s°C, ощущается как %s°C, относительная влажность %s%%, давление %s мм.рт.ст",
+				"Погода в городе %s, %s:\n%s, ветер %s %s м/c, температура %s°C, ощущается как %s°C, относительная влажность %s%%, давление %s мм.рт.с",
 				$w->{name},
 				$w->{country},
 				ucfirst $w->{description},
@@ -47,23 +48,9 @@ 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 мм.рт.ст",
+				"Погода в городе %s, %s:\n%s, ветер %s %s м/c, температура %s-%s°C, ощущается как %s°C, относительная влажность %s%%, давление %s мм.рт.ст",
 				$w->{name},
 				$w->{country},
 				ucfirst $w->{description},
@@ -87,6 +74,7 @@ sub __weather {
 	my $city = shift;
 	$city = urlencode $city;
 	my $appid = $c->{openweathermap}->{appid};
+	my $cachedir = $c->{openweathermap}->{cachedir};
 	my $now = time ();
 	my $fc;
 	my $w;
@@ -124,11 +112,11 @@ sub __weather {
 		};
 
 		unless ($fc) {
-			$log->warn ("[WARN] openweathermap returns corrupted json: $EVAL_ERROR");
+			cluck "[WARN] openweathermap returns corrupted json: $EVAL_ERROR";
 			return undef;
 		};
 	} else {
-		$log->warn (sprintf '[WARN] Server return status %s with message: %s', $r->code, $r->message);
+		cluck sprintf 'Server return status %s with message: %s', $r->code, $r->message;
 		return undef;
 	}
 

lib/xkcd.pm

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