15 Commits
v1.4 ... master

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
7 changed files with 349 additions and 148 deletions

View File

@@ -132,3 +132,5 @@ lib_sections = NAME | VERSION | DESCRIPTION | AUTHOR | LICENSE AND COPYRIGHT
[-TooMuchCode::ProhibitLargeBlock] [-TooMuchCode::ProhibitLargeBlock]
# read my lips: fuck off # read my lips: fuck off
[-RegularExpressions::ProhibitComplexRegexes]

7
README
View File

@@ -72,3 +72,10 @@ service aleesa-webapp start
в автозагрузку его можно прописать через команду: в автозагрузку его можно прописать через команду:
rc-update add aleesa-webapp default 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

View File

@@ -43,7 +43,6 @@ sub __fork;
sub __signal_handler; sub __signal_handler;
local $OUTPUT_AUTOFLUSH = 1; local $OUTPUT_AUTOFLUSH = 1;
my $runAsUid = $UID;
my $piddir = '/var/run/' . basename (abs_path $PROGRAM_NAME); my $piddir = '/var/run/' . basename (abs_path $PROGRAM_NAME);
my $C = LoadConf (); my $C = LoadConf ();

View File

@@ -2,34 +2,36 @@
requires 'Carp', '==1.50'; requires 'Carp', '==1.50';
requires 'CHI', '==0.61'; requires 'CHI', '==0.61';
requires 'CHI::Driver::BerkeleyDB', '==0.05'; requires 'CHI::Driver::BerkeleyDB', '==0.05';
requires 'Clone', '==0.46';
requires 'Cwd', '==3.75'; requires 'Cwd', '==3.75';
requires 'Cwd::utf8', '==0.011'; requires 'Cwd::utf8', '==0.011';
requires 'DateTime', '==1.55'; requires 'DateTime', '==1.59';
requires 'Digest::HMAC_SHA1', '==1.04'; requires 'Digest::HMAC_SHA1', '==1.04';
requires 'Encode', '==3.16'; requires 'Encode', '==3.19';
requires 'English', '0'; requires 'English', '0';
requires 'EV', '==4.33'; requires 'EV', '==4.33';
requires 'File::Basename', '==2.85'; requires 'File::Basename', '0';
requires 'File::Path', '==2.18'; requires 'File::Path', '==2.18';
requires 'File::Spec', '==3.75'; requires 'File::Spec', '==3.75';
requires 'HTML::TokeParser', '==3.76'; requires 'HTML::TokeParser', '==3.81';
requires 'IO::Socket::SSL', '==2.073'; requires 'IO::Socket::SSL', '==2.081';
requires 'JSON', '==4.04'; requires 'JSON', '==4.10';
requires 'JSON::XS', '==4.03'; requires 'JSON::XS', '==4.03';
requires 'local::lib', '==2.000028'; requires 'local::lib', '==2.000029';
requires 'Log::Any', '==1.710'; requires 'Log::Any', '==1.714';
requires 'Log::Any::Adapter', '==1.710'; requires 'Log::Any::Adapter', '==1.714';
requires 'Log::Any::For::Std', '==0.05'; requires 'Log::Any::For::Std', '==0.05';
requires 'Math::Random::Secure', '==0.080001'; requires 'Math::Random::Secure', '==0.080001';
requires 'MIME::Base64', '==3.16'; requires 'MIME::Base64', '==3.16';
requires 'Mojolicious', '==9.22'; requires 'Mojolicious', '==9.31';
requires 'Mojo::IOLoop::Signal', '==0.003'; requires 'Mojo::IOLoop::Signal', '==0.003';
# Чтобы заткнуть Mojo::UserAgent::Cached # Чтобы заткнуть Mojo::UserAgent::Cached
requires 'Mojo::Log', '0'; requires 'Mojo::Log', '0';
requires 'Mojo::Redis', '==3.27'; requires 'Mojo::Redis', '==3.29';
requires 'Mojo::UserAgent', '0'; requires 'Mojo::UserAgent', '0';
requires 'Mojo::UserAgent::Cached', '==1.18'; requires 'Mojo::UserAgent::Cached', '==1.25';
requires 'POSIX', '0'; requires 'POSIX', '0';
requires 'Protocol::Redis::XS', '0'; # Рекомендованный модуль для DateTime
requires 'Sub::Util', '==1.63';
requires 'URI::Encode::XS', '==0.11'; requires 'URI::Encode::XS', '==0.11';
requires 'URI::URL', '==5.10'; requires 'URI::URL', '==5.19';

