eleksir/aleesa-jabber-bot
1
Fork 0
Code Activity

Anek.pm: fix rare case when fetched response is unparsable

Browse Source
This commit is contained in:
eleksir
2021-08-15 23:54:35 +03:00
parent 87c29ac8d3
commit 5e53450221
1 changed files with 46 additions and 34 deletions
Download Patch File Download Diff File Expand all files Collapse all files

24
lib/BotLib/Anek.pm
View File

@@ -6,7 +6,6 @@ use warnings;
use utf8; use utf8;
use open qw (:std :utf8); use open qw (:std :utf8);
use English qw ( -no_match_vars ); use English qw ( -no_match_vars );
use Carp qw (cluck);
use Encode; use Encode;
use HTML::TokeParser; use HTML::TokeParser;
use HTTP::Tiny; use HTTP::Tiny;
@@ -20,6 +19,11 @@ our @EXPORT_OK = qw (Anek);
sub Anek { sub Anek {
my $r; my $r;
my $ret = 'Все рассказчики анекдотов отдыхают'; my $ret = 'Все рассказчики анекдотов отдыхают';
my $got_anek = 0;
# time to time anekdot.ru can give valid but unparsable response
# i've no clue where's err, just fetch another response and try again :)
for (1..3) {
for (1..3) { for (1..3) {
my $ua = HTTP::Tiny->new (timeout => 3); my $ua = HTTP::Tiny->new (timeout => 3);
$r = $ua->get ('https://www.anekdot.ru/rss/randomu.html'); $r = $ua->get ('https://www.anekdot.ru/rss/randomu.html');
@@ -50,14 +54,17 @@ sub Anek {
if (defined $json && length ($json) > 10) { if (defined $json && length ($json) > 10) {
$json =~ s/\\"/"/g; $json =~ s/\\"/"/g;
$json =~ s/\\\\"/\\"/g; $json =~ s/\\\\"/\\"/g;
chop $json; $json = substr $json, 0, -3;
chop $json;
chop $json;
my $anek = eval { ${JSON::XS->new->relaxed->decode ($json)}[0] }; my $anek = eval { ${JSON::XS->new->relaxed->decode ($json)}[0] };
if (defined $anek) { if (defined $anek) {
my @anek = split (/<br>/, $anek); my @anek = split /<br>/, $anek;
$ret = join ("\n", @anek); $ret = join "\n", @anek;
if (length ($ret) > 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);
} }
@@ -69,6 +76,11 @@ sub Anek {
$log->warn (sprintf '[WARN] anekdot.ru server return status %s with message: %s', $r->code, $r->message); $log->warn (sprintf '[WARN] anekdot.ru server return status %s with message: %s', $r->code, $r->message);
} }
if ($got_anek) {
last;
}
}
return $ret; return $ret;
} }