From a1d238949f889d9df68769b01d176f10d5bc3da9 Mon Sep 17 00:00:00 2001
From: eleksir <eleksir@exs-elm.ru>
Date: Tue, 5 Jan 2021 13:42:41 +0300
Subject: [PATCH] Refactor code

* move plugins out of botlib.pm
* use make_path instead of mkpath
* squash some bugs
* update .gitignore
* use more correct randomizer, rather than perl own rand()
* coding style fixes
---
 .gitignore              |  17 ++-
 README.md               |   8 +-
 bin/aleesa-telegram-bot |  55 ++++---
 bin/fortune_seed.pl     |   3 +-
 bin/friday_seed.pl      |   3 +-
 bin/train_lat.pl        |   3 +-
 confcheck.pl            |   2 +-
 cpanfile                |   1 +
 data/sample_config.json |   7 +-
 lib/archeologist.pm     |  28 ++--
 lib/botlib.pm           | 313 +++++++---------------------------------
 lib/conf.pm             |  13 +-
 lib/fortune.pm          |  40 ++---
 lib/friday.pm           |  52 ++++---
 lib/karma.pm            |  34 +++--
 lib/kitty.pm            |  55 +++++++
 lib/lat.pm              |  33 ++---
 lib/telegrambot.pm      |  38 +++--
 lib/util.pm             |  83 +++++++++++
 lib/weather.pm          | 200 +++++++++++++++++++++++++
 20 files changed, 582 insertions(+), 406 deletions(-)
 create mode 100644 lib/kitty.pm
 create mode 100644 lib/util.pm
 create mode 100644 lib/weather.pm

