From c6b3fac29c7926f150064d9393f6e3eea14f5687 Mon Sep 17 00:00:00 2001
From: eleksir <eleksir@exs-elm.ru>
Date: Fri, 30 Jul 2021 13:29:53 +0300
Subject: [PATCH] =?UTF-8?q?Add=20!anek=20!=D0=B0=D0=BD=D0=B5=D0=BA=20!?=
 =?UTF-8?q?=D0=B0=D0=BD=D0=B5=D0=BA=D0=B4=D0=BE=D1=82=20commands?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 lib/BotLib.pm      |  4 +++
 lib/BotLib/Anek.pm | 77 ++++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 81 insertions(+)
 create mode 100644 lib/BotLib/Anek.pm

diff --git a/lib/BotLib.pm b/lib/BotLib.pm
index 9b2c0d9..6625c59 100644
--- a/lib/BotLib.pm
+++ b/lib/BotLib.pm
@@ -8,6 +8,7 @@ use open qw (:std :utf8);
 use English qw ( -no_match_vars );
 use Carp qw (carp);
 use Math::Random::Secure qw (irand);
+use BotLib::Anek qw (Anek);
 use BotLib::Archeologist qw (Dig);
 use BotLib::Buni qw (Buni);
 use BotLib::Conf qw (LoadConf);
@@ -179,12 +180,15 @@ sub Command {
 	} elsif (substr ($text, 1, 2) eq 'w '  ||  substr ($text, 1, 2) eq 'п ') {
 		my $city = substr $text, 2;
 		$reply = Weather ($city) =~ tr/\n/ /r;
+	} elsif (substr ($text, 1) eq 'anek'  ||  substr ($text, 1) eq 'анек' || substr ($text, 1) eq 'анекдот' ) {
+		$reply = Anek ();
 	} elsif (substr ($text, 1) eq 'version'  ||  substr ($text, 1) eq 'ver') {
 		$reply = 'Версия нуль.чего-то_там.чего-то_там';
 	} elsif (substr ($text, 1) eq 'help'  ||  substr ($text, 1) eq 'помощь') {
 		$reply = <<"EOL";
 
 ${csign}help | ${csign}помощь             - это сообщение
+${csign}anek | ${csign}анек | ${csign}анекдот    - рандомный анекдот с anekdot.ru
 ${csign}buni                       - комикс-стрип hapi buni
 ${csign}bunny                      - кролик
 ${csign}rabbit | ${csign}кролик           - кролик
diff --git a/lib/BotLib/Anek.pm b/lib/BotLib/Anek.pm
new file mode 100644
index 0000000..b41573c
--- /dev/null
+++ b/lib/BotLib/Anek.pm
@@ -0,0 +1,77 @@
+package BotLib::Anek;
+
+use 5.018;
+use strict;
+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 HTTP::Tiny;
+use JSON::XS;
+use Log::Any qw ($log);
+
+use version; our $VERSION = qw (1.0);
+use Exporter qw (import);
+our @EXPORT_OK = qw (Anek);
+
+sub Anek {
+	my $r;
+	my $ret = 'Все рассказчики анекдотов отдыхают';
+	for (1..3) {
+		my $ua = HTTP::Tiny->new (timeout => 3);
+		$r = $ua->get ('https://www.anekdot.ru/rss/randomu.html');
+
+		if ($r->{success}) {
+			last;
+		}
+
+		sleep 2;
+	}
+
+	if ($r->{success}) {
+		my $json;
+		my $response_text = decode ('UTF-8', $r->{content});
+		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 $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 $anek) {
+				my @anek = split (/<br>/, $anek);
+				$ret = join ("\n", @anek);
+			} 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 unexpected response text: %s', $response_text);
+		}
+
+	} else {
+		$log->warn (sprintf '[WARN] anekdot.ru server return status %s with message: %s', $r->code, $r->message);
+	}
+
+	return $ret;
+}
+
+1;
+
+# vim: set ft=perl noet ai ts=4 sw=4 sts=4: