Fix inconsistence of city name pick decision introduced in fa59102

Introduce option country in config to use either country code or coordinates as secondary id for city.
Looks like openweathermap.org gives incorrect or mangled coutry codes for some cities for whatever reasons. So we have to introduce this option in order to cool-down irritation of some engaging users.
2023-05-07 18:57:15 +03:00 · 2023-05-07 16:22:33 +03:00 · 2023-05-04 13:29:38 +03:00 · 2023-05-04 13:25:47 +03:00 · 2023-05-04 11:12:32 +03:00 · 2023-02-04 15:37:40 +03:00
12 changed files with 598 additions and 275 deletions
--- a/.perlcriticrc
+++ b/.perlcriticrc
@@ -1,4 +1,19 @@
 #!/usr/bin/env perlcritic
+
+# Задействованные модули критика:
+#
+# Perl::Critic::More
+# Perl::Critic::Pulp
+# Perl::Critic::TooMuchCode
+# Perl::Critic::Lax
+# Perl::Critic::CognitiveComplexity
+# Perl::Critic::Policy::CompileTime
+# Perl::Critic::Policy::ProhibitImplicitImport
+# Perl::Critic::Policy::Dynamic::NoIndirect
+# Perl::Critic::StricterSubs
+# Perl::Critic::Policy::ProhibitImplicitImport
+# Perl::Critic::Policy::CodeLayout::RequireUseUTF8
+
 severity    = 5
 verbose     = 8

@@ -94,3 +109,28 @@ lib_sections    = NAME | VERSION | DESCRIPTION | AUTHOR | LICENSE AND COPYRIGHT
 # Have to use it, so fuckoff

 [-Variables::ProhibitPackageVars]
+
+[-Miscellanea::ProhibitUnrestrictedNoCritic]
+
+[-Editor::RequireEmacsFileVariables]
+
+[-CodeLayout::RequireASCII]
+
+[-TooMuchCode::ProhibitDuplicateLiteral]
+
+[-ValuesAndExpressions::RequireConstantOnLeftSideOfEquality]
+
+[-Lax::RequireConstantOnLeftSideOfEquality::ExceptEq]
+
+[-TooMuchCode::ProhibitUnnecessaryUTF8Pragma]
+
+[-ErrorHandling::RequireUseOfExceptions]
+
+[-Lax::ProhibitEmptyQuotes::ExceptAsFallback]
+
+[-ValuesAndExpressions::RestrictLongStrings]
+
+[-TooMuchCode::ProhibitLargeBlock]
+# read my lips: fuck off
+
+[-RegularExpressions::ProhibitComplexRegexes]
--- a/18
+++ b/18
@@ -7,7 +7,7 @@ aleesa-webapp
 -----------------------------------------------------------------------------------------------------------------------
 Клиент подписан на на redis-канал webapp. В этот канал пишет другой демоночек - aleesa-misc.

-Формат протокола 
+Формат протокола общения по redis pub-sub - см README от aleesa-misc.


 Плагин для работы с flickr
@@ -46,6 +46,12 @@ https://home.openweathermap.org/api_keys . Free plan предлагает всё
 Когда api key будет создан, его нужно вписать в config.json в секцию openweathermap в качестве appid. На этом всё.


+Список строк UserAgent для модуля Drink
+-----------------------------------------------------------------------------------------------------------------------
+На сайте https://kakoysegodnyaprazdnik.ru/ умеют банить по useragent-у чем-то им не угодил UA от Mojo::Client. Пришлось
+прикрутить список из 31 штуки Browser UserAgent string, по одному на каждый день недели.
+
+
 Как это запустить?
 -----------------------------------------------------------------------------------------------------------------------
 Понадобится perl, cpanm и local::lib, а также несколько разных devel-пакетов для разных библиотек. Как правило, это
@@ -63,5 +69,13 @@ https://home.openweathermap.org/api_keys . Free plan предлагает всё
 В каталоге contrib находится скрипт для alpine linux, системы инициализации openrc. Этот скрипт достаточно положить В
 /etc/init.d/aleesa-webapp сконфигурить сервис по инструкции выше и после этого сервис запускается командой:
 service aleesa-webapp start
-в автозагрузку его можно прописать через команду
+
+в автозагрузку его можно прописать через команду:
 rc-update add aleesa-webapp default
+
+
+На MacOS вылазит ошибка BerkeleyDB.xs:82:2: error: db.h is from Berkeley DB 1.x - need at least Berkeley DB 2.6.4
+------------------------------------------------------------------------------------------------------------------------
+На момент 04.02.2023 в Mac OS Ventura (13.1), это чинится установкой через brew пакета berkeley-db4:
+brew install berkeley-db4
+brew link berkeley-db4 --force
--- a/8
+++ b/8
@@ -1,8 +0,0 @@
-Приоритетные задачи:
-Нет
-
-Неприоритетные задачи:
-* В парсере обрабатывать параметр plugin.
-  Формально, клиенты не должны знать, как работает этот чёрный ящик. Послал
-  сообщение - получил ответ, а уж как он там получается - это неважно. Тем не
-  менее возможность напрямую дёрнуть один из плагинов должна быть.
--- a/bin/aleesa-webapp
+++ b/bin/aleesa-webapp
@@ -1,6 +1,6 @@
 #!/usr/bin/perl

-use 5.018;
+use 5.018; ## no critic (ProhibitImplicitImport)
 use strict;
 use warnings;
 use utf8;
@@ -29,9 +29,10 @@ no Cwd;
 use Cwd::utf8 qw (chdir abs_path);
 use File::Basename qw (basename dirname);
 use File::Path qw (make_path);
+use File::Spec ();
 use Log::Any qw ($log);
-use Log::Any::Adapter;
-use Log::Any::For::Std;
+use Log::Any::Adapter ();
+use Log::Any::For::Std ();
 use POSIX qw (setgid setuid setsid);

 use Conf qw (LoadConf);
@@ -42,7 +43,6 @@ sub __fork;
 sub __signal_handler;

 local $OUTPUT_AUTOFLUSH = 1;
-my $runAsUid = $UID;

 my $piddir = '/var/run/' . basename (abs_path $PROGRAM_NAME);
 my $C = LoadConf ();
@@ -69,8 +69,8 @@ if ($UID == 0) {
 		make_path (
 			$piddir, {
 				uid   => $uid,
-				group => $gid
-			}
+				group => $gid,
+			},
 		);
 	}

@@ -81,8 +81,8 @@ if ($UID == 0) {
 			make_path (
 					$logdir, {
 							uid   => $uid,
-							group => $gid
-					}
+							group => $gid,
+					},
 			) or die "Unable to create $logdir: $OS_ERROR\n";
 		}
 	}
@@ -102,14 +102,14 @@ if (defined $logfile) {
 	# verbosity paticulary for CHI.
 	Log::Any::Adapter->set (
 		{
-			category => 'CHI::Driver'
+			category => 'CHI::Driver',
 		},
 		'File',
 		$logfile,
-		log_level => 'warn'
+		log_level => 'warn',
 	);
 } else {
-	Log::Any::Adapter->set ('File', '/dev/null');
+	Log::Any::Adapter->set ('File', File::Spec->devnull);
 }

 # по-умолчанию, демонизируемся, если явно не указано, что этого делать не надо
@@ -125,7 +125,7 @@ my $apath = abs_path $PROGRAM_NAME;
 unless (defined $apath) {
 	$log->fatal ("[FATAL] Unable to get abs_path: $OS_ERROR\n");
 	exit 1;
-};
+}

 my $pidfile = sprintf '%s/%s.pid', $piddir, basename $apath;
 $log->info ("[INFO] Creating pidfile at $pidfile");
@@ -151,7 +151,7 @@ $PROGRAM_NAME = abs_path $PROGRAM_NAME;              ## no critic (Variables::Re
 # run bot, at last
 RunWebApp ();