View File

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

View File

@@ -8,6 +8,7 @@ use utf8;
use open qw (:std :utf8); use open qw (:std :utf8);
# Модули для работы приложения # Модули для работы приложения
use Clone qw (clone);
use Data::Dumper qw (Dumper); use Data::Dumper qw (Dumper);
use Log::Any qw ($log); use Log::Any qw ($log);
use Math::Random::Secure qw (irand); use Math::Random::Secure qw (irand);
@@ -24,23 +25,51 @@ use Exporter qw (import);
our @EXPORT_OK = qw (RunWebApp); our @EXPORT_OK = qw (RunWebApp);
my $c = LoadConf (); 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 $parse_message = sub {
my $self = shift; my $self = shift;
my $m = shift; my $m = shift;
my $answer = $m;
$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->{from} = 'webapp';
$answer->{message} = undef;
my $send_to = $m->{plugin}; my $send_to = $m->{plugin};
my $reply; my $reply;
# Если $answer->{misc}->{answer} не существует, то проставим его как 1, предполагаем, что по-умолчанию ответ от нас
# всё-таки ожидают. Если что - уточним ниже.
if (defined $answer->{misc}) { 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}) { unless (defined $answer->{misc}->{fwd_cnt}) {
$answer->{misc}->{fwd_cnt} = 1; $answer->{misc}->{fwd_cnt} = 1;
} else { } else {
if ($answer->{misc}->{fwd_cnt} > $fwd_cnt) { 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); $log->debug (Dumper $m);
return; return;
} else { } else {
@@ -48,108 +77,120 @@ my $parse_message = sub {
} }
} }
unless (defined $answer->{misc}->{answer}) { unless (defined $answer->{misc}->{good_morning}) {
$answer->{misc}->{answer} = 1; $answer->{misc}->{good_morning} = 0;
} }
unless (defined $answer->{misc}->{csign}) { unless (defined $answer->{misc}->{msg_format}) {
$answer->{misc}->{csign} = '!';
}
} else {
$answer->{misc}->{answer} = 1;
$answer->{misc}->{csign} = '!';
$answer->{misc}->{msg_format} = 0; $answer->{misc}->{msg_format} = 0;
} }
$log->debug ('[DEBUG] Incoming message ' . Dumper($m)); unless (defined $answer->{misc}->{username}) {
$answer->{misc}->{username} = 'user';
}
} else {
$answer->{misc}->{answer} = 1;
$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';
}
if (substr ($m->{message}, 1) eq 'buni') { if (length $m->{message} <= length $answer->{misc}->{csign}) {
$log->info (sprintf 'Unable to process unknown message: %s', $m->{message});
return;
}
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}) { if (($m->{plugin} eq 'telegram') && $answer->{misc}->{msg_format}) {
$reply = sprintf '[buni](%s)', Buni (); $reply = sprintf '[buni](%s)', Buni ();
} else { } else {
$reply = Buni (); $reply = Buni ();
} }
} elsif (substr ($m->{message}, 1) eq 'anek' || substr ($m->{message}, 1) eq 'анек' || substr ($m->{message}, 1) eq 'анекдот') { } elsif ($cmd eq 'anek' || $cmd eq 'анек' || $cmd eq 'анекдот') {
if (($m->{plugin} eq 'telegram') && $answer->{misc}->{msg_format}) { if (($m->{plugin} eq 'telegram') && $answer->{misc}->{msg_format}) {
$reply = "```\n" . Anek () . "\n```"; $reply = "```\n" . Anek () . "\n```";
} else { } else {
$reply = Anek (); $reply = Anek ();
} }
} elsif (substr ($m->{message}, 1) eq 'cat' || substr ($m->{message}, 1) eq 'кис') { } elsif ($cmd eq 'cat' || $cmd eq 'кис') {
if (($m->{plugin} eq 'telegram') && $answer->{misc}->{msg_format}) { if (($m->{plugin} eq 'telegram') && $answer->{misc}->{msg_format}) {
my @cats = ('龴ↀ◡ↀ龴', '=^..^=', '≧◔◡◔≦ ','^ↀᴥↀ^'); my @cats = ('龴ↀ◡ↀ龴', '=^..^=', '≧◔◡◔≦ ','^ↀᴥↀ^');
$reply = sprintf '[%s](%s)', $cats[irand ($#cats + 1)], Kitty (); $reply = sprintf '[%s](%s)', $cats[irand ($#cats + 1)], Kitty ();
} else { } else {
$reply = Kitty (); $reply = Kitty ();
} }
} elsif (substr ($m->{message}, 1) eq 'drink' || substr ($m->{message}, 1) eq 'праздник') { } elsif ($cmd eq 'drink' || $cmd eq 'праздник') {
$reply = Drink (); $reply = Drink ();
} elsif (substr ($m->{message}, 1) eq 'fox' || substr ($m->{message}, 1) eq 'лис') { } elsif ($cmd eq 'fox' || $cmd eq 'лис') {
if (($m->{plugin} eq 'telegram') && $answer->{misc}->{msg_format}) { if (($m->{plugin} eq 'telegram') && $answer->{misc}->{msg_format}) {
$reply = sprintf '[-^^,--,~](%s)', Fox (); $reply = sprintf '[-^^,--,~](%s)', Fox ();
} else { } else {
$reply = Fox (); $reply = Fox ();
} }
} elsif (substr ($m->{message}, 1) eq 'frog' || substr ($m->{message}, 1) eq 'лягушка') { } elsif ($cmd eq 'frog' || $cmd eq 'лягушка') {
if (($m->{plugin} eq 'telegram') && $answer->{misc}->{msg_format}) { if (($m->{plugin} eq 'telegram') && $answer->{misc}->{msg_format}) {
my @art = qw (frog toad лягушка); my @art = qw (frog toad лягушка);
$reply = sprintf '[%s](%s)', $art [irand ($#art + 1)], Frog (); $reply = sprintf '[%s](%s)', $art [irand ($#art + 1)], Frog ();
} else { } else {
$reply = Frog (); $reply = Frog ();
} }
} elsif (substr ($m->{message}, 1) eq 'horse' || substr ($m->{message}, 1) eq 'лошадь' || substr ($m->{message}, 1) eq 'лошадка') { } elsif ($cmd eq 'horse' || $cmd eq 'лошадь' || $cmd eq 'лошадка') {
if (($m->{plugin} eq 'telegram') && $answer->{misc}->{msg_format}) { if (($m->{plugin} eq 'telegram') && $answer->{misc}->{msg_format}) {
my @art = qw (horse лошадь лошадка); my @art = qw (horse лошадь лошадка);
$reply = sprintf '[%s](%s)', $art [irand ($#art + 1)], Horse (); $reply = sprintf '[%s](%s)', $art [irand ($#art + 1)], Horse ();
} else { } else {
$reply = Horse (); $reply = Horse ();
} }
} elsif (substr ($m->{message}, 1) eq 'monkeyuser') { } elsif ($cmd eq 'monkeyuser') {
if (($m->{plugin} eq 'telegram') && $answer->{misc}->{msg_format}) { if (($m->{plugin} eq 'telegram') && $answer->{misc}->{msg_format}) {
$reply = sprintf '[monkeyuser](%s)', Monkeyuser (); $reply = sprintf '[monkeyuser](%s)', Monkeyuser ();
} else { } else {
$reply = Monkeyuser (); $reply = Monkeyuser ();
} }
} elsif (substr ($m->{message}, 1) eq 'owl' || substr ($m->{message}, 1) eq 'сова' || substr ($m->{message}, 1) eq 'сыч') { } elsif ($cmd eq 'owl' || $cmd eq 'сова' || $cmd eq 'сыч') {
if (($m->{plugin} eq 'telegram') && $answer->{misc}->{msg_format}) { if (($m->{plugin} eq 'telegram') && $answer->{misc}->{msg_format}) {
$reply = sprintf '[{ O v O }](%s)', Owl (); $reply = sprintf '[{ O v O }](%s)', Owl ();
} else { } else {
$reply = Owl (); $reply = Owl ();
} }
} elsif (substr ($m->{message}, 1) eq 'rabbit' || substr ($m->{message}, 1) eq 'bunny' || substr ($m->{message}, 1) eq 'кролик') { } elsif ($cmd eq 'rabbit' || $cmd eq 'bunny' || $cmd eq 'кролик') {
if (($m->{plugin} eq 'telegram') && $answer->{misc}->{msg_format}) { if (($m->{plugin} eq 'telegram') && $answer->{misc}->{msg_format}) {
$reply = sprintf '[(\_/)](%s)', Rabbit (); $reply = sprintf '[(\_/)](%s)', Rabbit ();
} else { } else {
$reply = Rabbit (); $reply = Rabbit ();
} }
} elsif (substr ($m->{message}, 1) eq 'snail' || substr ($m->{message}, 1) eq 'улитка') { } elsif ($cmd eq 'snail' || $cmd eq 'улитка') {
if (($m->{plugin} eq 'telegram') && $answer->{misc}->{msg_format}) { if (($m->{plugin} eq 'telegram') && $answer->{misc}->{msg_format}) {
my @art = qw ('-'_@_ @╜ @_'-'); my @art = qw ('-'_@_ @╜ @_'-');
$reply = sprintf '[%s](%s)', $art [irand ($#art + 1)], Snail (); $reply = sprintf '[%s](%s)', $art [irand ($#art + 1)], Snail ();
} else { } else {
$reply = Snail (); $reply = Snail ();
} }
} elsif (substr ($m->{message}, 1) eq 'xkcd') { } elsif ($cmd eq 'xkcd') {
if (($m->{plugin} eq 'telegram') && $answer->{misc}->{msg_format}) { if (($m->{plugin} eq 'telegram') && $answer->{misc}->{msg_format}) {
$reply = sprintf '[xkcd](%s)', Xkcd (); $reply = sprintf '[xkcd](%s)', Xkcd ();
} else { } else {
$reply = Xkcd (); $reply = Xkcd ();
} }
} elsif (substr ($m->{message}, 1, 2) eq 'w ' || substr ($m->{message}, 1, 2) eq 'п ') { } elsif ($cmd =~ /^(w|weather|п|погода|погодка|погадка)\s+(.+)$/gui) {
my $city = substr $m->{message}, 2; my $city = $2;
$reply = Weather ($city); $reply = Weather ($city);
} elsif (substr ($m->{message}, 1, 8) eq 'weather ' || substr ($m->{message}, 1, 8) eq 'погодка ' || substr ($m->{message}, 1, 8) eq 'погадка ') { } elsif ($cmd eq 'tits' ||
my $city = substr $m->{message}, 9; $cmd eq 'boobs' ||
$reply = Weather ($city); $cmd eq 'tities' ||
} elsif (substr ($m->{message}, 1, 7) eq 'погода ') { $cmd eq 'boobies' ||
my $city = substr $m->{message}, 8; $cmd eq 'сиси' ||
$reply = Weather ($city); $cmd eq 'сисечки') {
} 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 'сисечки') {
if ($m->{plugin} eq 'telegram') { if ($m->{plugin} eq 'telegram') {
my @art = ('(. )( .)', '( . Y . )', '(o)(o)', '( @ )( @ )', '(.)(.)'); my @art = ('(. )( .)', '( . Y . )', '(o)(o)', '( @ )( @ )', '(.)(.)');
my $oboobs = Oboobs (); my $oboobs = Oboobs ();
@@ -158,11 +199,11 @@ my $parse_message = sub {
} else { } else {
$reply = Oboobs (); $reply = Oboobs ();
} }
} elsif (substr ($m->{message}, 1) eq 'butt' || } elsif ($cmd eq 'butt' ||
substr ($m->{message}, 1) eq 'booty' || $cmd eq 'booty' ||
substr ($m->{message}, 1) eq 'ass' || $cmd eq 'ass' ||
substr ($m->{message}, 1) eq 'попа' || $cmd eq 'попа' ||
substr ($m->{message}, 1) eq 'попка') { $cmd eq 'попка') {
if ($m->{plugin} eq 'telegram') { if ($m->{plugin} eq 'telegram') {
my @art = ('(__(__)', '(_!_)', '(__.__)'); my @art = ('(__(__)', '(_!_)', '(__.__)');
my $obutts = Obutts (); my $obutts = Obutts ();
@@ -240,10 +281,8 @@ sub RunWebApp {
); );
} }
Mojo::IOLoop::Signal->on ( Mojo::IOLoop::Signal->on (TERM => $__signal_handler);
TERM => $__signal_handler, Mojo::IOLoop::Signal->on (INT => $__signal_handler);
INT => $__signal_handler,
);
do { Mojo::IOLoop->start } until Mojo::IOLoop->is_running; do { Mojo::IOLoop->start } until Mojo::IOLoop->is_running;
return; return;

View File

@@ -31,7 +31,6 @@ use version; our $VERSION = qw (1.0);
use Exporter qw (import); use Exporter qw (import);
our @EXPORT_OK = qw (Anek Buni Drink Monkeyuser Kitty Fox Oboobs Obutts Rabbit Owl Frog Horse Snail Xkcd Weather); 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 $c = LoadConf ();
my $cachedir = $c->{cachedir}; my $cachedir = $c->{cachedir};
@@ -131,7 +130,12 @@ sub Anek {
$got_anek = 1; $got_anek = 1;
} }
} else { } 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 { } else {
$log->warn (sprintf '[WARN] anekdot.ru server returns unexpected response text: %s', $r->body); $log->warn (sprintf '[WARN] anekdot.ru server returns unexpected response text: %s', $r->body);
@@ -192,8 +196,7 @@ sub Buni {
sub Drink { sub Drink {
my $r; my $r;
my $ret = 'Не знаю праздников - вджобываю весь день на шахтах, как проклятая.'; my $ret = 'Не знаю праздников - вджобываю весь день на шахтах, как проклятая.';
my ($dayNum, $monthNum) = (localtime ())[3, 4]; my $url = 'https://prazdniki-segodnya.ru/';
my $url = sprintf 'https://kakoysegodnyaprazdnik.ru/baza/%s/%s', $MONTH[$monthNum], $dayNum;
# Those POSIX assholes just forgot to add unix timestamps without TZ offset, so... # Those POSIX assholes just forgot to add unix timestamps without TZ offset, so...
my ($mday, $mon, $year) = (gmtime ())[3, 4, 5]; my ($mday, $mon, $year) = (gmtime ())[3, 4, 5];
@@ -254,28 +257,39 @@ sub Drink {
if ($r->is_success) { if ($r->is_success) {
my $p = HTML::TokeParser->new(\$r->body); my $p = HTML::TokeParser->new(\$r->body);
my @a; my @a;
my @holyday; my %holiday;
do { do {
$#a = -1; $#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') { if ($#{$a[0]} > 2) {
push @holyday,'* ' . decode ('UTF-8', $p->get_trimmed_text ('/span')); 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); } while ($#{$a[0]} > 1);
if ($#holyday > 0) { if (int (keys (%holiday)) > 0) {
# cut off something weird, definely not a "holyday" $ret = join "\n", sort (keys (%holiday));
$#holyday = $#holyday - 1;
}
if ($#holyday > 0) {
$ret = join "\n", @holyday;
} }
} else { } 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; return $ret;
@@ -559,14 +573,22 @@ sub Weather {
$city = 'Екатеринбург'; $city = 'Екатеринбург';
} }
my $w = __weather ($city);
my $reply; 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) {
if ($w->{temperature_min} == $w->{temperature_max}) { if ($w->{temperature_min} == $w->{temperature_max}) {
if ($c->{openweathermap}->{country}) {
$reply = sprintf ( $reply = sprintf (
"Погода в городе %s, %s:\n%s, ветер %s %s м/c, температура %s°C, ощущается как %s°C, относительная влажность %s%%, давление %s мм.рт.ст", "Погода в городе %s, %s:\n%s, ветер %s %s м/c, температура %s°C, ощущается как %s°C, относительная влажность %s%%, давление %s мм.рт.ст",
$w->{name}, $city,
$w->{country}, $w->{country},
ucfirst $w->{description}, ucfirst $w->{description},
$w->{wind_direction}, $w->{wind_direction},
@@ -576,10 +598,26 @@ sub Weather {
$w->{humidity}, $w->{humidity},
$w->{pressure}, $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) { } elsif ($w->{temperature_min} < 0 && $w->{temperature_max} <= 0) {
if ($c->{openweathermap}->{country}) {
$reply = sprintf ( $reply = sprintf (
"Погода в городе %s, %s:\n%s, ветер %s %s м/c, температура от %s до %s°C, ощущается как %s°C, относительная влажность %s%%, давление %s мм.рт.ст", "Погода в городе %s, %s:\n%s, ветер %s %s м/c, температура от %s до %s°C, ощущается как %s°C, относительная влажность %s%%, давление %s мм.рт.ст",
$w->{name}, $city,
$w->{country}, $w->{country},
ucfirst $w->{description}, ucfirst $w->{description},
$w->{wind_direction}, $w->{wind_direction},
@@ -591,9 +629,26 @@ sub Weather {
$w->{pressure}, $w->{pressure},
); );
} else { } 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 ( $reply = sprintf (
"Погода в городе %s, %s:\n%s, ветер %s %s м/c, температура от %s до %s°C, ощущается как %s°C, относительная влажность %s%%, давление %s мм.рт.ст", "Погода в городе %s, %s:\n%s, ветер %s %s м/c, температура от %s до %s°C, ощущается как %s°C, относительная влажность %s%%, давление %s мм.рт.ст",
$w->{name}, $city,
$w->{country}, $w->{country},
ucfirst $w->{description}, ucfirst $w->{description},
$w->{wind_direction}, $w->{wind_direction},
@@ -604,25 +659,42 @@ sub Weather {
$w->{humidity}, $w->{humidity},
$w->{pressure}, $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 { } else {
$reply = "Я не знаю, какая погода в $city"; $reply = "Я не знаю, какая погода в $city";
} }
}
return $reply; return $reply;
} }
sub __weather { sub __weather {
my $city = shift; my $lat = shift;
$city = urlencode $city; my $lon = shift;
my $appid = $c->{openweathermap}->{appid}; my $appid = $c->{openweathermap}->{appid};
my $now = time ();
my $fc; my $fc;
my $w; my $w;
my $r; my $r;
# try 3 times and giveup # Try 3 times and giveup
for (1..3) { for (1..3) {
my $ua = Mojo::UserAgent::Cached->new; my $ua = Mojo::UserAgent::Cached->new;
$ua->local_dir ($cachedir); $ua->local_dir ($cachedir);
@@ -637,7 +709,14 @@ sub __weather {
); );
# just to make Mojo::UserAgent::Cached happy # just to make Mojo::UserAgent::Cached happy
$ua->logger (Mojo::Log->new (path => File::Spec->devnull, level => 'error')); $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) { if ($r->is_success) {
last; last;
@@ -716,6 +795,77 @@ sub __weather {
return $w; 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; 1;
# vim: set ft=perl noet ai ts=4 sw=4 sts=4: # vim: set ft=perl noet ai ts=4 sw=4 sts=4: