116 lines
3.9 KiB
Perl
116 lines
3.9 KiB
Perl
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:
|