Initial commit

2021-07-29 03:23:25 +03:00
commit 1e0181a294
24 changed files with 2363 additions and 0 deletions
--- a/lib/WebApp.pm
+++ b/lib/WebApp.pm
@@ -0,0 +1,115 @@
+package WebApp;
+
+# общие модули - синтаксис, кодировки итд
+use 5.018;
+use strict;
+use warnings;
+use utf8;
+use open qw (:std :utf8);
+
+# модули для работы приложения
+use Log::Any qw ($log);
+use Mojo::Redis;
+use Mojo::IOLoop;
+
+# плагины web-клиентов
+use Buni qw (Buni);
+use Conf qw (LoadConf);
+use Drink qw (Drink);
+use Fox qw (Fox);
+use Image qw (Rabbit Owl Frog Horse Snail);
+use Kitty qw (Kitty);
+use Monkeyuser qw (Monkeyuser);
+use Weather qw (Weather);
+use Xkcd qw (Xkcd);
+
+use version; our $VERSION = qw (1.0);
+use Exporter qw (import);
+our @EXPORT_OK = qw (RunWebApp);
+
+my $c = LoadConf ();
+
+# основной парсер
+my $parse_message = sub {
+	my $self = shift;
+	my $m = shift;
+	my $answer = $m;
+	my $send_to = $answer->{from};
+
+	if (substr ($m->{message}, 1) eq 'buni') {
+		$answer->{message} = Buni ();
+	} elsif (substr ($m->{message}, 1) eq 'cat' || substr ($m->{message}, 1) eq 'кис') {
+		$answer->{message} = Kitty ();
+	} elsif (substr ($m->{message}, 1) eq 'drink' || substr ($m->{message}, 1) eq 'праздник') {
+		$answer->{message} = Drink ();
+	} elsif (substr ($m->{message}, 1) eq 'fox' || substr ($m->{message}, 1) eq 'лис') {
+		$answer->{message} = Fox ();
+	} elsif (substr ($m->{message}, 1) eq 'frog' || substr ($m->{message}, 1) eq 'лягушка') {
+		$answer->{message} = Frog ();
+	} elsif (substr ($m->{message}, 1) eq 'horse' || substr ($m->{message}, 1) eq 'лошадь' || substr ($m->{message}, 1) eq 'лошадка') {
+		$answer->{message} = Horse ();
+	} elsif (substr ($m->{message}, 1) eq 'monkeyuser') {
+		$answer->{message} = Monkeyuser ();
+	} elsif (substr ($m->{message}, 1) eq 'owl' || substr ($m->{message}, 1) eq 'сова' || substr ($m->{message}, 1) eq 'сыч') {
+		$answer->{message} = Owl ();
+	} elsif (substr ($m->{message}, 1) eq 'rabbit' || substr ($m->{message}, 1) eq 'bunny' || substr ($m->{message}, 1) eq 'кролик') {
+		$answer->{message} = Rabbit ();
+	} elsif (substr ($m->{message}, 1) eq 'snail' || substr ($m->{message}, 1) eq 'улитка') {
+		$answer->{message} = Snail ();
+	} elsif (substr ($m->{message}, 1) eq 'xkcd') {
+		$answer->{message} = Xkcd ();
+	} elsif (substr ($m->{message}, 1, 2) eq 'w ' || substr ($m->{message}, 1, 2) eq 'п ') {
+		my $city = substr $m->{message}, 2;
+		$answer->{message} = Weather ($city);
+	} else {
+		$log->info (sprintf 'Unable to process unknown message: %s', $m->{message});
+	}
+
+	$self->json ($send_to)->notify (
+		$send_to => {
+			from    => $answer->{from},
+			userid  => $answer->{userid},
+			chatid  => $answer->{chatid},
+			plugin  => $answer->{plugin},
+			message => $answer->{message}
+		}
+	);
+
+	return;
+};
+
+# main loop, он же event loop
+sub RunWebApp {
+	my $redis = Mojo::Redis->new (
+		sprintf 'redis://%s:%s/1', $c->{server}, $c->{port}
+	);
+
+	my $pubsub = $redis->pubsub;
+	my $sub;
+
+	$pubsub->listen (
+		# Вот такая ебическая конструкция для авто-подписывания на все новые каналы.
+		# Странное ограничение, при котором на шаблон каналов можно подписаться только, подписавшись на каждый из
+		# каналов. То есть подписка создаётся по запросу. В AnyEvent::Redis подписаться можно сразу на * :(
+		# Но конкретно в моём случае этот момент неважен, т.к. подразумевается, что каналы будут добавляться, но не 
+		# будут убавляться.
+		'webapp:*' => sub {
+			my ($ps, $channel) = @_ ;
+
+			unless (defined $sub->{$channel}) {
+				$log->info ("Subscribing to $channel");
+
+				$sub->{$channel} = $ps->json ($channel)->listen (
+					$channel => sub { $parse_message->(@_); }
+				);
+			}
+		}
+	);
+
+	do { Mojo::IOLoop->start } until Mojo::IOLoop->is_running;
+	return;
+}
+
+1;
+
+# vim: set ft=perl noet ai ts=4 sw=4 sts=4: