Anek.pm: fix rare case when fetched response is unparsable
This commit is contained in:
@@ -6,13 +6,11 @@ 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 JSON::XS;
|
use JSON::XS;
|
||||||
use Log::Any qw ($log);
|
use Log::Any qw ($log);
|
||||||
use Mojo::UserAgent;
|
use Mojo::UserAgent;
|
||||||
use Data::Dumper;
|
|
||||||
|
|
||||||
use version; our $VERSION = qw (1.0);
|
use version; our $VERSION = qw (1.0);
|
||||||
use Exporter qw (import);
|
use Exporter qw (import);
|
||||||
@@ -21,6 +19,9 @@ our @EXPORT_OK = qw (Anek);
|
|||||||
sub Anek {
|
sub Anek {
|
||||||
my $r;
|
my $r;
|
||||||
my $ret = 'Все рассказчики анекдотов отдыхают';
|
my $ret = 'Все рассказчики анекдотов отдыхают';
|
||||||
|
my $got_anek = 0;
|
||||||
|
|
||||||
|
for (1..3) {
|
||||||
for (1..3) {
|
for (1..3) {
|
||||||
my $ua = Mojo::UserAgent->new->connect_timeout (3);
|
my $ua = Mojo::UserAgent->new->connect_timeout (3);
|
||||||
$ua->max_redirects(3);
|
$ua->max_redirects(3);
|
||||||
@@ -52,14 +53,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);
|
||||||
}
|
}
|
||||||
@@ -71,6 +75,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