-if (-f $pidfile) {
+if (-e $pidfile) {
 	unlink $pidfile;
 }

@@ -159,11 +159,11 @@ exit 0;

 sub daemonize {
 	__fork ();
-	POSIX::setsid ();
-	open STDIN, '<', '/dev/null';                    ## no critic (InputOutput::RequireCheckedSyscalls, InputOutput::RequireCheckedOpen)
+	setsid ();
+	open STDIN, '<', File::Spec->devnull;                    ## no critic (InputOutput::RequireCheckedSyscalls, InputOutput::RequireCheckedOpen)
 	# we handle STDOUT && STDERR via Log::Any::For::Std, so do not close them explicitly
-	#open STDOUT, '>', '/dev/null';                   ## no critic (InputOutput::RequireCheckedSyscalls, InputOutput::RequireCheckedOpen)
-	#open STDERR, '>', '/dev/null';                   ## no critic (InputOutput::RequireCheckedSyscalls, InputOutput::RequireCheckedOpen)
+	#open STDOUT, '>', File::Spec->devnull;                   ## no critic (InputOutput::RequireCheckedSyscalls, InputOutput::RequireCheckedOpen)
+	#open STDERR, '>', File::Spec->devnull;                   ## no critic (InputOutput::RequireCheckedSyscalls, InputOutput::RequireCheckedOpen)
 	__fork ();
 	umask 0;
 	return;
@@ -187,7 +187,7 @@ sub __fork {
 sub __signal_handler {
 	$log->info ("[INFO] Caught a signal $OS_ERROR");

-	if (-f $pidfile) {
+	if (-e $pidfile) {
 		unlink $pidfile;
 	}

--- a/bin/flickr_init.pl
+++ b/bin/flickr_init.pl
@@ -1,6 +1,6 @@
 #!/usr/bin/perl

-use 5.018;
+use 5.018; ## no critic (ProhibitImplicitImport)
 use strict;
 use warnings;
 use utf8;
--- a/32
+++ b/32
@@ -1,31 +1,37 @@
+## no critic
 requires 'Carp',                    '==1.50';
 requires 'CHI',                     '==0.61';
 requires 'CHI::Driver::BerkeleyDB', '==0.05';
+requires 'Clone',                   '==0.46';
 requires 'Cwd',                     '==3.75';
 requires 'Cwd::utf8',               '==0.011';
-requires 'DateTime',                '==1.55';
+requires 'DateTime',                '==1.59';
 requires 'Digest::HMAC_SHA1',       '==1.04';
-requires 'Encode',                  '==3.16';
+requires 'Encode',                  '==3.19';
 requires 'English',                 '0';
 requires 'EV',                      '==4.33';
 requires 'File::Basename',          '0';
 requires 'File::Path',              '==2.18';
-requires 'HTML::TokeParser',        '==3.76';
-requires 'IO::Socket::SSL',         '==2.073';
-requires 'JSON',                    '==4.04';
+requires 'File::Spec',              '==3.75';
+requires 'HTML::TokeParser',        '==3.81';
+requires 'IO::Socket::SSL',         '==2.081';
+requires 'JSON',                    '==4.10';
 requires 'JSON::XS',                '==4.03';
-requires 'local::lib',              '==2.000028';
-requires 'Log::Any',                '==1.710';
-requires 'Log::Any::Adapter',       '==1.710';
+requires 'local::lib',              '==2.000029';
+requires 'Log::Any',                '==1.714';
+requires 'Log::Any::Adapter',       '==1.714';
 requires 'Log::Any::For::Std',      '==0.05';
 requires 'Math::Random::Secure',    '==0.080001';
 requires 'MIME::Base64',            '==3.16';
-requires 'Mojolicious',             '==9.22';
+requires 'Mojolicious',             '==9.31';
 requires 'Mojo::IOLoop::Signal',    '==0.003';
-requires 'Mojo::Redis',             '==3.27';
+# Чтобы заткнуть Mojo::UserAgent::Cached
+requires 'Mojo::Log',               '0';
+requires 'Mojo::Redis',             '==3.29';
 requires 'Mojo::UserAgent',         '0';
-requires 'Mojo::UserAgent::Cached', '==1.18';
+requires 'Mojo::UserAgent::Cached', '==1.25';
 requires 'POSIX',                   '0';
-requires 'Protocol::Redis::XS',     '0';
+# Рекомендованный модуль для DateTime
+requires 'Sub::Util',               '==1.63';
 requires 'URI::Encode::XS',         '==0.11';
-requires 'URI::URL',                '==5.10';
+requires 'URI::URL',                '==5.19';
--- a/data/config_sample.json
+++ b/data/config_sample.json
@@ -26,6 +26,8 @@
    "forwards_max" : 5,

    "openweathermap" : {
+        # (For shitty political reasons) 0 - use coordinates instead of coutry code, 1 - use country codes
+        "country" : 0,
        "appid" : "get_it_on_openweathermap.org"
    },

--- a/data/useragents.txt
+++ b/data/useragents.txt
@@ -0,0 +1,31 @@
+Mozilla/5.0 (Macintosh; Intel Mac OS X 12_2) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/98.0.4758.81 Safari/537.36 OPR/83.0.4254.27
+Mozilla/5.0 (Windows NT 10.0) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/98.0.4758.81 Safari/537.36
+Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/87.0.4280.88 Safari/537.36 Vivaldi/3.5
+Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/88.0.4324.182 Safari/537.36 Edg/88.0.705.81
+Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/89.0.4389.114 Safari/537.36
+Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/92.0.4515.159 Safari/537.36
+Mozilla/5.0 (Macintosh; Intel Mac OS X 10_15_7) AppleWebKit/605.1.15 (KHTML, like Gecko) Version/15.2 Safari/605.1.15
+Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/95.0.4638.69 Safari/537.36
+Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/95.0.4638.69 Safari/537.36 Edg/95.0.1020.44
+Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/96.0.4664.110 Safari/537.36
+Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/96.0.4664.110 Safari/537.36 Edg/96.0.1054.62
+Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/96.0.4664.110 Safari/537.36 OPR/82.0.4227.50
+Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/97.0.4692.71 Safari/537.36 Edg/97.0.1072.55
+Mozilla/5.0 (Macintosh; Intel Mac OS X 12_2) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/98.0.4758.81 Safari/537.36
+Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/98.0.4758.81 Safari/537.36
+Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/98.0.4758.81 Safari/537.36 Edg/97.0.1072.69
+Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/98.0.4758.81 Safari/537.36 Vivaldi/4.3
+Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/98.0.4758.81 YaBrowser/22.1.0 Yowser/2.5 Safari/537.36
+Mozilla/5.0 (Windows NT 10.0; Win64; x64; rv:91.0) Gecko/20100101 Firefox/91.0
+Mozilla/5.0 (Windows NT 10.0; Win64; x64; rv:95.0) Gecko/20100101 Firefox/95.0
+Mozilla/5.0 (Macintosh; Intel Mac OS X 10_15_6) AppleWebKit/605.1.15 (KHTML, like Gecko) Version/15.1 Safari/605.1.15
+Mozilla/5.0 (Windows NT 10.0; Win64; x64; rv:96.0) Gecko/20100101 Firefox/96.0
+Mozilla/5.0 (Windows NT 10.0; Win64; x64; rv:97.0) Gecko/20100101 Firefox/97.0
+Mozilla/5.0 (Windows NT 10.0; WOW64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/87.0.4280.88 Safari/537.36 Vivaldi/3.5
+Mozilla/5.0 (Windows NT 10.0; WOW64; Trident/7.0; rv:11.0) like Gecko
+Mozilla/5.0 (Windows NT 10.0; WOW64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/98.0.4758.81 Safari/537.36 OPR/83.0.4254.27
+Mozilla/5.0 (X11; Fedora; Linux x86_64; rv:91.0) Gecko/20100101 Firefox/91.0
+Mozilla/5.0 (X11; Linux x86_64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/98.0.4758.81 Safari/537.36 OPR/83.0.4254.27
+Mozilla/5.0 (X11; Linux x86_64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/98.0.4758.81 Safari/537.36 Vivaldi/4.3
+Mozilla/5.0 (X11; Ubuntu; Linux i686; rv:91.0) Gecko/20100101 Firefox/91.0
+Mozilla/5.0 (X11; Ubuntu; Linux x86_64; rv:97.0) Gecko/20100101 Firefox/97.0
--- a/lib/Conf.pm
+++ b/lib/Conf.pm
@@ -1,14 +1,13 @@
 package Conf;
-# Загружает конфиг
+# Загружает конфиг файл

-use 5.018;
+use 5.018; ## no critic (ProhibitImplicitImport)
 use strict;
 use warnings;
 use utf8;
 use open qw (:std :utf8);
 use English qw ( -no_match_vars );
-use Encode qw (encode);
-use JSON::XS;
+use JSON::XS ();

 use version; our $VERSION = qw (1.0);
 use Exporter qw (import);
@@ -16,17 +15,26 @@ 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 $json;
+	my $CH;
+
+	unless (open $CH, '<', $c) {
+		die "[FATAL] No conf at $c: $OS_ERROR\n";
+	}
+
 	my $len = (stat $c) [7];
+	my $json;
 	my $readlen = read $CH, $json, $len;
-	$json = encode 'UTF-8', $json;

 	unless ($readlen) {
 		close $CH;                                   ## no critic (InputOutput::RequireCheckedSyscalls
 		die "[FATAL] Unable to read $c: $OS_ERROR\n";
 	}

+	if ($readlen != $len) {
+		close $CH;                                   ## no critic (InputOutput::RequireCheckedSyscalls
+		die "[FATAL] File $c is $len bytes on disk, but we read only $readlen bytes\n";
+	}
+
 	close $CH;                                       ## no critic (InputOutput::RequireCheckedSyscalls
 	my $j = JSON::XS->new->utf8->relaxed;
 	return $j->decode ($json);
--- a/lib/WebApp.pm
+++ b/lib/WebApp.pm
@@ -1,19 +1,20 @@
 package WebApp;

 # Общие модули - синтаксис, кодировки итд
-use 5.018;
+use 5.018; ## no critic (ProhibitImplicitImport)
 use strict;
 use warnings;
 use utf8;
 use open qw (:std :utf8);

 # Модули для работы приложения
-use Data::Dumper;
+use Clone qw (clone);
+use Data::Dumper qw (Dumper);
 use Log::Any qw ($log);
 use Math::Random::Secure qw (irand);
-use Mojo::Redis;
-use Mojo::IOLoop;
-use Mojo::IOLoop::Signal;
+use Mojo::Redis ();
+use Mojo::IOLoop ();
+use Mojo::IOLoop::Signal ();

 # Плагины web-клиентов
 use Conf qw (LoadConf);
@@ -24,23 +25,51 @@ use Exporter qw (import);
 our @EXPORT_OK = qw (RunWebApp);

 my $c = LoadConf ();
-my $fwd_cnt = $c->{'forward_max'} // 5;
+my $fwd_cnt = 5;
+
+if (defined $c->{'forward_max'}) {
+	$fwd_cnt = $c->{'forward_max'};
+}

 # Основной парсер
 my $parse_message = sub {
 	my $self = shift;
-	my $m = shift;
-	my $answer = $m;
-	$answer->{from} = 'webapp';
+	my $m    = shift;
+
+	$log->debug ('[DEBUG] Incoming message ' . Dumper ($m));
+
+	unless (defined $m->{message}) {
+		$log->error (sprintf 'Unable to process unknown message: %s', $m->{message});
+		return;
+	}
+
+	my $answer         = clone ($m);
+	$answer->{from}    = 'webapp';
+	$answer->{message} = undef;
+
 	my $send_to = $m->{plugin};
 	my $reply;

+	# Если $answer->{misc}->{answer} не существует, то проставим его как 1, предполагаем, что по-умолчанию ответ от нас
+	# всё-таки ожидают. Если что - уточним ниже.
 	if (defined $answer->{misc}) {
+		unless (defined $answer->{misc}->{answer}) {
+			$answer->{misc}->{answer} = 1;
+		}
+
+		unless (defined $answer->{misc}->{bot_nick}) {
+			$answer->{misc}->{bot_nick} = undef;
+		}
+
+		unless (defined $answer->{misc}->{csign}) {
+			$answer->{misc}->{csign} = '!';
+		}
+
 		unless (defined $answer->{misc}->{fwd_cnt}) {
 			$answer->{misc}->{fwd_cnt} = 1;
 		} else {
 			if ($answer->{misc}->{fwd_cnt} > $fwd_cnt) {
-				$log->error ('Forward loop detected, discarding message.');
+				$log->error ('[ERROR] Forward loop detected, discarding message.');
 				$log->debug (Dumper $m);
 				return;
 			} else {
@@ -48,111 +77,120 @@ my $parse_message = sub {
 			}
 		}

-		unless (defined $answer->{misc}->{answer}) {
-			$answer->{misc}->{answer} = 1;
+		unless (defined $answer->{misc}->{good_morning}) {
+			$answer->{misc}->{good_morning} = 0;
 		}

-		unless (defined $answer->{misc}->{csign}) {
-			$answer->{misc}->{csign} = '!';
+		unless (defined $answer->{misc}->{msg_format}) {
+			$answer->{misc}->{msg_format} = 0;
+		}
+
+		unless (defined $answer->{misc}->{username}) {
+			$answer->{misc}->{username} = 'user';
 		}
 	} else {
 		$answer->{misc}->{answer} = 1;
-		$answer->{misc}->{csign} = '!';
+		$answer->{misc}->{bot_nick} = undef;
+		$answer->{misc}->{csign} = $c->{csign};
+		$answer->{misc}->{fwd_cnt} = 1;
+		$answer->{misc}->{good_morning} = 0;
 		$answer->{misc}->{msg_format} = 0;
+		$answer->{misc}->{username} = 'user';
 	}

-	$log->debug ('[DEBUG] Incoming message ' . Dumper($m));
+	if (length $m->{message} <= length $answer->{misc}->{csign}) {
+		$log->info (sprintf 'Unable to process unknown message: %s', $m->{message});
+		return;
+	}

-	if (substr ($m->{message}, 1) eq 'buni') {
-		$reply = Buni ();
-	} elsif (substr ($m->{message}, 1) eq 'anek' || substr ($m->{message}, 1) eq 'анек' || substr ($m->{message}, 1) eq 'анекдот') {
-		if ($m->{plugin} eq 'telegram') {
+	if (substr ($m->{message}, 0, length ($answer->{misc}->{csign})) ne $answer->{misc}->{csign}) {
+		$log->info (sprintf 'Unable to process unknown message: %s', $m->{message});
+		return;
+	}
+
+	my $cmd = substr $m->{message}, length ($answer->{misc}->{csign});
+
+	if ($cmd eq 'buni') {
+		if (($m->{plugin} eq 'telegram')  &&  $answer->{misc}->{msg_format}) {
+			$reply = sprintf '[buni](%s)', Buni ();
+		} else {
+			$reply = Buni ();
+		}
+	} elsif ($cmd eq 'anek' || $cmd eq 'анек' || $cmd eq 'анекдот') {
+		if (($m->{plugin} eq 'telegram')  &&  $answer->{misc}->{msg_format}) {
 			$reply = "```\n" . Anek () . "\n```";
-			$answer->{misc}->{msg_format} = 1;
 		} else {
 			$reply = Anek ();
 		}
-	} elsif (substr ($m->{message}, 1) eq 'cat' || substr ($m->{message}, 1) eq 'кис') {
-		if ($m->{plugin} eq 'telegram') {
+	} elsif ($cmd eq 'cat' || $cmd eq 'кис') {
+		if (($m->{plugin} eq 'telegram')  &&  $answer->{misc}->{msg_format}) {
 			my @cats = ('龴ↀ◡ↀ龴', '=^..^=', '≧◔◡◔≦ ','^ↀᴥↀ^');
-			my $cat = Kitty ();
-			$reply = sprintf '[%s](%s)', $cats[irand ($#cats + 1)], $cat;
-			$answer->{misc}->{msg_format} = 1;
+			$reply = sprintf '[%s](%s)', $cats[irand ($#cats + 1)], Kitty ();
 		} else {
 			$reply = Kitty ();
 		}
-	} elsif (substr ($m->{message}, 1) eq 'drink' || substr ($m->{message}, 1) eq 'праздник') {
+	} elsif ($cmd eq 'drink' || $cmd eq 'праздник') {
 		$reply = Drink ();
-	} elsif (substr ($m->{message}, 1) eq 'fox' || substr ($m->{message}, 1) eq 'лис') {
-		if ($m->{plugin} eq 'telegram') {
-			my $fox = Fox ();
-			$reply = sprintf '[-^^,--,~](%s)', $fox;
-			$answer->{misc}->{msg_format} = 1;
+	} elsif ($cmd eq 'fox' || $cmd eq 'лис') {
+		if (($m->{plugin} eq 'telegram')  &&  $answer->{misc}->{msg_format}) {
+			$reply = sprintf '[-^^,--,~](%s)', Fox ();
 		} else {
 			$reply = Fox ();
 		}
-	} elsif (substr ($m->{message}, 1) eq 'frog' || substr ($m->{message}, 1) eq 'лягушка') {
-		if ($m->{plugin} eq 'telegram') {
+	} elsif ($cmd eq 'frog' || $cmd eq 'лягушка') {
+		if (($m->{plugin} eq 'telegram')  &&  $answer->{misc}->{msg_format}) {
 			my @art = qw (frog toad лягушка);
-			my $frog = Frog ();
-			$reply = sprintf '[%s](%s)', $art [irand ($#art + 1)], $frog;
-			$answer->{misc}->{msg_format} = 1;
+			$reply = sprintf '[%s](%s)', $art [irand ($#art + 1)], Frog ();
 		} else {
 			$reply = Frog ();
 		}
-	} elsif (substr ($m->{message}, 1) eq 'horse' || substr ($m->{message}, 1) eq 'лошадь' || substr ($m->{message}, 1) eq 'лошадка') {
-		if ($m->{plugin} eq 'telegram') {
+	} elsif ($cmd eq 'horse' || $cmd eq 'лошадь' || $cmd eq 'лошадка') {
+		if (($m->{plugin} eq 'telegram')  &&  $answer->{misc}->{msg_format}) {
 			my @art = qw (horse лошадь лошадка);
-			my $horse = Horse ();
-			$reply = sprintf '[%s](%s)', $art [irand ($#art + 1)], $horse;
-			$answer->{misc}->{msg_format} = 1;
+			$reply = sprintf '[%s](%s)', $art [irand ($#art + 1)], Horse ();
 		} else {
 			$reply = Horse ();
 		}
-	} elsif (substr ($m->{message}, 1) eq 'monkeyuser') {
-		$reply = Monkeyuser ();
-	} elsif (substr ($m->{message}, 1) eq 'owl' || substr ($m->{message}, 1) eq 'сова' || substr ($m->{message}, 1) eq 'сыч') {
-		if ($m->{plugin} eq 'telegram') {
-			my $owl = Owl ();
-			$reply = sprintf '[{ O v O }](%s)', $owl;
-			$answer->{misc}->{msg_format} = 1;
+	} elsif ($cmd eq 'monkeyuser') {
+		if (($m->{plugin} eq 'telegram')  &&  $answer->{misc}->{msg_format}) {
+			$reply = sprintf '[monkeyuser](%s)', Monkeyuser ();
+		} else {
+			$reply = Monkeyuser ();
+		}
+	} elsif ($cmd eq 'owl' || $cmd eq 'сова' || $cmd eq 'сыч') {
+		if (($m->{plugin} eq 'telegram')  &&  $answer->{misc}->{msg_format}) {
+			$reply = sprintf '[{ O v O }](%s)', Owl ();
 		} else {
 			$reply = Owl ();
 		}
-	} elsif (substr ($m->{message}, 1) eq 'rabbit' || substr ($m->{message}, 1) eq 'bunny' || substr ($m->{message}, 1) eq 'кролик') {
-		if ($m->{plugin} eq 'telegram') {
-			my $rabbit = Rabbit ();
-			$reply = sprintf '[(\_/)](%s)', $rabbit;
-			$answer->{misc}->{msg_format} = 1;
+	} elsif ($cmd eq 'rabbit' || $cmd eq 'bunny' || $cmd eq 'кролик') {
+		if (($m->{plugin} eq 'telegram')  &&  $answer->{misc}->{msg_format}) {
+			$reply = sprintf '[(\_/)](%s)', Rabbit ();
 		} else {
 			$reply = Rabbit ();
 		}
-	} elsif (substr ($m->{message}, 1) eq 'snail' || substr ($m->{message}, 1) eq 'улитка') {
-		if ($m->{plugin} eq 'telegram') {
+	} elsif ($cmd eq 'snail' || $cmd eq 'улитка') {
+		if (($m->{plugin} eq 'telegram')  &&  $answer->{misc}->{msg_format}) {
 			my @art = qw ('-'_@_ @╜ @_'-');
-			my $snail = Snail ();
-			$reply = sprintf '[%s](%s)', $art [irand ($#art + 1)], $snail;
-			$answer->{misc}->{msg_format} = 1;
+			$reply = sprintf '[%s](%s)', $art [irand ($#art + 1)], Snail ();
 		} else {
 			$reply = Snail ();
 		}
-	} elsif (substr ($m->{message}, 1) eq 'xkcd') {
-		$reply = Xkcd ();
-	} elsif (substr ($m->{message}, 1, 2) eq 'w ' || substr ($m->{message}, 1, 2) eq 'п ') {
-		my $city = substr $m->{message}, 2;
+	} elsif ($cmd eq 'xkcd') {
+		if (($m->{plugin} eq 'telegram')  &&  $answer->{misc}->{msg_format}) {
+			$reply = sprintf '[xkcd](%s)', Xkcd ();
+		} else {
+			$reply = Xkcd ();
+		}
+	} elsif ($cmd =~ /^(w|weather|п|погода|погодка|погадка)\s+(.+)$/gui) {
+		my $city = $2;
 		$reply = Weather ($city);
-	} elsif (substr ($m->{message}, 1, 8) eq 'weather ' || substr ($m->{message}, 1, 8) eq 'погодка ' || substr ($m->{message}, 1, 8) eq 'погадка ') {
-		my $city = substr $m->{message}, 9;
-		$reply = Weather ($city);
-	} elsif (substr ($m->{message}, 1, 7) eq 'погода ') {
-		my $city = substr $m->{message}, 8;
-		$reply = Weather ($city);
-	} elsif (substr ($m->{message}, 1) eq 'tits'    ||
-             substr ($m->{message}, 1) eq 'boobs'   ||
-             substr ($m->{message}, 1) eq 'tities'  ||
-             substr ($m->{message}, 1) eq 'boobies' ||
-             substr ($m->{message}, 1) eq 'сиси'    ||
-             substr ($m->{message}, 1) eq 'сисечки') {
+	} elsif ($cmd eq 'tits'    ||
+             $cmd eq 'boobs'   ||
+             $cmd eq 'tities'  ||
+             $cmd eq 'boobies' ||
+             $cmd eq 'сиси'    ||
+             $cmd eq 'сисечки') {
 		if ($m->{plugin} eq 'telegram') {
 			my @art = ('(. )( .)', '(  . Y .  )', '(o)(o)', '( @ )( @ )', '(.)(.)');
 			my $oboobs = Oboobs ();
@@ -161,11 +199,11 @@ my $parse_message = sub {
 		} else {
 			$reply = Oboobs ();
 		}
-	} elsif (substr ($m->{message}, 1) eq 'butt'  ||
-		     substr ($m->{message}, 1) eq 'booty' ||
-		     substr ($m->{message}, 1) eq 'ass'   ||
-		     substr ($m->{message}, 1) eq 'попа'  ||
-		     substr ($m->{message}, 1) eq 'попка') {
+	} elsif ($cmd eq 'butt'  ||
+		     $cmd eq 'booty' ||
+		     $cmd eq 'ass'   ||
+		     $cmd eq 'попа'  ||
+		     $cmd eq 'попка') {
 		if ($m->{plugin} eq 'telegram') {
 			my @art = ('(__(__)', '(_!_)', '(__.__)');
 			my $obutts = Obutts ();
@@ -183,7 +221,7 @@ my $parse_message = sub {
 		$log->debug ("[DEBUG] Sending message to channel $send_to " . Dumper ($answer));

 		$self->json ($send_to)->notify (
-			$send_to => $answer
+			$send_to => $answer,
 		);
 	}

@@ -194,7 +232,7 @@ my $__signal_handler = sub {
 	my ($self, $name) = @_;
 	$log->info ("[INFO] Caught a signal $name");

-	if (defined $main::pidfile && -f $main::pidfile) {
+	if (defined $main::pidfile && -e $main::pidfile) {
 		unlink $main::pidfile;
 	}

@@ -207,7 +245,7 @@ sub RunWebApp {
 	$log->info ("[INFO] Connecting to $c->{server}, $c->{port}");

 	my $redis = Mojo::Redis->new (
-		sprintf 'redis://%s:%s/1', $c->{server}, $c->{port}
+		sprintf 'redis://%s:%s/1', $c->{server}, $c->{port},
 	);

 	$log->info ('[INFO] Registering connection-event callback');
@@ -224,11 +262,11 @@ sub RunWebApp {
 					my ($conn, $error) = @_;
 					$log->error ("[ERROR] Redis connection error: $error");
 					return;
-				}
+				},
 			);

 			return;
-		}
+		},
 	);

 	my $pubsub = $redis->pubsub;
@@ -239,14 +277,12 @@ sub RunWebApp {
 		$log->debug ("[DEBUG] Subscribing to $channel");

 		$sub->{$channel} = $pubsub->json ($channel)->listen (
-			$channel => sub { $parse_message->(@_); }
+			$channel => sub { $parse_message->(@_); },
 		);
 	}

-	Mojo::IOLoop::Signal->on (
-		TERM => $__signal_handler,
-		INT  => $__signal_handler
-	);
+	Mojo::IOLoop::Signal->on (TERM => $__signal_handler);
+	Mojo::IOLoop::Signal->on (INT  => $__signal_handler);

 	do { Mojo::IOLoop->start } until Mojo::IOLoop->is_running;
 	return;
--- a/lib/WebApp/Client.pm
+++ b/lib/WebApp/Client.pm
@@ -1,6 +1,6 @@
 package WebApp::Client;

-use 5.018;
+use 5.018; ## no critic (ProhibitImplicitImport)
 use strict;
 use warnings;
 use utf8;
@@ -8,19 +8,21 @@ use open qw (:std :utf8);
 use English qw ( -no_match_vars );

 use Carp qw (carp cluck);
-use CHI;
-use CHI::Driver::BerkeleyDB;
-use DateTime;
-use Encode;
-use HTML::TokeParser;
-use JSON::XS;
+use CHI ();
+use CHI::Driver::BerkeleyDB ();
+use DateTime ();
+use Encode qw (decode);
+use File::Spec ();
+use HTML::TokeParser ();
+use JSON::XS ();
 use Log::Any qw ($log);
 use Math::Random::Secure qw (irand);
-use Mojo::UserAgent;
-use Mojo::UserAgent::Cached;
+use Mojo::Log (); # Чтобы заткнуть Mojo::UserAgent::Cached
+use Mojo::UserAgent ();
+use Mojo::UserAgent::Cached ();
 use Mojo::Util qw (trim);
 use POSIX qw (strftime);
-use URI::URL;
+use URI::URL qw (url);

 use Conf qw (LoadConf);
 use WebApp::Client::API::Flickr qw (FlickrByTags);
@@ -29,10 +31,44 @@ use version; our $VERSION = qw (1.0);
 use Exporter qw (import);
 our @EXPORT_OK = qw (Anek Buni Drink Monkeyuser Kitty Fox Oboobs Obutts Rabbit Owl Frog Horse Snail Xkcd Weather);

-my @MONTH = qw (yanvar fevral mart aprel may iyun iyul avgust sentyabr oktyabr noyabr dekabr);
 my $c = LoadConf ();
 my $cachedir = $c->{cachedir};

+my @useragents = _get_ua_list ();
+
+sub _get_ua_list {
+	my $file = $c->{useragentfile};
+	my $file_opened = 1;
+
+	open my $FILEHANDLE, '<', $file || do {
+		carp "[ERROR] No browser useragent list at $file: $OS_ERROR\n";
+		$file_opened = 0;
+	};
+
+	my @ua_list;
+
+	if ($file_opened) {
+		while (my $str = <$FILEHANDLE>) {
+			chomp $str;
+			next unless $str eq '';
+			push @ua_list, $str;
+		}
+
+		close $FILEHANDLE;                                       ## no critic (InputOutput::RequireCheckedSyscalls
+		return @ua_list;
+	}
+
+	if ($#ua_list < 31) {
+		carp "[ERROR] Useragent list in $file have less than 31 enties, discarding it\n";
+		$#ua_list = -1;
+	} elsif ($#ua_list > 31) {
+		carp "[INFO] Useragent list in $file have more than 31 enties, truncating it to 31 entries\n";
+		$#ua_list = 31;
+	}
+
+	return @ua_list;
+}
+
 sub urlencode {
 	my $str = shift;

@@ -53,7 +89,7 @@ sub Anek {
 	for (1..3) {
 		for (1..3) {
 			my $ua  = Mojo::UserAgent->new->connect_timeout (3);
-			$ua->max_redirects(3);
+			$ua->max_redirects (3);
 			$r = $ua->get ('https://www.anekdot.ru/rss/randomu.html')->result;

 			if ($r->is_success) {
@@ -94,7 +130,12 @@ sub Anek {
 						$got_anek = 1;
 					}
 				} else {
-					$log->warn (sprintf '[WARN] anekdot.ru server returns incorrect json, full response text message: %s', $response_text);
+					$log->warn (
+						sprintf (
+							'[WARN] anekdot.ru server returns incorrect json, full response text message: %s',
+							$response_text,
+						),
+					);
 				}
 			} else {
 				$log->warn (sprintf '[WARN] anekdot.ru server returns unexpected response text: %s', $r->body);
@@ -118,7 +159,7 @@ sub Buni {

 	for (1..3) {
 		my $ua  = Mojo::UserAgent->new->connect_timeout (3);
-		$ua->max_redirects(3);
+		$ua->max_redirects (3);
 		$r = $ua->get ('http://www.bunicomic.com/?random&nocache=1')->result;

 		if ($r->is_success) {
@@ -136,10 +177,10 @@ sub Buni {
 		{
 			do {
 				$#a = -1;
-				@a = $p->get_tag('meta'); ## no critic (Variables::RequireLocalizedPunctuationVars)
+				@a = $p->get_tag ('meta'); ## no critic (Variables::RequireLocalizedPunctuationVars)

 				if (defined $a[0][1]->{property} && $a[0][1]->{property} eq 'og:image') {
-					$ret = sprintf '[buni](%s)', $a[0][1]->{content};
+					$ret = $a[0][1]->{content};
 					last;
 				}

@@ -155,8 +196,7 @@ sub Buni {
 sub Drink {
 	my $r;
 	my $ret = 'Не знаю праздников - вджобываю весь день на шахтах, как проклятая.';
-	my ($dayNum, $monthNum) = (localtime ())[3, 4];
-	my $url = sprintf 'https://kakoysegodnyaprazdnik.ru/baza/%s/%s', $MONTH[$monthNum], $dayNum;
+	my $url = 'https://prazdniki-segodnya.ru/';

 	# Those POSIX assholes just forgot to add unix timestamps without TZ offset, so...
 	my ($mday, $mon, $year) = (gmtime ())[3, 4, 5];
@@ -170,12 +210,12 @@ sub Drink {
 	}

 	my $expirationDate = DateTime->new (
-		year => $year + 1900,
-		month => $mon + 1,
-		day => $mday,
-		hour => 0,
+		year   => $year + 1900,
+		month  => $mon + 1,
+		day    => $mday,
+		hour   => 0,
 		minute => 0,
-		second => 0
+		second => 0,
 	)->add (days => 1)->strftime ('%s');

 	if ((substr $offset, 0, 1) eq '+') {
@@ -193,10 +233,18 @@ sub Drink {
 				namespace          => __PACKAGE__,
 				expires_at         => $expirationDate,
 				expires_on_backend => 1,
-			)
+			),
 		);
 		# just to make Mojo::UserAgent::Cached happy
-		$ua->logger (Mojo::Log->new (path => '/dev/null', level => 'error'));
+		$ua->logger (Mojo::Log->new (path => File::Spec->devnull, level => 'error'));
+		my $useragent = 'Mozilla/5.0 (Macintosh; Intel Mac OS X 10_15_7) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/98.0.4758.80 Safari/537.36';
+
+		if ($#useragents > 0) {
+			$useragent = $useragents [ (localtime ()) [3] ];
+		}
+
+		$ua->transactor->name ($useragent);
+
 		$r = $ua->get ($url => {'Accept-Language' => 'ru-RU', 'Accept-Charset' => 'utf-8'})->result;

 		if ($r->is_success) {
@@ -209,28 +257,39 @@ sub Drink {
 	if ($r->is_success) {
 		my $p = HTML::TokeParser->new(\$r->body);
 		my @a;
-		my @holyday;
+		my %holiday;

 		do {
 			$#a = -1;
-			@a = $p->get_tag('span'); ## no critic (Variables::RequireLocalizedPunctuationVars)
+			@a = $p->get_tag ('div'); ## no critic (Variables::RequireLocalizedPunctuationVars)

-			if ($#{$a[0]} > 2 && defined $a[0][1]->{itemprop} && $a[0][1]->{itemprop} eq 'text') {
-				push @holyday,'* ' . decode ('UTF-8', $p->get_trimmed_text ('/span'));
+			if ($#{$a[0]} > 2) {
+				my @shitty_array = $a[0];
+				foreach my $item (@shitty_array) {
+					if (ref $item) {
+						foreach my $item1 (@{$item}) {
+							my %h = eval { %{$item1} };
+
+							if (defined ($h{class}) && $h{class} eq 'list-group-item text-monospace') {
+								$holiday {'* ' . decode ('UTF-8', $p->get_trimmed_text ('/div'))} = 1;
+							}
+						}
+					}
+				}
 			}
-
 		} while ($#{$a[0]} > 1);

-		if ($#holyday > 0) {
-			# cut off something weird, definely not a "holyday"
-			$#holyday = $#holyday - 1;
-		}
-
-		if ($#holyday > 0) {
-			$ret = join "\n", @holyday;
+		if (int (keys (%holiday)) > 0) {
+			$ret = join "\n", sort (keys (%holiday));
 		}
 	} else {
-		$log->warn (sprintf '[WARN] Kakoysegodnyaprazdnik server return status %s with message: %s', $r->code, $r->message);
+		$log->warn (
+			sprintf (
+				'[WARN] prazdniki-segodnya.ru server return status %s with message: %s',
+				$r->code,
+				$r->message,
+			),
+		);
 	}

 	return $ret;
@@ -258,7 +317,7 @@ sub Monkeyuser {

 		do {
 			$#a = -1;
-			@a = $p->get_tag('a'); ## no critic (Variables::RequireLocalizedPunctuationVars)
+			@a = $p->get_tag ('a'); ## no critic (Variables::RequireLocalizedPunctuationVars)

 			if (defined $a[0][1]->{class} && $a[0][1]->{class} eq 'lazyload small-image') {
 				if (defined $a[0][1]->{'data-src'} && ($a[0][1]->{'data-src'} !~ /adlitteram/)) {
@@ -269,7 +328,7 @@ sub Monkeyuser {
 		} while ($#{$a[0]} > 1);

 		if ($#link > 0) {
-			$ret = sprintf '[MonkeyUser](https://www.monkeyuser.com%s)', $link [irand (1 + $#link)];
+			$ret = sprintf '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});
@@ -470,7 +529,7 @@ sub Xkcd {
 	my $ua  = Mojo::UserAgent->new->connect_timeout (5)->max_redirects (0);
 	my $location;
 	my $status = 400;
-	my $c = 0;
+	my $counter = 0;

 	do {
 		my $r = $ua->get ('https://xkcd.ru/random/')->result;
@@ -486,12 +545,12 @@ sub Xkcd {
 			$r = $ua->head ($location)->result;
 		}

-		$c++;
+		$counter++;
 		$status = $r->code;
 	} while ($c < 3 || $status >= 404);

 	if ($status == 200) {
-		return sprintf '[xkcd.ru](%s)', $location;
+		return $location;
 	}

 	return 'Комикс-стрип нарисовать не так-то просто :(';
@@ -514,70 +573,128 @@ sub Weather {
 		$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}
-			);
-		} 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 мм.рт.ст",
-				$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 {
+	# Get coordinates
+	my $g = __weather_geo ($city);
+
+	unless (defined $g) {
 		$reply = "Я не знаю, какая погода в $city";
+	} else {
+		my $w = __weather ($g->{lat}, $g->{lon});
+
+		if ($w) {
+			if ($w->{temperature_min} == $w->{temperature_max}) {
+				if ($c->{openweathermap}->{country}) {
+					$reply = sprintf (
+						"Погода в городе %s, %s:\n%s, ветер %s %s м/c, температура %s°C, ощущается как %s°C, относительная влажность %s%%, давление %s мм.рт.ст",
+						$city,
+						$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, д:%s):\n%s, ветер %s %s м/c, температура %s°C, ощущается как %s°C, относительная влажность %s%%, давление %s мм.рт.ст",
+						$city,
+						$g->{lat},
+						$g->{lon},
+						ucfirst $w->{description},
+						$w->{wind_direction},
+						$w->{wind_speed},
+						$w->{temperature_min},
+						$w->{temperature_feelslike},
+						$w->{humidity},
+						$w->{pressure},
+					);
+				}
+			} elsif ($w->{temperature_min} < 0 && $w->{temperature_max} <= 0) {
+				if ($c->{openweathermap}->{country}) {
+					$reply = sprintf (
+						"Погода в городе %s, %s:\n%s, ветер %s %s м/c, температура от %s до %s°C, ощущается как %s°C, относительная влажность %s%%, давление %s мм.рт.ст",
+						$city,
+						$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, д:%s):\n%s, ветер %s %s м/c, температура от %s до %s°C, ощущается как %s°C, относительная влажность %s%%, давление %s мм.рт.ст",
+						$city,
+						$g->{lat},
+						$g->{lon},
+						ucfirst $w->{description},
+						$w->{wind_direction},
+						$w->{wind_speed},
+						$w->{temperature_max},
+						$w->{temperature_min},
+						$w->{temperature_feelslike},
+						$w->{humidity},
+						$w->{pressure},
+					);
+				}
+			} else {
+				if ($c->{openweathermap}->{country}) {
+					$reply = sprintf (
+						"Погода в городе %s, %s:\n%s, ветер %s %s м/c, температура от %s до %s°C, ощущается как %s°C, относительная влажность %s%%, давление %s мм.рт.ст",
+						$city,
+						$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 = sprintf (
+						"Погода в городе %s, (ш:%s, д:%s):\n%s, ветер %s %s м/c, температура от %s до %s°C, ощущается как %s°C, относительная влажность %s%%, давление %s мм.рт.ст",
+						$city,
+						$g->{lat},
+						$g->{lon},
+						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 $lat  = shift;
+	my $lon  = shift;
+
 	my $appid = $c->{openweathermap}->{appid};
-	my $now = time ();
 	my $fc;
 	my $w;

 	my $r;

-	# try 3 times and giveup
+	# Try 3 times and giveup
 	for (1..3) {
 		my $ua = Mojo::UserAgent::Cached->new;
 		$ua->local_dir ($cachedir);
@@ -588,11 +705,18 @@ sub __weather {
 				namespace          => __PACKAGE__,
 				expires_in         => '3 hours',
 				expires_on_backend => 1,
-			)
+			),
 		);
 		# just to make Mojo::UserAgent::Cached happy
-		$ua->logger (Mojo::Log->new (path => '/dev/null', level => 'error'));
-		$r = $ua->get (sprintf ('http://api.openweathermap.org/data/2.5/weather?q=%s&lang=ru&APPID=%s', $city, $appid))->result;
+		$ua->logger (Mojo::Log->new (path => File::Spec->devnull, level => 'error'));
+		$r = $ua->get (
+			sprintf (
+				'http://api.openweathermap.org/data/2.5/weather?lat=%s&lon=%s&lang=ru&APPID=%s',
+				$lat,
+				$lon,
+				$appid,
+			),
+		)->result;

 		if ($r->is_success) {
 			last;
@@ -610,26 +734,26 @@ sub __weather {
 		unless ($fc) {
 			$log->warn ("[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);
 		return undef;
 	}

 	# TODO: check all of this for existence
-	$w->{'name'} = $fc->{name};
-	$w->{'state'} = $fc->{state};
-	$w->{'country'} = $fc->{sys}->{country};
-	$w->{'longitude'} = $fc->{coord}->{lon};
-	$w->{'latitude'} = $fc->{coord}->{lat};
-	$w->{'temperature_min'} = int ($fc->{main}->{temp_min} - 273.15);
-	$w->{'temperature_max'} = int ($fc->{main}->{temp_max} - 273.15);
+	$w->{'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'} = 'разный';
+	$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) {
@@ -671,6 +795,77 @@ sub __weather {
 	return $w;
 }

+sub __weather_geo {
+	my $city = shift;
+	$city = urlencode $city;
+	my $appid = $c->{openweathermap}->{appid};
+	my $geo;
+
+	my $r;
+
+	# Try 3 times and giveup
+	for (1..3) {
+		my $ua = Mojo::UserAgent::Cached->new;
+		$ua->local_dir ($cachedir);
+		$ua->cache_agent (
+			CHI->new (
+				driver             => 'BerkeleyDB',
+				root_dir           => $cachedir,
+				namespace          => __PACKAGE__,
+				expires_in         => '2 months',
+				expires_on_backend => 1,
+			),
+		);
+		# Just to make Mojo::UserAgent::Cached happy
+		$ua->logger (Mojo::Log->new (path => File::Spec->devnull, level => 'error'));
+
+		$r = $ua->get (
+			sprintf (
+				'http://api.openweathermap.org/geo/1.0/direct?q=%s&limit=1&APPID=%s',
+				$city,
+				$appid,
+			),
+		)->result;
+
+		if ($r->is_success) {
+			last;
+		}
+
+		sleep 2;
+	}
+
+	# All 3 times it can give us error, so check this case here
+	if ($r->is_success) {
+		$geo = eval {
+			return $r->json;
+		};
+
+		unless ($geo) {
+			$log->warn ("[WARN] openweathermap geo api returns corrupted json: $EVAL_ERROR");
+			return;
+		}
+	} else {
+		$log->warn (
+			sprintf (
+				'[WARN] Server api.openweathermap.org return status %s with message: %s in request to geo',
+				$r->code,
+				$r->message,
+			),
+		);
+
+		return;
+	}
+
+	if (defined ($geo->[0]->{lat}) && defined ($geo->[0]->{lon})) {
+		# Success
+		return $geo->[0];
+	} else {
+		# Error, no coordinates
+		$log->warn ('[WARN] Server api.openweathermap.org does not return coordinates in response to geo request');
+		return;
+	}
+}
+
 1;

 # vim: set ft=perl noet ai ts=4 sw=4 sts=4:
--- a/lib/WebApp/Client/API/Flickr.pm
+++ b/lib/WebApp/Client/API/Flickr.pm
@@ -1,24 +1,23 @@
 package WebApp::Client::API::Flickr;

-use 5.018;
+use 5.018; ## no critic (ProhibitImplicitImport)
 use strict;
 use warnings;
 use utf8;
 use open qw (:std :utf8);
 use English qw ( -no_match_vars );
-use Carp qw (cluck);
-use CHI;
-use CHI::Driver::BerkeleyDB;
-use Digest::HMAC_SHA1 qw (hmac_sha1);
+use CHI ();
+use CHI::Driver::BerkeleyDB ();
+use Digest::HMAC_SHA1 ();
 use Log::Any qw ($log);
 use Math::Random::Secure qw (irand);
-use MIME::Base64;
-use Mojo::UserAgent;
+use MIME::Base64 qw (encode_base64);
+use Mojo::UserAgent ();
 use URI::Encode::XS qw (uri_encode);

 use Conf qw (LoadConf);

-use Data::Dumper;
+use Data::Dumper qw (Dumper);

 use version; our $VERSION = qw (1.0);
 use Exporter qw (import);
@@ -107,7 +106,7 @@ sub flickrRequestToken {
 	my $oauth_signature = flickerSignReq (
 		type => 'request_token',
 		oauth_timestamp => $oauth_timestamp,
-		oauth_nonce => $oauth_nonce
+		oauth_nonce => $oauth_nonce,
 	);

 	my $url = $flickr_request_token_url . sprintf (
@@ -116,7 +115,7 @@ sub flickrRequestToken {
 		$oauth_timestamp,
 		$flickr_consumer_key,
 		uri_encode ($oauth_signature),
-		uri_encode ($flickr_callback_url)
+		uri_encode ($flickr_callback_url),
 	);

 	my $ua = Mojo::UserAgent->new->connect_timeout (5);
@@ -147,7 +146,7 @@ sub flickrAccessToken {
 		oauth_nonce => $oauth_nonce,
 		oauth_token => $flickr_request_token,
 		oauth_token_secret => $flickr_request_token_secret,
-		oauth_verifier => $flickr_verifier
+		oauth_verifier => $flickr_verifier,
 	);

 	my $url = $flickr_access_token_url . sprintf (
@@ -157,7 +156,7 @@ sub flickrAccessToken {
 		$flickr_verifier,
 		$flickr_consumer_key,
 		$flickr_request_token,
-		uri_encode ($oauth_signature)
+		uri_encode ($oauth_signature),
 	);

 	my $ua  = Mojo::UserAgent->new->connect_timeout (5);
@@ -211,7 +210,7 @@ sub flickrTestLogin {
 		oauth_token => $flickr_access_token,
 		oauth_token_secret => $flickr_access_token_secret,
 		oauth_signature_method => 'HMAC-SHA1',
-		oauth_version => '1.0'
+		oauth_version => '1.0',
 	);

 	my $url = $flickr_api_url . sprintf (
@@ -220,7 +219,7 @@ sub flickrTestLogin {
 		$flickr_consumer_key,
 		$oauth_timestamp,
 		$flickr_access_token,
-		uri_encode ($oauth_signature)
+		uri_encode ($oauth_signature),
 	);

 	my $ua = Mojo::UserAgent->new->connect_timeout (5);
@@ -267,7 +266,7 @@ sub flickrSearchByText {
 		oauth_token => $flickr_access_token,
 		oauth_token_secret => $flickr_access_token_secret,
 		oauth_signature_method => 'HMAC-SHA1',
-		oauth_version => '1.0'
+		oauth_version => '1.0',
 	);

 	my $url = $flickr_api_url . sprintf (
@@ -277,7 +276,7 @@ sub flickrSearchByText {
 		$oauth_timestamp,
 		$flickr_access_token,
 		uri_encode ($oauth_signature),
-		uri_encode ($text)
+		uri_encode ($text),
 	);

 	my $ua = Mojo::UserAgent->new->connect_timeout (5);
@@ -309,7 +308,7 @@ sub flickrSearchByText {
 				oauth_token => $flickr_access_token,
 				oauth_token_secret => $flickr_access_token_secret,
 				oauth_signature_method => 'HMAC-SHA1',
-				oauth_version => '1.0'
+				oauth_version => '1.0',
 			);

 			$url = $flickr_api_url . sprintf (
@@ -320,7 +319,7 @@ sub flickrSearchByText {
 				$flickr_access_token,
 				uri_encode ($oauth_signature),
 				$page,
-				uri_encode ($text)
+				uri_encode ($text),
 			);

 			$ua = Mojo::UserAgent->new->connect_timeout (5);
@@ -375,7 +374,7 @@ sub flickrSearchByTags {
 		oauth_token => $flickr_access_token,
 		oauth_token_secret => $flickr_access_token_secret,
 		oauth_signature_method => 'HMAC-SHA1',
-		oauth_version => '1.0'
+		oauth_version => '1.0',
 	);

 	my $url = $flickr_api_url . sprintf (
@@ -385,7 +384,7 @@ sub flickrSearchByTags {
 		$oauth_timestamp,
 		$flickr_access_token,
 		uri_encode ($oauth_signature),
-		uri_encode ($tags)
+		uri_encode ($tags),
 	);

 	my $ua = Mojo::UserAgent->new->connect_timeout (5);
@@ -417,7 +416,7 @@ sub flickrSearchByTags {
 				oauth_token => $flickr_access_token,
 				oauth_token_secret => $flickr_access_token_secret,
 				oauth_signature_method => 'HMAC-SHA1',
-				oauth_version => '1.0'
+				oauth_version => '1.0',
 			);

 			$url = $flickr_api_url . sprintf (
@@ -428,7 +427,7 @@ sub flickrSearchByTags {
 				$flickr_access_token,
 				uri_encode ($oauth_signature),
 				$page,
-				uri_encode ($tags)
+				uri_encode ($tags),
 			);

 			$ua = Mojo::UserAgent->new->connect_timeout (5);
@@ -463,7 +462,7 @@ sub FlickrInit {
 	my $cache = CHI->new (
 		driver => 'BerkeleyDB',
 		root_dir => $cachedir,
-		namespace => __PACKAGE__
+		namespace => __PACKAGE__,
 	);

 	if (defined $flickr_verifier && $flickr_verifier) {
@@ -516,7 +515,7 @@ sub FlickrTestLogin {
 	my $cache = CHI->new (
 		driver => 'BerkeleyDB',
 		root_dir => $cachedir,
-		namespace => __PACKAGE__
+		namespace => __PACKAGE__,
 	);

 	my $flickr_access_token = $cache->get ('flickr_access_token');
@@ -535,7 +534,7 @@ sub FlickrByTags {
 	my $cache = CHI->new (
 		driver => 'BerkeleyDB',
 		root_dir => $cachedir,
-		namespace => __PACKAGE__
+		namespace => __PACKAGE__,
 	);

 	my $flickr_access_token = $cache->get ('flickr_access_token');
@@ -568,7 +567,7 @@ sub FlickrByText {
 	my $cache = CHI->new (
 		driver => 'BerkeleyDB',
 		root_dir => $cachedir,
-		namespace => __PACKAGE__
+		namespace => __PACKAGE__,
 	);

 	my $flickr_access_token = $cache->get ('flickr_access_token');
Author	SHA1	Message	Date
eleksir	657090b5f7	Fix inconsistence of city name pick decision introduced in `fa59102`	2023-05-07 18:57:15 +03:00
eleksir	a0fd6faafc	Introduce option country in config to use either country code or coordinates as secondary id for city. Looks like openweathermap.org gives incorrect or mangled coutry codes for some cities for whatever reasons. So we have to introduce this option in order to cool-down irritation of some engaging users.	2023-05-07 16:22:33 +03:00
eleksir	fa5910218e	Use dedicated geo api instead of builtin for openweathermap api	2023-05-04 13:29:38 +03:00
eleksir	079ea8098e	Mute perlcritic complains about long regexp	2023-05-04 13:25:47 +03:00
eleksir	8aea873746	Bump pinned versions in cpanfile, again	2023-05-04 11:12:32 +03:00
eleksir	77435364e8	Bump pinned versions in cpanfile	2023-02-04 15:37:40 +03:00
eleksir	d3c2857af8	In README add fix for annoying error on macos	2023-02-04 15:36:57 +03:00
eleksir	5c23f41229	Remove unused variables	2023-02-04 15:15:19 +03:00
eleksir	f25a4d9ea3	Fix redis message processing, duh	2022-06-21 23:14:01 +03:00
eleksir	3d6be5ae04	Fix !drink for newer perl, also delete unused/obsolete code	2022-06-21 23:00:37 +03:00
eleksir	4c6a1ea4cd	Bump version of Mojolicious 9.24 -> 9.26	2022-06-21 22:58:21 +03:00
eleksir	a891c7ed6f	Fix !drink command, kind of	2022-05-25 20:40:14 +03:00
eleksir	0daaa6f568	Update cpanfile: bump Mojolicious version 9.22 -> 9.24, drop Protocol::Redis::XS	2022-04-24 02:06:44 +03:00
eleksir	209c9f1ad7	Use less substrs, more deeply tidy incoming json data	2022-04-18 17:24:14 +03:00
eleksir	44a22a3382	Fix a bit code formatting in Client.pm	2022-04-18 17:22:56 +03:00
eleksir	b6a4aaa4c1	Fix handling formating for telegram	2022-04-17 17:09:53 +03:00
eleksir	6b78eb7c1f	Add some perlcritic pilicies	2022-04-04 23:05:49 +03:00
eleksir	b9af01728d	Fix mistake in exported Conf module name	2022-02-19 16:09:11 +03:00
eleksir	0e9159be0d	Update README	2022-02-19 15:48:44 +03:00
eleksir	f13b7d78ed	Remove TODO	2022-02-19 15:46:10 +03:00
eleksir	f96e74725d	More critic!	2022-02-19 15:44:50 +03:00
eleksir	6b115a63e4	Use 1 of 31 ua-strings for !drink, fix/update README	2022-02-08 20:49:12 +03:00