eleksir/aleesa-telegram-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-16 00:03:38 +03:00
parent 2134edd841
commit f83a2d3436
1 changed files with 45 additions and 36 deletions
Download Patch File Download Diff File Expand all files Collapse all files

81
lib/BotLib/Anek.pm
View File

@@ -6,13 +6,11 @@ use warnings;
use utf8;
use open qw (:std :utf8);
use English qw ( -no_match_vars );
use Carp qw (cluck);
use Encode;
use HTML::TokeParser;
use JSON::XS;
use Log::Any qw ($log);
use Mojo::UserAgent;
use Data::Dumper;
use version; our $VERSION = qw (1.0);
use Exporter qw (import);
@@ -21,54 +19,65 @@ our @EXPORT_OK = qw (Anek);
sub Anek {
my $r;
my $ret = 'Все рассказчики анекдотов отдыхают';
my $got_anek = 0;
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;
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) {
last;
}
my $json;
my $response_text = decode ('UTF-8', $r->body);
my @text = split /\n/, $response_text;
sleep 2;
}
while (my $str = pop @text) {
if ($str =~ /^var anekdot_texts \= JSON/) {
$str = (split /JSON\.parse\(\'/, $str, 2)[1];
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 $str && length ($str) > 10) {
$json = (split /\';\)/, $str, 2)[0];
last;
}
}
}
}
if (defined $json && length ($json) > 10) {
$json =~ s/\\"/"/g;
$json =~ s/\\\\"/\\"/g;
chop $json;
chop $json;
chop $json;
my $anek = eval { ${JSON::XS->new->relaxed->decode ($json)}[0] };
if (defined $json && length ($json) > 10) {
$json =~ s/\\"/"/g;
$json =~ s/\\\\"/\\"/g;
$json = substr $json, 0, -3;
if (defined $anek) {
my @anek = split (/<br>/, $anek);
$ret = join ("\n", @anek);
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 incorrect json, full response text message: %s', $response_text);
$log->warn (sprintf '[WARN] anekdot.ru server returns unexpected response text: %s', $r->body);
}
} else {
$log->warn (sprintf '[WARN] anekdot.ru server returns unexpected response text: %s', $r->body);
$log->warn (sprintf '[WARN] anekdot.ru server return status %s with message: %s', $r->code, $r->message);
}
} else {
$log->warn (sprintf '[WARN] anekdot.ru server return status %s with message: %s', $r->code, $r->message);
if ($got_anek) {
last;
}
}
return $ret;