diff --git a/.gitignore b/.gitignore
index b8af58e..7251da7 100644
--- a/.gitignore
+++ b/.gitignore
@@ -1,7 +1,12 @@
-vendor_perl
-data/config.json
-data/cache
-data/telegrambot-brains
-data/lat
+.idea/**
+.vscode/**
 aleesa-telegram-bot.pid
-TODO
\ No newline at end of file
+data/cache/**
+data/config.json
+data/fortune/**
+data/friday/**
+data/karma/**
+data/telegrambot-brains/**
+data/lat/**
+vendor_perl
+_Deparsed_XSubs.pm
diff --git a/README.md b/README.md
index 12d2c8d..5e53a89 100644
--- a/README.md
+++ b/README.md
@@ -6,9 +6,9 @@ It is based on Perl modules [Telegram::Bot][1] and [Hailo][2] as conversation
 generator.
 
 I have to fork [Telegram::Bot][1] and add some of new methods that are already
-appear in [Telegram API][3], but author seems to abandon lib. Also i decide to
-rename it to avoid collision in future, now it is Teapot::Bot and is bundled
-with bot. When lib become mature enough, maybe i release it separately.
+appear in [Telegram API][3], but author seems to abandon lib. Also, I decide to
+rename it to avoid collision in the future, now it is Teapot::Bot and is bundled
+with bot. When lib become mature enough, maybe I release it separately.
 
 Bot config located in **data/config.json**, sample config provided as
 **data/sample_config.json**.
@@ -24,7 +24,7 @@ You'll need "Development Tools" or similar group of packages, perl, perl-devel,
 perl-local-lib, perl-app-cpanm, sqlite-devel, zlib-devel, openssl-devel,
 libdb4-devel (Berkeley DB devel), make.
 
-After installng required dependencies it is possible to run:
+After installing required dependencies it is possible to run:
 
 ```bash
 bash bootstrap.sh
diff --git a/bin/aleesa-telegram-bot b/bin/aleesa-telegram-bot
index 23a2698..0acfa11 100755
--- a/bin/aleesa-telegram-bot
+++ b/bin/aleesa-telegram-bot
@@ -4,32 +4,36 @@ use 5.018;
 use strict;
 use warnings;
 use utf8;
-use open qw(:std :utf8);
-use English qw( -no_match_vars );
+use open qw (:std :utf8);
+use English qw ( -no_match_vars );
 
-use version; our $VERSION = qw(1.0);
+use version; our $VERSION = qw (1.0);
 
 my $workdir;
 
 # before we run, change working dir
 BEGIN {
-	use Cwd qw(chdir abs_path);
+	use Cwd qw (chdir abs_path);
 	my @CWD = split /\//xms, abs_path ($PROGRAM_NAME);
-	if ($#CWD > 1) { $#CWD = $#CWD - 2; }
+
+	if ($#CWD > 1) {
+		$#CWD = $#CWD - 2;
+	}
+
 	$workdir = join '/', @CWD;
 	chdir $workdir;
 }
 
 use lib ("$workdir/lib", "$workdir/vendor_perl", "$workdir/vendor_perl/lib/perl5");
 no Cwd;
-use Cwd::utf8 qw(chdir abs_path);
-use POSIX qw(setgid setuid setsid);
-use File::Path qw(make_path);
-use File::Basename qw(basename dirname);
+use Cwd::utf8 qw (chdir abs_path);
+use File::Basename qw (basename dirname);
+use File::Path qw (make_path);
 use Log::Any::Adapter;
 use Log::Any::For::Std;
-use conf qw(loadConf);
-use telegrambot qw(run_telegrambot);
+use POSIX qw (setgid setuid setsid);
+use conf qw (loadConf);
+use telegrambot qw (run_telegrambot);
 
 sub daemonize;
 sub __fork;
@@ -41,8 +45,12 @@ my $runAsUid = $UID;
 my $piddir = '/var/run/' . basename (abs_path ($PROGRAM_NAME));
 my $C = loadConf ();
 my $logfile;
-if (defined $C->{'log'}) { $logfile = $C->{'log'}; }
-elsif (defined $C->{'debug_log'}) {$logfile = $C->{'debug_log'}; }
+
+if (defined $C->{'log'}) {
+	$logfile = $C->{'log'};
+} elsif (defined $C->{'debug_log'}) {
+	$logfile = $C->{'debug_log'};
+}
 
 # if we run under root, create pid dir and set correct owner for it, same for debug log if it is defined
 if ($UID == 0) {
@@ -72,10 +80,8 @@ if ($UID == 0) {
 							uid   => $uid,
 							group => $gid
 					}
-			);
+			) or die "Unable to create $logdir: $OS_ERROR\n";
 		}
-
-		die "Unable to create $logdir" unless (-d $logdir); ## no critic (ErrorHandling::RequireCarping)
 	}
 
 # drop privs
@@ -137,14 +143,25 @@ sub daemonize {
 
 sub __fork {
 	my $pid = fork;
-	unless (defined $pid) { die "[FATAL] Can't fork: $OS_ERROR\n"; }
-	exit if ($pid != 0);
+
+	unless (defined $pid) {
+		die "[FATAL] Can't fork: $OS_ERROR\n";
+	}
+
+	if ($pid != 0) {
+		exit;
+	}
+
 	return;
 }
 
 sub __signal_handler {
 	warn "[INFO] Caught a signal $OS_ERROR\n";
-	unlink $pidfile if (-f $pidfile);
+
+	if (-f $pidfile) {
+		unlink $pidfile;
+	}
+
 	exit 0;
 }
 
diff --git a/bin/fortune_seed.pl b/bin/fortune_seed.pl
index 2989b7c..a0fd004 100644
--- a/bin/fortune_seed.pl
+++ b/bin/fortune_seed.pl
@@ -6,8 +6,7 @@ use warnings;
 use utf8;
 use open qw(:std :utf8);
 use English qw( -no_match_vars );
-use vars qw/$VERSION/;
-$VERSION = '1.0';
+use version; our $VERSION = qw (1.0);
 
 my $workdir;
 
diff --git a/bin/friday_seed.pl b/bin/friday_seed.pl
index fdf4cbf..5176009 100644
--- a/bin/friday_seed.pl
+++ b/bin/friday_seed.pl
@@ -6,8 +6,7 @@ use warnings;
 use utf8;
 use open qw(:std :utf8);
 use English qw( -no_match_vars );
-use vars qw/$VERSION/;
-$VERSION = '1.0';
+use version; our $VERSION = qw (1.0);
 
 my $workdir;
 
diff --git a/bin/train_lat.pl b/bin/train_lat.pl
index b08e7d5..4d7bf36 100644
--- a/bin/train_lat.pl
+++ b/bin/train_lat.pl
@@ -6,8 +6,7 @@ use warnings;
 use utf8;
 use open qw(:std :utf8);
 use English qw( -no_match_vars );
-use vars qw/$VERSION/;
-$VERSION = '1.0';
+use version; our $VERSION = qw (1.0);
 
 my $workdir;
 
diff --git a/confcheck.pl b/confcheck.pl
index acb45d8..a75b446 100755
--- a/confcheck.pl
+++ b/confcheck.pl
@@ -9,7 +9,7 @@ use English qw( -no_match_vars );
 use lib qw(./lib ./vendor_perl ./vendor_perl/lib/perl5);
 use JSON::XS;
 
-use version; our $VERSION = qv(1.0);
+use version; our $VERSION = qw (1.0);
 
 my $c = 'data/config.json';
 open (my $C, '<', $c) or die "No conf at $c: $OS_ERROR\n";
diff --git a/cpanfile b/cpanfile
index 734a267..cfe4d3c 100644
--- a/cpanfile
+++ b/cpanfile
@@ -17,6 +17,7 @@ requires 'local::lib';
 requires 'Log::Any';
 requires 'Log::Any::Adapter';
 requires 'Log::Any::For::Std';
+requires 'Math::Random::Secure';
 requires 'Mojo::Base';
 requires 'Mojo::IOLoop';
 requires 'Mojo::UserAgent';
diff --git a/data/sample_config.json b/data/sample_config.json
index 7a6feec..80202b9 100644
--- a/data/sample_config.json
+++ b/data/sample_config.json
@@ -10,16 +10,13 @@
         "srcdir" : "data/fortune_src"
     },
     "telegrambot" : {
-        "name" : "mybot",
-        "tname" : "@my_bot",
         "csign" : "!",
         "token" : "get_it_from_botfather",
         "braindir": "data/telegrambot-brains"
     },
     "openweathermap" : {
-        "cachetime": "data/cache/openweathermap.Id-Timestamp.db",
-        "cachedata": "data/cache/openweathermap.Id-Data.db",
-        "appid": "get_it_on_openweathermap.org"
+        "appid": "get_it_on_openweathermap.org",
+        "cachedir" : "data/cache"
     },
     "lat" : {
         "brain": "data/lat/lat.sqlite",
diff --git a/lib/archeologist.pm b/lib/archeologist.pm
index 3b07007..6aaab33 100644
--- a/lib/archeologist.pm
+++ b/lib/archeologist.pm
@@ -4,13 +4,13 @@ use 5.018;
 use strict;
 use warnings;
 use utf8;
-use open qw(:std :utf8);
-use English qw( -no_match_vars );
+use open qw (:std :utf8);
+use English qw ( -no_match_vars );
+use Math::Random::Secure qw (irand);
 
-use vars qw/$VERSION/;
-use Exporter qw(import);
-our @EXPORT_OK = qw(dig);
-$VERSION = '1.0';
+use version; our $VERSION = qw (1.0);
+use Exporter qw (import);
+our @EXPORT_OK = qw (dig);
 
 sub dig {
 	my $name = shift;
@@ -100,21 +100,21 @@ sub dig {
 		'на просторах Украины',
 	);
 
-	my $find_probability = int (rand 100);
-	my $success_probability = int (rand 100);
-	my $artifact_age = int (rand 15000);
+	my $find_probability = irand 101;
+	my $success_probability = irand 101;
+	my $artifact_age = irand 15001;
 
 	if ($find_probability <= 20) {
-		return sprintf 'По уши закопавшись %s, %s, нифига вы не выкопали! Может повезет в другом месте?', $location[int (rand ($#location + 1))], $name;
+		return sprintf 'По уши закопавшись %s, %s, нифига вы не выкопали! Может повезет в другом месте?', $location[irand ($#location + 1)], $name;
 	}
 
-	my $phrase = sprintf "Вы начали раскопки %s и усиленно роете лопатами, экскаватором...\n", $location[int (rand ($#location + 1))];
+	my $phrase = sprintf "Вы начали раскопки %s и усиленно роете лопатами, экскаватором...\n", $location[irand ($#location + 1)];
 	$phrase .= "Вам кажется что ваш совочек ударился обо что-то твердое. Может, это клад?!\n\n";
 
-	if ($success_probability <= 20) {
-		$phrase .= sprintf '%s стал лучшим археологом, выкопав %s! возраст артефакта - %s лет!', $name, $artifact[int (rand ($#artifact + 1))], $artifact_age;
+	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[int (rand ($#artifact + 1))], $artifact_age;
+		$phrase .= sprintf "Поздравляю, %s! Вы только что выкопали %s, возраст - %s лет!\n", $name, $artifact[irand ($#artifact + 1)], $artifact_age;
 		$phrase .= sprintf 'Извини %s, но на артефакт это не тянет! Однако, попытка хорошая!', $name;
 	}
 
diff --git a/lib/botlib.pm b/lib/botlib.pm
index 248fc69..8e48b20 100644
--- a/lib/botlib.pm
+++ b/lib/botlib.pm
@@ -5,210 +5,27 @@ use 5.018;
 use strict;
 use warnings;
 use utf8;
-use open qw(:std :utf8);
-use English qw( -no_match_vars );
-use Carp qw(carp);
-use HTTP::Tiny;
-use URI::URL;
-use JSON::XS qw(decode_json encode_json);
-use Digest::MD5 qw(md5_base64);
-use DB_File;
-use Text::Fuzzy qw(distance_edits);
-use conf qw(loadConf);
-use lat qw(latAnswer);
-use karma qw(karmaSet karmaGet);
-use friday qw(friday);
-use fortune qw(fortune fortune_toggle fortune_status);
+use open qw (:std :utf8);
+use English qw ( -no_match_vars );
+use Carp qw (carp);
+use Math::Random::Secure qw (irand);
+
+use conf qw (loadConf);
 use archeologist qw (dig);
+use fortune qw (fortune fortune_toggle fortune_status);
+use friday qw (friday);
+use karma qw (karmaSet karmaGet);
+use kitty qw (kitty);
+use lat qw (latAnswer);
+use util qw (trim);
+use weather qw (weather);
 
-use vars qw/$VERSION/;
-use Exporter qw(import);
-our @EXPORT_OK = qw(weather trim randomCommonPhrase command highlight botsleep fmatch);
-$VERSION = '1.0';
+use version; our $VERSION = qw (1.0);
+use Exporter qw (import);
+our @EXPORT_OK = qw (randomCommonPhrase command highlight botsleep);
 
-my $c = loadConf();
-
-sub __urlencode {
-	my $str = shift;
-	my $urlobj = url $str;
-	$str = $urlobj->as_string;
-	$urlobj = undef; undef $urlobj;
-	return $str;
-}
-
-sub trim {
-	my $str = shift;
-
-	return $str if ($str eq '');
-
-	while (substr ($str, 0, 1) =~ /^\s$/xms) {
-		$str = substr ($str, 1);
-	}
-
-	while (substr ($str, -1, 1) =~ /^\s$/xms) {
-		chop ($str);
-	}
-
-	return $str;
-}
-
-
-sub weather {
-	my $city = shift;
-	$city = trim ($city);
-
-	return 'Мне нужно ИМЯ города.' if ($city eq '');
-	return 'Длинновато для названия города.' if (length($city) > 80);
-
-	$city = ucfirst ($city);
-	my $w = __weather ($city);
-	my $reply;
-
-	if ($w) {
-		if ($w->{temperature_min} == $w->{temperature_max}) {
-			$reply = sprintf ("Погода в городе %s, %s:\n%s, ветер %s %s м/c, температура %s°C, ощущается как %s°C, относительная влажность %s%%, давление %s мм.рт.с",
-				$w->{name},
-				$w->{country},
-				ucfirst ($w->{description}),
-				$w->{wind_direction},
-				$w->{wind_speed},
-				$w->{temperature_min},
-				$w->{temperature_feelslike},
-				$w->{humidity},
-				$w->{pressure}
-			);
-		} else {
-			$reply = sprintf ("Погода в городе %s, %s:\n%s, ветер %s %s м/c, температура %s-%s°C, ощущается как %s°C, относительная влажность %s%%, давление %s мм.рт.ст",
-				$w->{name},
-				$w->{country},
-				ucfirst ($w->{description}),
-				$w->{wind_direction},
-				$w->{wind_speed},
-				$w->{temperature_min},
-				$w->{temperature_max},
-				$w->{temperature_feelslike},
-				$w->{humidity},
-				$w->{pressure}
-			);
-		}
-	} else {
-		$reply = "Я не знаю, какая погода в $city";
-	}
-
-	return $reply;
-}
-
-sub __weather {
-	my $city = shift;
-	$city = __urlencode ($city);
-	my $id = md5_base64 ($city);
-	my $appid = $c->{openweathermap}->{appid};
-	my $now = time ();
-	my $fc;
-	my $w;
-
-	# attach to cache data
-	tie my %cachetime, 'DB_File', $c->{openweathermap}->{cachetime} or do {
-		carp "[ERROR] Something nasty happen when cachetime ties to its data: $OS_ERROR";
-		return undef;
-	};
-
-	tie my %cachedata, 'DB_File', $c->{openweathermap}->{cachedata} or do {
-		carp "[ERROR] Something nasty happen when cachedata ties to its data: $OS_ERROR";
-		return undef;
-	};
-
-	# lookup cache
-	if (defined ($cachetime{$id}) && ($now - $cachetime{$id}) < 10800) {
-		$fc = decode_json ($cachedata{$id});
-	} else {
-		my $r;
-
-		# try 3 times and giveup
-		for (1..3) {
-			next if ($r->{success});
-			my $http = HTTP::Tiny->new (timeout => 3);
-			$r = $http->get (sprintf ('http://api.openweathermap.org/data/2.5/weather?q=%s&lang=ru&APPID=%s', $city, $appid));
-			sleep 2;
-		}
-
-		# all 3 times can give error, so check it here
-		if ($r->{success}) {
-			$fc = eval { decode_json ($r->{content}) };
-
-			if ($EVAL_ERROR) {
-				carp "[WARN] openweathermap returns corrupted json: $EVAL_ERROR";
-				untie %cachetime;
-				untie %cachedata;
-				return undef;
-			};
-
-			$cachetime{$id} = $now;
-			$cachedata{$id} = encode_json ($fc);
-		} else {
-			untie %cachetime;
-			untie %cachedata;
-			return undef;
-		}
-	}
-
-	untie %cachetime;
-	untie %cachedata;
-
-	# TODO: check all of this for existance
-	$w->{'name'} = $fc->{name};
-	$w->{'state'} = $fc->{state};
-	$w->{'country'} = $fc->{sys}->{country};
-	$w->{'longitude'} = $fc->{coord}->{lon};
-	$w->{'latitude'} = $fc->{coord}->{lat};
-	$w->{'temperature_min'} = int ($fc->{main}->{temp_min} - 273.15);
-	$w->{'temperature_max'} = int ($fc->{main}->{temp_max} - 273.15);
-	$w->{'temperature_feelslike'} = int ($fc->{main}->{feels_like} - 273.15);
-	$w->{'humidity'} = $fc->{main}->{humidity};
-	$w->{'pressure'} = int ($fc->{main}->{pressure} * 0.75006375541921);
-	$w->{'description'} = $fc->{weather}->[0]->{description};
-	$w->{'wind_speed'} = $fc->{wind}->{speed};
-	$w->{'wind_direction'} = 'разный';
-	my $dir = int ($fc->{wind}->{deg} + 0);
-
-	if ($dir == 0) {
-		$w->{'wind_direction'} = 'северный';
-	} elsif ($dir > 0   && $dir <= 30) {
-		$w->{'wind_direction'} = 'северо-северо-восточный';
-	} elsif ($dir > 30  && $dir <= 60) {
-		$w->{'wind_direction'} = 'северо-восточный';
-	} elsif ($dir > 60  && $dir <  90) {
-		$w->{'wind_direction'} = 'восточно-северо-восточный';
-	} elsif ($dir == 90) {
-		$w->{'wind_direction'} = 'восточный';
-	} elsif ($dir > 90  && $dir <= 120) {
-		$w->{'wind_direction'} = 'восточно-юго-восточный';
-	} elsif ($dir > 120 && $dir <= 150) {
-		$w->{'wind_direction'} = 'юговосточный';
-	} elsif ($dir > 150 && $dir <  180) {
-		$w->{'wind_direction'} = 'юго-юго-восточный';
-	} elsif ($dir == 180) {
-		$w->{'wind_direction'} = 'южный';
-	} elsif ($dir > 180 && $dir <= 210) {
-		$w->{'wind_direction'} = 'юго-юго-западный';
-	} elsif ($dir > 210 && $dir <= 240) {
-		$w->{'wind_direction'} = 'юго-западный';
-	} elsif ($dir > 240 && $dir <  270) {
-		$w->{'wind_direction'} = 'западно-юго-западный';
-	} elsif ($dir == 270) {
-		$w->{'wind_direction'} = 'западный';
-	} elsif ($dir > 270 && $dir <= 300) {
-		$w->{'wind_direction'} = 'западно-северо-западный';
-	} elsif ($dir > 300 && $dir <= 330) {
-		$w->{'wind_direction'} = 'северо-западный';
-	} elsif ($dir > 330 && $dir <  360) {
-		$w->{'wind_direction'} = 'северо-северо-западный';
-	} elsif ($dir == 360) {
-		$w->{'wind_direction'} = 'северный';
-	}
-
-	return $w;
-}
+my $c = loadConf ();
+my $csign = $c->{telegrambot}->{csign};
 
 sub randomCommonPhrase {
 	my @myphrase = (
@@ -225,7 +42,7 @@ sub randomCommonPhrase {
 		'А ви, таки, почему интересуетесь?',
 	);
 
-	return $myphrase[rand ($#myphrase -1)];
+	return $myphrase[irand ($#myphrase + 1)];
 }
 
 sub command {
@@ -250,10 +67,14 @@ sub command {
 		my $city = substr ($text, 3);
 		$reply = weather ($city);
 	} elsif (substr ($text, 1) eq 'cat'  ||  substr ($text, 1) eq 'кис') {
-		$reply = kitty();
+		$reply = kitty ();
+		$msg->typing ();
+		sleep (int ( rand (2) + 1));
+		$msg->replyMd ($reply);
+		return;
 	} elsif (substr ($text, 1) eq 'lat'  ||  substr ($text, 1) eq 'лат') {
 		$reply = latAnswer ();
-	} elsif ((length ($text) >= 6 && (substr ($text, 1, 6) eq 'karma ' || substr ($text, 1, 6) eq 'карма '))  ||  substr($text, 1) eq 'karma'  ||  substr($text, 1) eq 'карма') {
+	} elsif ((length ($text) >= 6 && (substr ($text, 1, 6) eq 'karma ' || substr ($text, 1, 6) eq 'карма '))  ||  substr ($text, 1) eq 'karma'  ||  substr ($text, 1) eq 'карма') {
 		my $mytext = '';
 
 		if (length($text) > 6) {
@@ -282,23 +103,23 @@ sub command {
 		$msg->replyMd ($reply);
 		return;
 	} elsif (substr ($text, 1) eq 'help'  ||  substr ($text, 1) eq 'помощь') {
-		$reply = << 'MYHELP';
+		$reply = << "MYHELP";
 ```
-!help | !помощь             - список команд
-!cat | !кис                 - кошечка
-!dig | !копать              - заняться археологией
-!f | !ф                     - рандомная фраза из сборника цитат fortune_mod
-!fortune | !фортунка        - рандомная фраза из сборника цитат fortune_mod
-!f # | !ф #                 - где 1 - вкл, 0 - выкл фортунку с утра
-!fortune # | !фортунка #    - где 1 - вкл, 0 - выкл фортунку с утра
-!f ? | !ф ?                 - показываем ли с утра фортунку для чата
-!fortune ? | !фортунка ?    - показываем ли с утра фортунку для чата
-!friday | !пятница          - а не пятница ли сегодня?
-!lat | !лат                 - сгенерить фразу из крылатых латинских выражений
-!ping | !пинг               - попинговать бота
-!ver | !version | !версия   - что-то про версию ПО
-!w город | !п город         - погода в указанном городе
-!karma фраза | !карма фраза - посмотреть карму фразы
+${csign}help | ${csign}помощь             - список команд
+${csign}cat | ${csign}кис                 - кошечка
+${csign}dig | ${csign}копать              - заняться археологией
+${csign}f | ${csign}ф                     - рандомная фраза из сборника цитат fortune_mod
+${csign}fortune | ${csign}фортунка        - рандомная фраза из сборника цитат fortune_mod
+${csign}f # | ${csign}ф #                 - где 1 - вкл, 0 - выкл фортунку с утра
+${csign}fortune # | ${csign}фортунка #    - где 1 - вкл, 0 - выкл фортунку с утра
+${csign}f ? | ${csign}ф ?                 - показываем ли с утра фортунку для чата
+${csign}fortune ? | ${csign}фортунка ?    - показываем ли с утра фортунку для чата
+${csign}friday | ${csign}пятница          - а не пятница ли сегодня?
+${csign}lat | ${csign}лат                 - сгенерить фразу из крылатых латинских выражений
+${csign}ping | ${csign}пинг               - попинговать бота
+${csign}ver | ${csign}version | ${csign}версия   - что-то про версию ПО
+${csign}w город | ${csign}п город         - погода в указанном городе
+${csign}karma фраза | ${csign}карма фраза - посмотреть карму фразы
 фраза-- | фраза++           - убавить или добавить карму фразе
 ```
 Но на самом деле я бот больше для общения, чем для исполнения команд.
@@ -319,15 +140,18 @@ sub highlight {
 	my $username;
 	my $visavi = '';
 	my $userid = $msg->from->id;
-	$username = $msg->from->username if ($msg->from->can ('username') && defined($msg->from->username));
 
-	if ($msg->from->can ('first_name') && defined ($msg->from->first_name)) {
+	if ($msg->from->can ('username') && defined $msg->from->username ) {
+		$username = $msg->from->username;
+	}
+
+	if ($msg->from->can ('first_name') && defined $msg->from->first_name) {
 		$fullname = $msg->from->first_name;
 
-		if ($msg->from->can ('last_name') && defined ($msg->from->last_name)) {
+		if ($msg->from->can ('last_name') && defined $msg->from->last_name) {
 			$fullname .= ' ' . $msg->from->last_name;
 		}
-	} elsif ($msg->from->can ('last_name') && defined ($msg->from->last_name)) {
+	} elsif ($msg->from->can ('last_name') && defined $msg->from->last_name) {
 		$fullname .= $msg->from->last_name;
 	}
 
@@ -358,7 +182,7 @@ sub botsleep {
 
 	for (0..(4 + int (rand (3)))) {
 		$msg->typing ();
-		sleep(3);
+		sleep 3;
 		sleep 3 unless ($_);
 	}
 
@@ -366,45 +190,6 @@ sub botsleep {
 	return;
 }
 
-sub fmatch {
-	my $srcphrase = shift;
-	my $answer = shift;
-
-	my ($distance, undef) = distance_edits ($srcphrase, $answer);
-	my $srcphraselen = length $srcphrase;
-	my $distance_max = int ($srcphraselen - ($srcphraselen * (100 - (90 / ($srcphraselen ** 0.5))) * 0.01));
-
-	if ($distance >= $distance_max) {
-		return 0;
-	} else {
-		return 1;
-	}
-}
-
-sub kitty {
-	my $r;
-
-	for (1..3) {
-		my $http = HTTP::Tiny->new (timeout => 3);
-		$r = $http->get ('https://api.thecatapi.com/v1/images/search');
-		last if ($r->{success});
-		sleep 2;
-	}
-
-	if ($r->{success}) {
-		my $jcat = eval { decode_json ($r->{content}) };
-
-		if ($jcat->[0]->{url}) {
-			my @cats = ('龴ↀ◡ↀ龴', '=^..^=', '≧◔◡◔≦ ','^ↀᴥↀ^' );
-			return sprintf '[%s](%s)', $cats[int(rand($#cats))], $jcat->[0]->{url};
-		} else {
-			return 'Нету кошечек, все разбежались.';
-		}
-	} else {
-		return 'Нету кошечек, все разбежались.';
-	}
-}
-
 1;
 
 # vim: set ft=perl noet ai ts=4 sw=4 sts=4:
diff --git a/lib/conf.pm b/lib/conf.pm
index 2a008b3..b864e2b 100644
--- a/lib/conf.pm
+++ b/lib/conf.pm
@@ -5,19 +5,18 @@ use 5.018;
 use strict;
 use warnings;
 use utf8;
-use open qw(:std :utf8);
-use English qw( -no_match_vars );
+use open qw (:std :utf8);
+use English qw ( -no_match_vars );
 use JSON::XS;
 
-use vars qw/$VERSION/;
-use Exporter qw(import);
-our @EXPORT_OK = qw(loadConf);
-$VERSION = '1.0';
+use version; our $VERSION = qw (1.0);
+use Exporter qw (import);
+our @EXPORT_OK = qw (loadConf);
 
 sub loadConf {
 	my $c = 'data/config.json';
 	open my $CH, '<', $c or die "[FATAL] No conf at $c: $OS_ERROR\n";
-	my $len = (stat ($c)) [7];
+	my $len = (stat $c) [7];
 	my $json;
 	my $readlen = read $CH, $json, $len;
 
diff --git a/lib/fortune.pm b/lib/fortune.pm
index 4f543a3..cc7c9f0 100644
--- a/lib/fortune.pm
+++ b/lib/fortune.pm
@@ -5,18 +5,17 @@ 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 open qw (:std :utf8);
+use English qw ( -no_match_vars );
+use Carp qw (cluck croak);
+use File::Path qw (make_path);
+use Math::Random::Secure qw (irand);
 use SQLite_File;
-use MIME::Base64;
-use File::Path qw(mkpath);
-use conf qw(loadConf);
+use conf qw (loadConf);
 
-use vars qw/$VERSION/;
+use version; our $VERSION = qw (1.0);
 use Exporter qw(import);
 our @EXPORT_OK = qw(seed fortune fortune_toggle fortune_toggle_list fortune_status);
-$VERSION = '1.0';
 
 my $c = loadConf();
 my $dir = $c->{fortune}->{dir};
@@ -24,7 +23,7 @@ my $srcdir = $c->{fortune}->{srcdir};
 
 sub seed () {
 	unless (-d $dir) {
-		mkpath ($dir)  ||  croak "Unable to create $dir: $OS_ERROR";
+		make_path ($dir)  ||  croak "Unable to create $dir: $OS_ERROR";
 	}
 
 	my $backingfile = sprintf '%s/fortune.sqlite', $dir;
@@ -39,14 +38,21 @@ sub seed () {
 
 	while (my $fortunefile = readdir ($srcdirhandle)) {
 		my $srcfile = sprintf '%s/%s', $srcdir, $fortunefile;
-		next unless (-f $srcfile);
-		next if ($fortunefile =~ m/\./);
+
+		unless (-f $srcfile) {
+			next;
+		}
+
+		if ($fortunefile =~ m/\./) {
+			next;
+		}
+
 		open (my $fh, '<', $srcfile)  ||  croak "Unable to open $srcfile, $OS_ERROR";
 		# set correct phrase delimiter
 		local $INPUT_RECORD_SEPARATOR = "\n%\n";
 
 		while (readline $fh) {
-			my $phrase = substr($_, 0, -3);
+			my $phrase = substr $_, 0, -3;
 			push @fortune, $phrase;
 		}
 
@@ -67,7 +73,7 @@ sub fortune () {
 		return '';
 	};
 
-	my $phrase = $array[int (rand ($#array - 1))];
+	my $phrase = $array[irand ($#array + 1)];
 	# decode?
 	utf8::decode $phrase;
 	untie @array;
@@ -80,7 +86,7 @@ sub fortune_toggle (@) {
 	my $phrase = 'Фортунка с утра ';
 
 	unless (-d $dir) {
-		mkpath ($dir)  ||  do {
+		make_path ($dir)  ||  do {
 			cluck "[ERROR] Unable to create $dir: $OS_ERROR";
 			return;
 		};
@@ -125,7 +131,7 @@ sub fortune_status ($) {
 	my $phrase = 'Фортунка с утра ';
 
 	unless (-d $dir) {
-		mkpath ($dir)  ||  do {
+		make_path ($dir)  ||  do {
 			cluck "[ERROR] Unable to create $dir: $OS_ERROR";
 			return;
 		};
@@ -141,7 +147,7 @@ sub fortune_status ($) {
 	my $state = $toggle{$chatid};
 
 	if (defined $state && $state) {
-		$phrase .= 'показываtтся.';
+		$phrase .= 'показывается.';
 	} else {
 		$phrase .= 'не показывается.';
 	}
@@ -152,7 +158,7 @@ sub fortune_status ($) {
 
 sub fortune_toggle_list () {
 	unless (-d $dir) {
-		mkpath ($dir)  ||  do {
+		make_path ($dir)  ||  do {
 			cluck "[ERROR] Unable to create $dir: $OS_ERROR";
 			my @empty = ();
 			return @empty;
diff --git a/lib/friday.pm b/lib/friday.pm
index 8d6fbda..0b6505d 100644
--- a/lib/friday.pm
+++ b/lib/friday.pm
@@ -5,27 +5,26 @@ 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 open qw (:std :utf8);
+use English qw ( -no_match_vars );
+use Carp qw (cluck croak);
+use File::Path qw (make_path);
+use Math::Random::Secure qw (irand);
 use SQLite_File;
-use MIME::Base64;
-use File::Path qw(mkpath);
-use conf qw(loadConf);
+use conf qw (loadConf);
 
-use vars qw/$VERSION/;
-use Exporter qw(import);
-our @EXPORT_OK = qw(seed friday);
-$VERSION = '1.0';
+use version; our $VERSION = qw (1.0);
+use Exporter qw (import);
+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 () {
 	unless (-d $dir) {
-		mkpath ($dir)  ||  croak "Unable to create $dir: $OS_ERROR";
+		make_path ($dir)  ||  croak "Unable to create $dir: $OS_ERROR";
 	}
 
 	my $friday;
@@ -43,27 +42,41 @@ sub seed () {
 	open (my $fh, '<', $srcfile)  ||  croak "Unable to open $srcfile, $OS_ERROR\n";
 
 	while (readline $fh) {
-		next unless  m/ \|\| /xmsg;
+		unless (m/ \|\| /xmsg) {
+			next;
+		}
+
 		chomp();
 		my ($phrase, $days) = split(/ \|\| /);
 		my @daylist = split(//, $days);
 
 		foreach my $day (@daylist) {
-			next unless (defined $day);
-			next unless ($day =~ /^\d$/);
-			push @{$friday->[$day - 1]}, $phrase if (defined $phrase && ($phrase ne '') && ($phrase !~ m/^\s+$/xmsg));
+			unless (defined $day) {
+				next;
+			}
+
+			unless ($day =~ /^\d$/) {
+				next;
+			}
+
+			if (defined $phrase && ($phrase ne '') && ($phrase !~ m/^\s+$/xmsg)) {
+				push @{$friday->[$day - 1]}, $phrase;
+			}
 		}
 	}
 
 	close $fh;  ## no critic (InputOutput::RequireCheckedSyscalls, InputOutput::RequireCheckedOpen)
-	for (0..$#dow) { untie $friday->[$_]; }
+
+	for (0..$#dow) {
+		untie $friday->[$_];
+	}
 
 	return;
 }
 
 # just return answer
 sub friday () {
-	my $today = (localtime(time))[6] - 1;
+	my $today = (localtime (time))[6] - 1;
 	my $backingfile = sprintf '%s/%s.sqlite', $dir, $dow[$today];
 
 	tie my @array, 'SQLite_File', $backingfile  ||  do {
@@ -71,8 +84,7 @@ sub friday () {
 		return '';
 	};
 
-	my $phrase = $array[int (rand ($#array - 1))];
-	# decode?
+	my $phrase = $array[irand ($#array + 1)];
 	utf8::decode $phrase;
 	untie @array;
 	return $phrase;
diff --git a/lib/karma.pm b/lib/karma.pm
index 1e855a3..6a2505e 100644
--- a/lib/karma.pm
+++ b/lib/karma.pm
@@ -4,17 +4,17 @@ use 5.018;
 use strict;
 use warnings;
 use utf8;
-use open qw(:std :utf8);
-use English qw( -no_match_vars );
-use Digest::SHA qw(sha1_base64);
+use open qw (:std :utf8);
+use English qw ( -no_match_vars );
+use Carp qw (cluck);
+use Digest::SHA qw (sha1_base64);
 use DB_File;
-use Carp qw(cluck);
-use conf qw(loadConf);
+use File::Path qw (make_path);
+use conf qw (loadConf);
 
-use vars qw/$VERSION/;
-use Exporter qw(import);
+use version; our $VERSION = qw (1.0);
+use Exporter qw (import);
 our @EXPORT_OK = qw(karmaSet karmaGet);
-$VERSION = '1.0';
 
 my $c = loadConf();
 my $karmadir = $c->{karma}->{dir};
@@ -28,7 +28,7 @@ sub karmaSet (@) {
 	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);
+	$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;
@@ -37,6 +37,13 @@ sub karmaSet (@) {
 		$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";
@@ -87,7 +94,7 @@ sub karmaGet (@) {
 	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);
+	$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;
@@ -96,6 +103,13 @@ sub karmaGet (@) {
 		$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";
diff --git a/lib/kitty.pm b/lib/kitty.pm
new file mode 100644
index 0000000..b97f86b
--- /dev/null
+++ b/lib/kitty.pm
@@ -0,0 +1,55 @@
+package kitty;
+
+use 5.018;
+use strict;
+use warnings;
+use utf8;
+use open qw (:std :utf8);
+use English qw ( -no_match_vars );
+use Carp qw (cluck);
+use JSON::XS;
+use HTTP::Tiny;
+use Math::Random::Secure qw (irand);
+
+use version; our $VERSION = qw (1.0);
+use Exporter qw (import);
+our @EXPORT_OK = qw (kitty);
+
+sub kitty {
+	my $r;
+	my $ret = 'Нету кошечек, все разбежались.';
+
+	for (1..3) {
+		my $http = HTTP::Tiny->new (timeout => 3);
+		$r = $http->get ('https://api.thecatapi.com/v1/images/search');
+
+		if ($r->{success}) {
+			last;
+		}
+
+		sleep 2;
+	}
+
+	if ($r->{success}) {
+		my $jcat = eval {
+			decode_json ($r->{content})
+		};
+
+		if ($EVAL_ERROR) {
+			cluck "[ERROR] Unable to decode JSON: $EVAL_ERROR";
+		} else {
+			if ($jcat->[0]->{url}) {
+				my @cats = ('龴ↀ◡ↀ龴', '=^..^=', '≧◔◡◔≦ ','^ↀᴥↀ^' );
+				$ret = sprintf '[%s](%s)', $cats[irand ($#cats + 1)], $jcat->[0]->{url};
+			}
+		}
+	} else {
+		cluck sprintf 'Server return status %s with message: %s', $r->{status}, $r->{reason};
+	}
+
+	return $ret;
+}
+
+1;
+
+# vim: set ft=perl noet ai ts=4 sw=4 sts=4:
diff --git a/lib/lat.pm b/lib/lat.pm
index 4432fba..31436c5 100644
--- a/lib/lat.pm
+++ b/lib/lat.pm
@@ -5,28 +5,27 @@ 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 open qw (:std :utf8);
+use English qw ( -no_match_vars );
+use Carp qw (cluck);
+use File::Basename qw (dirname);
+use File::Path qw (make_path);
 use Hailo;
-use File::Basename qw(dirname);
-use File::Path qw(mkpath);
-use conf qw(loadConf);
+use conf qw (loadConf);
 
-use vars qw/$VERSION/;
-use Exporter qw(import);
-our @EXPORT_OK = qw(train latAnswer);
-$VERSION = '1.0';
+use version; our $VERSION = qw (1.0);
+use Exporter qw (import);
+our @EXPORT_OK = qw (train latAnswer);
 
-my $c = loadConf();
+my $c = loadConf ();
 my $brain = $c->{lat}->{brain};
 my $srcfile = $c->{lat}->{src};
 
 sub train () {
-	my $braindir = dirname ($brain);
+	my $braindir = dirname $brain;
 
 	unless (-d $braindir) {
-		mkpath ($braindir) or do {
+		make_path ($braindir) or do {
 			cluck "Unable to create $braindir: $OS_ERROR";
 			exit 1;
 		};
@@ -38,8 +37,8 @@ sub train () {
 		order => 2
 	);
 
-	$lat->train($srcfile);
-	my ($tokens, $expressions) = ($lat->stats())[0,1];
+	$lat->train ($srcfile);
+	my ($tokens, $expressions) = ($lat->stats ())[0,1];
 	printf "Total tokens: %s\nTotal expressins: %s\n", $tokens, $expressions;
 	$lat->save ();
 	return;
@@ -47,7 +46,7 @@ sub train () {
 
 # just return answer
 sub latAnswer () {
-	my $braindir = dirname ($brain);
+	my $braindir = dirname $brain;
 
 	unless (-d $braindir) {
 		cluck "[ERROR] No lat module data: $braindir is absent! Train lat first.";
@@ -66,7 +65,7 @@ sub latAnswer () {
 		save_on_exit => 0
 	);
 
-	return $lat->reply();
+	return $lat->reply ();
 }
 
 1;
diff --git a/lib/telegrambot.pm b/lib/telegrambot.pm
index 678fd42..e6f5969 100644
--- a/lib/telegrambot.pm
+++ b/lib/telegrambot.pm
@@ -6,22 +6,23 @@ use strict;
 use warnings;
 use utf8;
 use Data::Dumper;
-use open qw(:std :utf8);
-use Carp qw(carp);
-use File::Path qw(mkpath);
+use open qw (:std :utf8);
+use English qw ( -no_match_vars );
+use Carp qw (cluck carp);
+use File::Path qw (make_path);
 use Hailo;
 use Mojo::Base 'Teapot::Bot::Brain';
-use conf qw(loadConf);
-use botlib qw(weather trim randomCommonPhrase command highlight botsleep fmatch);
-use karma qw(karmaSet);
-use fortune qw(fortune fortune_toggle_list);
+use botlib qw (randomCommonPhrase command highlight botsleep);
+use conf qw (loadConf);
+use fortune qw (fortune fortune_toggle_list);
+use karma qw (karmaSet);
+use util qw (trim fmatch);
 
-use vars qw/$VERSION/;
-use Exporter qw(import);
-our @EXPORT_OK = qw(run_telegrambot);
-$VERSION = '1.0';
+use version; our $VERSION = qw (1.0);
+use Exporter qw (import);
+our @EXPORT_OK = qw (run_telegrambot);
 
-my $c = loadConf();
+my $c = loadConf ();
 my $hailo;
 my $myid;
 my $myusername;
@@ -241,7 +242,7 @@ sub __on_msg {
 			} elsif ((lc ($text) =~ /.+ ${qtname}[\,|\!|\?|\.| ]/) or (lc ($text) =~ / $qtname$/)) {
 				$phrase = $text;
 				$reply = $hailo->{$msg->chat->id}->reply ($phrase);
-			# karma agjustment
+			# karma adjustment
 			} elsif (substr ($text, -2) eq '++'  ||  substr ($text, -2) eq '--') {
 				my @arr = split(/\n/, $text);
 
@@ -289,11 +290,16 @@ sub __on_msg {
 
 # setup our bot
 sub init {
-	unless (-d $c->{telegrambot}->{braindir}) {
-		mkpath ($c->{telegrambot}->{braindir}, 0, 0755); ## no critic (ValuesAndExpressions::ProhibitLeadingZeros)
+	my $self = shift;
+	my $braindir = $c->{telegrambot}->{braindir};
+
+	unless (-d $braindir) {
+		make_path ($braindir, 0, 0755) or do { ## no critic (ValuesAndExpressions::ProhibitLeadingZeros)
+			cluck "Unable to create $braindir: $OS_ERROR";
+			exit 1;
+		};
 	}
 
-	my $self = shift;
 	$self->add_listener (\&__on_msg);
 	$self->add_repeating_task (900, \&__cron);
 	return;
diff --git a/lib/util.pm b/lib/util.pm
new file mode 100644
index 0000000..8d3e4f6
--- /dev/null
+++ b/lib/util.pm
@@ -0,0 +1,83 @@
+package util;
+
+use 5.018;
+use strict;
+use warnings;
+use utf8;
+use open qw (:std :utf8);
+use English qw ( -no_match_vars );
+use Digest::SHA qw (sha1_base64);
+use Encode;
+use MIME::Base64;
+use Text::Fuzzy qw (distance_edits);
+use URI::URL;
+
+use version; our $VERSION = qw (1.0);
+use Exporter qw (import);
+our @EXPORT_OK = qw (trim urlencode fmatch utf2b64 utf2sha1);
+
+sub trim {
+	my $str = shift;
+
+	if ($str eq '') {
+		return $str;
+	}
+
+	while (substr ($str, 0, 1) =~ /^\s$/xms) {
+		$str = substr $str, 1;
+	}
+
+	while (substr ($str, -1, 1) =~ /^\s$/xms) {
+		chop $str;
+	}
+
+	return $str;
+}
+
+sub urlencode {
+	my $str = shift;
+	my $urlobj = url $str;
+	return $urlobj->as_string;
+}
+
+sub fmatch {
+	my $srcphrase = shift;
+	my $answer = shift;
+
+	my ($distance, undef) = distance_edits ($srcphrase, $answer);
+	my $srcphraselen = length $srcphrase;
+	my $distance_max = int ($srcphraselen - ($srcphraselen * (100 - (90 / ($srcphraselen ** 0.5))) * 0.01));
+
+	if ($distance >= $distance_max) {
+		return 0;
+	} else {
+		return 1;
+	}
+}
+
+sub utf2b64 {
+	my $string = shift;
+
+	if ($string eq '') {
+		return encode_base64 '';
+	}
+
+	my $bytes = encode_utf8 $string;
+	return encode_base64 $bytes;
+}
+
+sub utf2sha1 {
+	my $string = shift;
+
+	if ($string eq '') {
+		return sha1_base64 '';
+	}
+
+	my $bytes = encode_utf8 $string;
+	return sha1_base64 $bytes;
+}
+
+
+1;
+
+# vim: set ft=perl noet ai ts=4 sw=4 sts=4:
diff --git a/lib/weather.pm b/lib/weather.pm
new file mode 100644
index 0000000..ca5f514
--- /dev/null
+++ b/lib/weather.pm
@@ -0,0 +1,200 @@
+package weather;
+
+use 5.018;
+use strict;
+use warnings;
+use utf8;
+use open qw (:std :utf8);
+use English qw ( -no_match_vars );
+use Carp qw (carp cluck);
+use DB_File;
+use Digest::MD5 qw (md5_base64);
+use File::Path qw (make_path);
+use HTTP::Tiny;
+use JSON::XS;
+use conf qw (loadConf);
+use util qw (trim urlencode);
+
+use version; our $VERSION = qw (1.0);
+use Exporter qw (import);
+our @EXPORT_OK = qw (weather);
+
+my $c = loadConf ();
+
+sub weather {
+	my $city = shift;
+	$city = trim $city;
+
+	return 'Мне нужно ИМЯ города.' if ($city eq '');
+	return 'Длинновато для названия города.' if (length ($city) > 80);
+
+	$city = ucfirst $city;
+	my $w = __weather ($city);
+	my $reply;
+
+	if ($w) {
+		if ($w->{temperature_min} == $w->{temperature_max}) {
+			$reply = sprintf ("Погода в городе %s, %s:\n%s, ветер %s %s м/c, температура %s°C, ощущается как %s°C, относительная влажность %s%%, давление %s мм.рт.с",
+				$w->{name},
+				$w->{country},
+				ucfirst ($w->{description}),
+				$w->{wind_direction},
+				$w->{wind_speed},
+				$w->{temperature_min},
+				$w->{temperature_feelslike},
+				$w->{humidity},
+				$w->{pressure}
+			);
+		} else {
+			$reply = sprintf ("Погода в городе %s, %s:\n%s, ветер %s %s м/c, температура %s-%s°C, ощущается как %s°C, относительная влажность %s%%, давление %s мм.рт.ст",
+				$w->{name},
+				$w->{country},
+				ucfirst ($w->{description}),
+				$w->{wind_direction},
+				$w->{wind_speed},
+				$w->{temperature_min},
+				$w->{temperature_max},
+				$w->{temperature_feelslike},
+				$w->{humidity},
+				$w->{pressure}
+			);
+		}
+	} else {
+		$reply = "Я не знаю, какая погода в $city";
+	}
+
+	return $reply;
+}
+
+sub __weather {
+	my $city = shift;
+	$city = urlencode $city;
+	my $id = md5_base64 $city;
+	my $appid = $c->{openweathermap}->{appid};
+	my $cachedir = $c->{openweathermap}->{cachedir};
+	my $cachetimefile = $cachedir . '/openweathermap.Id-Timestamp.db';
+	my $cachedatafile = $cachedir . '/openweathermap.Id-Data.db';
+	my $now = time ();
+	my $fc;
+	my $w;
+
+	unless (-d $cachedir) {
+		make_path ($cachedir)  ||  do {
+			cluck "[ERROR] Unable to create $cachedir: $OS_ERROR";
+			return;
+		};
+	}
+
+	# attach to cache data
+	tie my %cachetime, 'DB_File', $cachetimefile or do {
+		carp "[ERROR] Something nasty happen when cachetime ties to its data: $OS_ERROR";
+		return undef;
+	};
+
+	tie my %cachedata, 'DB_File', $cachedatafile or do {
+		carp "[ERROR] Something nasty happen when cachedata ties to its data: $OS_ERROR";
+		return undef;
+	};
+
+	# lookup cache
+	if (defined ($cachetime{$id}) && ($now - $cachetime{$id}) < 10800) {
+		$fc = decode_json $cachedata{$id};
+	} else {
+		my $r;
+
+		# try 3 times and giveup
+		for (1..3) {
+			my $http = HTTP::Tiny->new (timeout => 3);
+			$r = $http->get (sprintf ('http://api.openweathermap.org/data/2.5/weather?q=%s&lang=ru&APPID=%s', $city, $appid));
+
+			if ($r->{success}) {
+				last;
+			}
+
+			sleep 2;
+		}
+
+		# all 3 times can give error, so check it here
+		if ($r->{success}) {
+			$fc = eval {
+				decode_json $r->{content};
+			};
+
+			if ($EVAL_ERROR) {
+				cluck "[WARN] openweathermap returns corrupted json: $EVAL_ERROR";
+				untie %cachetime;
+				untie %cachedata;
+				return undef;
+			};
+
+			$cachetime{$id} = $now;
+			$cachedata{$id} = encode_json $fc;
+		} else {
+			cluck sprintf 'Server return status %s with message: %s', $r->{status}, $r->{reason};
+			untie %cachetime;
+			untie %cachedata;
+			return undef;
+		}
+	}
+
+	untie %cachetime;
+	untie %cachedata;
+
+	# TODO: check all of this for existance
+	$w->{'name'} = $fc->{name};
+	$w->{'state'} = $fc->{state};
+	$w->{'country'} = $fc->{sys}->{country};
+	$w->{'longitude'} = $fc->{coord}->{lon};
+	$w->{'latitude'} = $fc->{coord}->{lat};
+	$w->{'temperature_min'} = int ($fc->{main}->{temp_min} - 273.15);
+	$w->{'temperature_max'} = int ($fc->{main}->{temp_max} - 273.15);
+	$w->{'temperature_feelslike'} = int ($fc->{main}->{feels_like} - 273.15);
+	$w->{'humidity'} = $fc->{main}->{humidity};
+	$w->{'pressure'} = int ($fc->{main}->{pressure} * 0.75006375541921);
+	$w->{'description'} = $fc->{weather}->[0]->{description};
+	$w->{'wind_speed'} = $fc->{wind}->{speed};
+	$w->{'wind_direction'} = 'разный';
+	my $dir = int ($fc->{wind}->{deg} + 0);
+
+	if ($dir == 0) {
+		$w->{'wind_direction'} = 'северный';
+	} elsif ($dir > 0   && $dir <= 30) {
+		$w->{'wind_direction'} = 'северо-северо-восточный';
+	} elsif ($dir > 30  && $dir <= 60) {
+		$w->{'wind_direction'} = 'северо-восточный';
+	} elsif ($dir > 60  && $dir <  90) {
+		$w->{'wind_direction'} = 'восточно-северо-восточный';
+	} elsif ($dir == 90) {
+		$w->{'wind_direction'} = 'восточный';
+	} elsif ($dir > 90  && $dir <= 120) {
+		$w->{'wind_direction'} = 'восточно-юго-восточный';
+	} elsif ($dir > 120 && $dir <= 150) {
+		$w->{'wind_direction'} = 'юговосточный';
+	} elsif ($dir > 150 && $dir <  180) {
+		$w->{'wind_direction'} = 'юго-юго-восточный';
+	} elsif ($dir == 180) {
+		$w->{'wind_direction'} = 'южный';
+	} elsif ($dir > 180 && $dir <= 210) {
+		$w->{'wind_direction'} = 'юго-юго-западный';
+	} elsif ($dir > 210 && $dir <= 240) {
+		$w->{'wind_direction'} = 'юго-западный';
+	} elsif ($dir > 240 && $dir <  270) {
+		$w->{'wind_direction'} = 'западно-юго-западный';
+	} elsif ($dir == 270) {
+		$w->{'wind_direction'} = 'западный';
+	} elsif ($dir > 270 && $dir <= 300) {
+		$w->{'wind_direction'} = 'западно-северо-западный';
+	} elsif ($dir > 300 && $dir <= 330) {
+		$w->{'wind_direction'} = 'северо-западный';
+	} elsif ($dir > 330 && $dir <  360) {
+		$w->{'wind_direction'} = 'северо-северо-западный';
+	} elsif ($dir == 360) {
+		$w->{'wind_direction'} = 'северный';
+	}
+
+	return $w;
+}
+
+1;
+
+# vim: set ft=perl noet ai ts=4 sw=4 sts=4: