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
6 changed files with 239 additions and 82 deletions
--- a/.perlcriticrc
+++ b/.perlcriticrc
@@ -132,3 +132,5 @@ lib_sections    = NAME | VERSION | DESCRIPTION | AUTHOR | LICENSE AND COPYRIGHT

 [-TooMuchCode::ProhibitLargeBlock]
 # read my lips: fuck off
+
+[-RegularExpressions::ProhibitComplexRegexes]
--- a/7
+++ b/7
@@ -72,3 +72,10 @@ 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/bin/aleesa-webapp
+++ b/bin/aleesa-webapp
@@ -43,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 ();
--- a/30
+++ b/30
@@ -2,34 +2,36 @@
 requires 'Carp',                    '==1.50';
 requires 'CHI',                     '==0.61';
 requires 'CHI::Driver::BerkeleyDB', '==0.05';
-requires 'Clone',                   '==0.45';
+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',          '==2.85';
+requires 'File::Basename',          '0';
 requires 'File::Path',              '==2.18';
 requires 'File::Spec',              '==3.75';
-requires 'HTML::TokeParser',        '==3.76';
-requires 'IO::Socket::SSL',         '==2.073';
-requires 'JSON',                    '==4.04';
+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.26';
+requires 'Mojolicious',             '==9.31';
 requires 'Mojo::IOLoop::Signal',    '==0.003';
 # Чтобы заткнуть Mojo::UserAgent::Cached
 requires 'Mojo::Log',               '0';
-requires 'Mojo::Redis',             '==3.27';
+requires 'Mojo::Redis',             '==3.29';
 requires 'Mojo::UserAgent',         '0';
-requires 'Mojo::UserAgent::Cached', '==1.18';
+requires 'Mojo::UserAgent::Cached', '==1.25';
 requires 'POSIX',                   '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/lib/WebApp/Client.pm
+++ b/lib/WebApp/Client.pm
@@ -31,7 +31,6 @@ 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};

@@ -131,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);
@@ -192,7 +196,6 @@ sub Buni {
 sub Drink {
 	my $r;
 	my $ret = 'Не знаю праздников - вджобываю весь день на шахтах, как проклятая.';
-	my ($dayNum, $monthNum) = (localtime ())[3, 4];
 	my $url = 'https://prazdniki-segodnya.ru/';

 	# Those POSIX assholes just forgot to add unix timestamps without TZ offset, so...
@@ -280,7 +283,13 @@ sub Drink {
 			$ret = join "\n", sort (keys (%holiday));
 		}
 	} else {
-		$log->warn (sprintf '[WARN] prazdniki-segodnya.ru 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;
@@ -564,14 +573,22 @@ sub Weather {
 		$city = 'Екатеринбург';
 	}

-	my $w = __weather ($city);
 	my $reply;

+	# 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 мм.рт.ст",
-				$w->{name},
+						$city,
 						$w->{country},
 						ucfirst $w->{description},
 						$w->{wind_direction},
@@ -581,10 +598,26 @@ sub Weather {
 						$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 мм.рт.ст",
-				$w->{name},
+						$city,
 						$w->{country},
 						ucfirst $w->{description},
 						$w->{wind_direction},
@@ -596,9 +629,26 @@ sub Weather {
 						$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 мм.рт.ст",
-				$w->{name},
+						$city,
 						$w->{country},
 						ucfirst $w->{description},
 						$w->{wind_direction},
@@ -609,25 +659,42 @@ sub Weather {
 						$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);
@@ -642,7 +709,14 @@ sub __weather {
 		);
 		# 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/data/2.5/weather?q=%s&lang=ru&APPID=%s', $city, $appid))->result;
+		$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;
@@ -721,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:
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