Anek.pm: fix rare case when fetched response is unparsable
This commit is contained in:
@@ -19,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');
|
||||||
@@ -49,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);
|
||||||
}
|
}
|
||||||
@@ -68,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;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|||||||
Reference in New Issue
Block a user