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.
872 lines
22 KiB
Perl
872 lines
22 KiB
Perl
package WebApp::Client;
|
|
|
|
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 (carp cluck);
|
|
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::Log (); # Чтобы заткнуть Mojo::UserAgent::Cached
|
|
use Mojo::UserAgent ();
|
|
use Mojo::UserAgent::Cached ();
|
|
use Mojo::Util qw (trim);
|
|
use POSIX qw (strftime);
|
|
use URI::URL qw (url);
|
|
|
|
use Conf qw (LoadConf);
|
|
use WebApp::Client::API::Flickr qw (FlickrByTags);
|
|
|
|
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 $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;
|
|
|
|
unless (defined $str) {
|
|
cluck '[ERROR] Str is undefined';
|
|
return '';
|
|
}
|
|
|
|
my $urlobj = url $str;
|
|
return $urlobj->as_string;
|
|
}
|
|
|
|
sub Anek {
|
|
my $r;
|
|
my $ret = 'Все рассказчики анекдотов отдыхают';
|
|
my $got_anek = 0;
|
|
|
|
for (1..3) {
|
|
for (1..3) {
|
|
my $ua = Mojo::UserAgent->new->connect_timeout (3);
|
|
$ua->max_redirects (3);
|
|
$r = $ua->get ('https://www.anekdot.ru/rss/randomu.html')->result;
|
|
|
|
if ($r->is_success) {
|
|
last;
|
|
}
|
|
|
|
sleep 2;
|
|
}
|
|
|
|
if ($r->is_success) {
|
|
my $json;
|
|
my $response_text = decode ('UTF-8', $r->body);
|
|
my @text = split /\n/, $response_text;
|
|
|
|
while (my $str = pop @text) {
|
|
if ($str =~ /^var anekdot_texts \= JSON/) {
|
|
$str = (split /JSON\.parse\(\'/, $str, 2)[1];
|
|
|
|
if (defined $str && length ($str) > 10) {
|
|
$json = (split /\';\)/, $str, 2)[0];
|
|
last;
|
|
}
|
|
}
|
|
}
|
|
|
|
if (defined $json && length ($json) > 10) {
|
|
$json =~ s/\\"/"/g;
|
|
$json =~ s/\\\\"/\\"/g;
|
|
$json = substr $json, 0, -3;
|
|
|
|
my $anek = eval { ${JSON::XS->new->relaxed->decode ($json)}[0] };
|
|
|
|
if (defined $anek) {
|
|
my @anek = split /<br>/, $anek;
|
|
$ret = join "\n", @anek;
|
|
|
|
if (length ($ret) > 1) {
|
|
$got_anek = 1;
|
|
}
|
|
} else {
|
|
$log->warn (
|
|
sprintf (
|
|
'[WARN] anekdot.ru server returns incorrect json, full response text message: %s',
|
|
$response_text,
|
|
),
|
|
);
|
|
}
|
|
} else {
|
|
$log->warn (sprintf '[WARN] anekdot.ru server returns unexpected response text: %s', $r->body);
|
|
}
|
|
|
|
} else {
|
|
$log->warn (sprintf '[WARN] anekdot.ru server return status %s with message: %s', $r->code, $r->message);
|
|
}
|
|
|
|
if ($got_anek) {
|
|
last;
|
|
}
|
|
}
|
|
|
|
return $ret;
|
|
}
|
|
|
|
sub Buni {
|
|
my $r;
|
|
my $ret = 'Нету Buni';
|
|
|
|
for (1..3) {
|
|
my $ua = Mojo::UserAgent->new->connect_timeout (3);
|
|
$ua->max_redirects (3);
|
|
$r = $ua->get ('http://www.bunicomic.com/?random&nocache=1')->result;
|
|
|
|
if ($r->is_success) {
|
|
last;
|
|
}
|
|
|
|
sleep 2;
|
|
}
|
|
|
|
if ($r->is_success) {
|
|
my $p = HTML::TokeParser->new(\$r->body);
|
|
my @a;
|
|
|
|
# additional {} required in order "last" to work properly :)
|
|
{
|
|
do {
|
|
$#a = -1;
|
|
@a = $p->get_tag ('meta'); ## no critic (Variables::RequireLocalizedPunctuationVars)
|
|
|
|
if (defined $a[0][1]->{property} && $a[0][1]->{property} eq 'og:image') {
|
|
$ret = $a[0][1]->{content};
|
|
last;
|
|
}
|
|
|
|
} while ($#{$a[0]} > 1);
|
|
}
|
|
} else {
|
|
$log->warn (sprintf '[WARN] Bunicomic server return status %s with message: %s', $r->code, $r->message);
|
|
}
|
|
|
|
return $ret;
|
|
}
|
|
|
|
sub Drink {
|
|
my $r;
|
|
my $ret = 'Не знаю праздников - вджобываю весь день на шахтах, как проклятая.';
|
|
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];
|
|
my $offset = strftime ('%z', gmtime ());
|
|
my $offsetMinutes = (substr $offset, -2) * 60;
|
|
my $offsetHours = (substr $offset, 1, 2) * 60 * 60;
|
|
my $offsetSign;
|
|
|
|
if ((substr $offset, 0, 1) eq '+') {
|
|
$offsetSign = 1;
|
|
}
|
|
|
|
my $expirationDate = DateTime->new (
|
|
year => $year + 1900,
|
|
month => $mon + 1,
|
|
day => $mday,
|
|
hour => 0,
|
|
minute => 0,
|
|
second => 0,
|
|
)->add (days => 1)->strftime ('%s');
|
|
|
|
if ((substr $offset, 0, 1) eq '+') {
|
|
$expirationDate = $expirationDate - $offsetHours - $offsetMinutes;
|
|
} else {
|
|
$expirationDate = $expirationDate + $offsetHours + $offsetMinutes;
|
|
}
|
|
|
|
for (1..3) {
|
|
my $ua = Mojo::UserAgent::Cached->new->connect_timeout (3);
|
|
$ua->cache_agent(
|
|
CHI->new (
|
|
driver => 'BerkeleyDB',
|
|
root_dir => $cachedir,
|
|
namespace => __PACKAGE__,
|
|
expires_at => $expirationDate,
|
|
expires_on_backend => 1,
|
|
),
|
|
);
|
|
# just to make Mojo::UserAgent::Cached happy
|
|
$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) {
|
|
last;
|
|
}
|
|
|
|
sleep 2;
|
|
}
|
|
|
|
if ($r->is_success) {
|
|
my $p = HTML::TokeParser->new(\$r->body);
|
|
my @a;
|
|
my %holiday;
|
|
|
|
do {
|
|
$#a = -1;
|
|
@a = $p->get_tag ('div'); ## no critic (Variables::RequireLocalizedPunctuationVars)
|
|
|
|
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 (int (keys (%holiday)) > 0) {
|
|
$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,
|
|
),
|
|
);
|
|
}
|
|
|
|
return $ret;
|
|
}
|
|
|
|
sub Monkeyuser {
|
|
my $r;
|
|
my $ret = 'Нету Monkey User-ов, они все спрятались.';
|
|
my @link;
|
|
|
|
for (1..3) {
|
|
my $ua = Mojo::UserAgent->new->connect_timeout (3);
|
|
$r = $ua->get ('https://www.monkeyuser.com/toc/')->result;
|
|
|
|
if ($r->is_success) {
|
|
last;
|
|
}
|
|
|
|
sleep 2;
|
|
}
|
|
|
|
if ($r->is_success) {
|
|
my $p = HTML::TokeParser->new(\$r->body);
|
|
my @a;
|
|
|
|
do {
|
|
$#a = -1;
|
|
@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/)) {
|
|
push @link, $a[0][1]->{'data-src'};
|
|
}
|
|
}
|
|
|
|
} while ($#{$a[0]} > 1);
|
|
|
|
if ($#link > 0) {
|
|
$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});
|
|
}
|
|
|
|
return $ret;
|
|
}
|
|
|
|
sub Kitty {
|
|
my $r;
|
|
my $ret = 'Нету кошечек, все разбежались.';
|
|
|
|
for (1..3) {
|
|
my $ua = Mojo::UserAgent->new->connect_timeout (3);
|
|
$r = $ua->get ('https://api.thecatapi.com/v1/images/search')->result;
|
|
|
|
if ($r->is_success) {
|
|
last;
|
|
}
|
|
|
|
sleep 2;
|
|
}
|
|
|
|
if ($r->is_success) {
|
|
my $jcat = eval {
|
|
return $r->json;
|
|
};
|
|
|
|
unless (defined $jcat) {
|
|
$log->warn ("[WARN] Unable to decode JSON from thecatapi: $EVAL_ERROR");
|
|
} else {
|
|
if ($jcat->[0]->{url}) {
|
|
$ret = $jcat->[0]->{url};
|
|
}
|
|
}
|
|
} else {
|
|
$log->warn (sprintf '[WARN] Thecatapi server return status %s with message: %s', $r->code, $r->message);
|
|
}
|
|
|
|
return $ret;
|
|
}
|
|
|
|
sub Fox {
|
|
my $r;
|
|
my $ret = 'Нету лисичек, все разбежались.';
|
|
|
|
for (1..3) {
|
|
my $ua = Mojo::UserAgent->new->connect_timeout (3);
|
|
$r = $ua->get ('https://randomfox.ca/floof/')->result;
|
|
|
|
if ($r->is_success) {
|
|
last;
|
|
}
|
|
|
|
sleep 2;
|
|
}
|
|
|
|
if ($r->is_success) {
|
|
my $jfox = eval {
|
|
return $r->json;
|
|
};
|
|
|
|
unless (defined $jfox) {
|
|
$log->warn ("[WARN] Unable to decode JSON from randomfox: $EVAL_ERROR");
|
|
} else {
|
|
if ($jfox->{image}) {
|
|
$jfox->{image} =~ s/\\//xmsg;
|
|
$ret = $jfox->{image};
|
|
}
|
|
}
|
|
} else {
|
|
$log->warn (sprintf '[WARN] Randomfox server return status %s with message: %s', $r->code, $r->message);
|
|
}
|
|
|
|
return $ret;
|
|
}
|
|
|
|
sub Oboobs {
|
|
my $r;
|
|
my $ret = 'Нету cисичек, все разбежались.';
|
|
|
|
for (1..3) {
|
|
my $ua = Mojo::UserAgent->new->connect_timeout (3);
|
|
$r = $ua->get ('http://api.oboobs.ru/boobs/0/1/random')->result;
|
|
|
|
if ($r->is_success) {
|
|
last;
|
|
}
|
|
|
|
sleep 2;
|
|
}
|
|
|
|
if ($r->is_success) {
|
|
my $joboobs = eval {
|
|
return $r->json;
|
|
};
|
|
|
|
unless (defined $joboobs) {
|
|
$log->warn ("[WARN] Unable to decode JSON from oboobs: $EVAL_ERROR");
|
|
} else {
|
|
if ($joboobs->[0]->{preview}) {
|
|
$ret = sprintf 'https://media.oboobs.ru/%s', $joboobs->[0]->{preview};
|
|
}
|
|
}
|
|
} else {
|
|
$log->warn (sprintf '[WARN] Oboobs server return status %s with message: %s', $r->code, $r->message);
|
|
}
|
|
|
|
return $ret;
|
|
}
|
|
|
|
sub Obutts {
|
|
my $r;
|
|
my $ret = 'Нету попок, все разбежались.';
|
|
|
|
for (1..3) {
|
|
my $ua = Mojo::UserAgent->new->connect_timeout (3);
|
|
$r = $ua->get ('http://api.obutts.ru/butts/0/1/random')->result;
|
|
|
|
if ($r->is_success) {
|
|
last;
|
|
}
|
|
|
|
sleep 2;
|
|
}
|
|
|
|
if ($r->is_success) {
|
|
my $jobutts = eval {
|
|
return $r->json;
|
|
};
|
|
|
|
unless (defined $jobutts) {
|
|
$log->warn ("[ERROR] Unable to decode JSON from obutts: $EVAL_ERROR");
|
|
} else {
|
|
if ($jobutts->[0]->{preview}) {
|
|
$ret = sprintf 'http://media.obutts.ru/%s', $jobutts->[0]->{preview};
|
|
}
|
|
}
|
|
} else {
|
|
$log->warn (sprintf '[WARN] Obutts server return status %s with message: %s', $r->code, $r->message);
|
|
}
|
|
|
|
return $ret;
|
|
}
|
|
|
|
sub Rabbit {
|
|
# rabbit, but bunny
|
|
my $url = FlickrByTags ('animal,bunny');
|
|
|
|
if (defined $url) {
|
|
return $url;
|
|
} else {
|
|
return 'Нету кроликов, все разбежались.';
|
|
}
|
|
}
|
|
|
|
sub Owl {
|
|
my $url = FlickrByTags ('bird,owl');
|
|
|
|
if (defined $url) {
|
|
return $url;
|
|
} else {
|
|
return 'Нету сов, все разлетелись.';
|
|
}
|
|
}
|
|
|
|
sub Frog {
|
|
my $url = FlickrByTags ('frog,toad,amphibian');
|
|
|
|
if (defined $url) {
|
|
return $url;
|
|
} else {
|
|
return 'Нету лягушек, все свалили.';
|
|
}
|
|
}
|
|
|
|
sub Horse {
|
|
my $url = FlickrByTags ('horse,equine,mammal');
|
|
|
|
if (defined $url) {
|
|
return $url;
|
|
} else {
|
|
return 'Нету коняшек, все разбежались.';
|
|
}
|
|
}
|
|
|
|
sub Snail {
|
|
my $url = FlickrByTags ('snail,slug');
|
|
|
|
if (defined $url) {
|
|
return $url;
|
|
} else {
|
|
return 'Нету улиток, все расползлись.';
|
|
}
|
|
}
|
|
|
|
sub Xkcd {
|
|
my $ua = Mojo::UserAgent->new->connect_timeout (5)->max_redirects (0);
|
|
my $location;
|
|
my $status = 400;
|
|
my $counter = 0;
|
|
|
|
do {
|
|
my $r = $ua->get ('https://xkcd.ru/random/')->result;
|
|
|
|
if (
|
|
defined $r->content &&
|
|
defined $r->content->headers &&
|
|
defined $r->content->headers->location &&
|
|
$r->content->headers->location ne ''
|
|
) {
|
|
$location = substr $r->content->headers->location, 1, -1;
|
|
$location = sprintf 'https://xkcd.ru/i/%s_v1.png', $location;
|
|
$r = $ua->head ($location)->result;
|
|
}
|
|
|
|
$counter++;
|
|
$status = $r->code;
|
|
} while ($c < 3 || $status >= 404);
|
|
|
|
if ($status == 200) {
|
|
return $location;
|
|
}
|
|
|
|
return 'Комикс-стрип нарисовать не так-то просто :(';
|
|
}
|
|
|
|
sub Weather {
|
|
my $city = shift;
|
|
$city = trim $city;
|
|
|
|
return 'Мне нужно ИМЯ города.' if ($city eq '');
|
|
return 'Длинновато для названия города.' if (length ($city) > 80);
|
|
|
|
$city = ucfirst $city;
|
|
|
|
if ($city eq 'Мск' || $city eq 'Default' || $city eq 'Dc' || $city eq 'Msk' || $city eq 'Dc-universe') {
|
|
$city = 'Москва';
|
|
} elsif ($city eq 'Спб' || $city eq 'Spb') {
|
|
$city = 'Санкт-Петербург';
|
|
} elsif ($city eq 'Ект' || $city eq 'Ебург' || $city eq 'Ёбург' || $city eq 'Екат' || $city eq 'Ekt' || $city eq 'Eburg' || $city eq 'Ekat') {
|
|
$city = 'Екатеринбург';
|
|
}
|
|
|
|
my $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 мм.рт.ст",
|
|
$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 мм.рт.ст",
|
|
$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, д:%s):\n%s, ветер %s %s м/c, температура от %s до %s°C, ощущается как %s°C, относительная влажность %s%%, давление %s мм.рт.ст",
|
|
$w->{name},
|
|
$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},
|
|
$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 мм.рт.ст",
|
|
$w->{name},
|
|
$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 $lat = shift;
|
|
my $lon = shift;
|
|
|
|
my $appid = $c->{openweathermap}->{appid};
|
|
my $fc;
|
|
my $w;
|
|
|
|
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 => '3 hours',
|
|
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/data/2.5/weather?lat=%s&lon=%s&lang=ru&APPID=%s',
|
|
$lat,
|
|
$lon,
|
|
$appid,
|
|
),
|
|
)->result;
|
|
|
|
if ($r->is_success) {
|
|
last;
|
|
}
|
|
|
|
sleep 2;
|
|
}
|
|
|
|
# all 3 times can give error, so check it here
|
|
if ($r->is_success) {
|
|
$fc = eval {
|
|
return $r->json;
|
|
};
|
|
|
|
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->{'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;
|
|
}
|
|
|
|
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:
|