294 lines
8.4 KiB
Perl
294 lines
8.4 KiB
Perl
package WebApp;
|
|
|
|
# Общие модули - синтаксис, кодировки итд
|
|
use 5.018; ## no critic (ProhibitImplicitImport)
|
|
use strict;
|
|
use warnings;
|
|
use utf8;
|
|
use open qw (:std :utf8);
|
|
|
|
# Модули для работы приложения
|
|
use Clone qw (clone);
|
|
use Data::Dumper qw (Dumper);
|
|
use Log::Any qw ($log);
|
|
use Math::Random::Secure qw (irand);
|
|
use Mojo::Redis ();
|
|
use Mojo::IOLoop ();
|
|
use Mojo::IOLoop::Signal ();
|
|
|
|
# Плагины web-клиентов
|
|
use Conf qw (LoadConf);
|
|
use WebApp::Client qw (Anek Buni Drink Monkeyuser Kitty Fox Oboobs Obutts Rabbit Owl Frog Horse Snail Xkcd Weather);
|
|
|
|
use version; our $VERSION = qw (1.0);
|
|
use Exporter qw (import);
|
|
our @EXPORT_OK = qw (RunWebApp);
|
|
|
|
my $c = LoadConf ();
|
|
my $fwd_cnt = 5;
|
|
|
|
if (defined $c->{'forward_max'}) {
|
|
$fwd_cnt = $c->{'forward_max'};
|
|
}
|
|
|
|
# Основной парсер
|
|
my $parse_message = sub {
|
|
my $self = shift;
|
|
my $m = shift;
|
|
|
|
$log->debug ('[DEBUG] Incoming message ' . Dumper ($m));
|
|
|
|
unless (defined $m->{message}) {
|
|
$log->error (sprintf 'Unable to process unknown message: %s', $m->{message});
|
|
return;
|
|
}
|
|
|
|
my $answer = clone ($m);
|
|
$answer->{from} = 'webapp';
|
|
$answer->{message} = undef;
|
|
|
|
my $send_to = $m->{plugin};
|
|
my $reply;
|
|
|
|
# Если $answer->{misc}->{answer} не существует, то проставим его как 1, предполагаем, что по-умолчанию ответ от нас
|
|
# всё-таки ожидают. Если что - уточним ниже.
|
|
if (defined $answer->{misc}) {
|
|
unless (defined $answer->{misc}->{answer}) {
|
|
$answer->{misc}->{answer} = 1;
|
|
}
|
|
|
|
unless (defined $answer->{misc}->{bot_nick}) {
|
|
$answer->{misc}->{bot_nick} = undef;
|
|
}
|
|
|
|
unless (defined $answer->{misc}->{csign}) {
|
|
$answer->{misc}->{csign} = '!';
|
|
}
|
|
|
|
unless (defined $answer->{misc}->{fwd_cnt}) {
|
|
$answer->{misc}->{fwd_cnt} = 1;
|
|
} else {
|
|
if ($answer->{misc}->{fwd_cnt} > $fwd_cnt) {
|
|
$log->error ('[ERROR] Forward loop detected, discarding message.');
|
|
$log->debug (Dumper $m);
|
|
return;
|
|
} else {
|
|
$answer->{misc}->{fwd_cnt}++;
|
|
}
|
|
}
|
|
|
|
unless (defined $answer->{misc}->{good_morning}) {
|
|
$answer->{misc}->{good_morning} = 0;
|
|
}
|
|
|
|
unless (defined $answer->{misc}->{msg_format}) {
|
|
$answer->{misc}->{msg_format} = 0;
|
|
}
|
|
|
|
unless (defined $answer->{misc}->{username}) {
|
|
$answer->{misc}->{username} = 'user';
|
|
}
|
|
} else {
|
|
$answer->{misc}->{answer} = 1;
|
|
$answer->{misc}->{bot_nick} = undef;
|
|
$answer->{misc}->{csign} = $c->{csign};
|
|
$answer->{misc}->{fwd_cnt} = 1;
|
|
$answer->{misc}->{good_morning} = 0;
|
|
$answer->{misc}->{msg_format} = 0;
|
|
$answer->{misc}->{username} = 'user';
|
|
}
|
|
|
|
if (length $m->{message} <= length $answer->{misc}->{csign}) {
|
|
$log->info (sprintf 'Unable to process unknown message: %s', $m->{message});
|
|
return;
|
|
}
|
|
|
|
if (substr ($m->{message}, 0, length ($answer->{misc}->{csign})) ne $answer->{misc}->{csign}) {
|
|
$log->info (sprintf 'Unable to process unknown message: %s', $m->{message});
|
|
return;
|
|
}
|
|
|
|
my $cmd = substr $m->{message}, length ($answer->{misc}->{csign});
|
|
|
|
if ($cmd eq 'buni') {
|
|
if (($m->{plugin} eq 'telegram') && $answer->{misc}->{msg_format}) {
|
|
$reply = sprintf '[buni](%s)', Buni ();
|
|
} else {
|
|
$reply = Buni ();
|
|
}
|
|
} elsif ($cmd eq 'anek' || $cmd eq 'анек' || $cmd eq 'анекдот') {
|
|
if (($m->{plugin} eq 'telegram') && $answer->{misc}->{msg_format}) {
|
|
$reply = "```\n" . Anek () . "\n```";
|
|
} else {
|
|
$reply = Anek ();
|
|
}
|
|
} elsif ($cmd eq 'cat' || $cmd eq 'кис') {
|
|
if (($m->{plugin} eq 'telegram') && $answer->{misc}->{msg_format}) {
|
|
my @cats = ('龴ↀ◡ↀ龴', '=^..^=', '≧◔◡◔≦ ','^ↀᴥↀ^');
|
|
$reply = sprintf '[%s](%s)', $cats[irand ($#cats + 1)], Kitty ();
|
|
} else {
|
|
$reply = Kitty ();
|
|
}
|
|
} elsif ($cmd eq 'drink' || $cmd eq 'праздник') {
|
|
$reply = Drink ();
|
|
} elsif ($cmd eq 'fox' || $cmd eq 'лис') {
|
|
if (($m->{plugin} eq 'telegram') && $answer->{misc}->{msg_format}) {
|
|
$reply = sprintf '[-^^,--,~](%s)', Fox ();
|
|
} else {
|
|
$reply = Fox ();
|
|
}
|
|
} elsif ($cmd eq 'frog' || $cmd eq 'лягушка') {
|
|
if (($m->{plugin} eq 'telegram') && $answer->{misc}->{msg_format}) {
|
|
my @art = qw (frog toad лягушка);
|
|
$reply = sprintf '[%s](%s)', $art [irand ($#art + 1)], Frog ();
|
|
} else {
|
|
$reply = Frog ();
|
|
}
|
|
} elsif ($cmd eq 'horse' || $cmd eq 'лошадь' || $cmd eq 'лошадка') {
|
|
if (($m->{plugin} eq 'telegram') && $answer->{misc}->{msg_format}) {
|
|
my @art = qw (horse лошадь лошадка);
|
|
$reply = sprintf '[%s](%s)', $art [irand ($#art + 1)], Horse ();
|
|
} else {
|
|
$reply = Horse ();
|
|
}
|
|
} elsif ($cmd eq 'monkeyuser') {
|
|
if (($m->{plugin} eq 'telegram') && $answer->{misc}->{msg_format}) {
|
|
$reply = sprintf '[monkeyuser](%s)', Monkeyuser ();
|
|
} else {
|
|
$reply = Monkeyuser ();
|
|
}
|
|
} elsif ($cmd eq 'owl' || $cmd eq 'сова' || $cmd eq 'сыч') {
|
|
if (($m->{plugin} eq 'telegram') && $answer->{misc}->{msg_format}) {
|
|
$reply = sprintf '[{ O v O }](%s)', Owl ();
|
|
} else {
|
|
$reply = Owl ();
|
|
}
|
|
} elsif ($cmd eq 'rabbit' || $cmd eq 'bunny' || $cmd eq 'кролик') {
|
|
if (($m->{plugin} eq 'telegram') && $answer->{misc}->{msg_format}) {
|
|
$reply = sprintf '[(\_/)](%s)', Rabbit ();
|
|
} else {
|
|
$reply = Rabbit ();
|
|
}
|
|
} elsif ($cmd eq 'snail' || $cmd eq 'улитка') {
|
|
if (($m->{plugin} eq 'telegram') && $answer->{misc}->{msg_format}) {
|
|
my @art = qw ('-'_@_ @╜ @_'-');
|
|
$reply = sprintf '[%s](%s)', $art [irand ($#art + 1)], Snail ();
|
|
} else {
|
|
$reply = Snail ();
|
|
}
|
|
} elsif ($cmd eq 'xkcd') {
|
|
if (($m->{plugin} eq 'telegram') && $answer->{misc}->{msg_format}) {
|
|
$reply = sprintf '[xkcd](%s)', Xkcd ();
|
|
} else {
|
|
$reply = Xkcd ();
|
|
}
|
|
} elsif ($cmd =~ /^(w|weather|п|погода|погодка|погадка)\s+(.+)$/gui) {
|
|
my $city = $2;
|
|
$reply = Weather ($city);
|
|
} elsif ($cmd eq 'tits' ||
|
|
$cmd eq 'boobs' ||
|
|
$cmd eq 'tities' ||
|
|
$cmd eq 'boobies' ||
|
|
$cmd eq 'сиси' ||
|
|
$cmd eq 'сисечки') {
|
|
if ($m->{plugin} eq 'telegram') {
|
|
my @art = ('(. )( .)', '( . Y . )', '(o)(o)', '( @ )( @ )', '(.)(.)');
|
|
my $oboobs = Oboobs ();
|
|
$reply = sprintf '[%s](%s)', $art [irand ($#art + 1)], $oboobs;
|
|
$answer->{misc}->{msg_format} = 1;
|
|
} else {
|
|
$reply = Oboobs ();
|
|
}
|
|
} elsif ($cmd eq 'butt' ||
|
|
$cmd eq 'booty' ||
|
|
$cmd eq 'ass' ||
|
|
$cmd eq 'попа' ||
|
|
$cmd eq 'попка') {
|
|
if ($m->{plugin} eq 'telegram') {
|
|
my @art = ('(__(__)', '(_!_)', '(__.__)');
|
|
my $obutts = Obutts ();
|
|
$reply = sprintf '[%s](%s)', $art [irand ($#art + 1)], $obutts;
|
|
$answer->{misc}->{msg_format} = 1;
|
|
} else {
|
|
$reply = Oboobs ();
|
|
}
|
|
} else {
|
|
$log->info (sprintf 'Unable to process unknown message: %s', $m->{message});
|
|
}
|
|
|
|
if (defined $reply) {
|
|
$answer->{message} = $reply;
|
|
$log->debug ("[DEBUG] Sending message to channel $send_to " . Dumper ($answer));
|
|
|
|
$self->json ($send_to)->notify (
|
|
$send_to => $answer,
|
|
);
|
|
}
|
|
|
|
return;
|
|
};
|
|
|
|
my $__signal_handler = sub {
|
|
my ($self, $name) = @_;
|
|
$log->info ("[INFO] Caught a signal $name");
|
|
|
|
if (defined $main::pidfile && -e $main::pidfile) {
|
|
unlink $main::pidfile;
|
|
}
|
|
|
|
exit 0;
|
|
};
|
|
|
|
|
|
# main loop, он же event loop
|
|
sub RunWebApp {
|
|
$log->info ("[INFO] Connecting to $c->{server}, $c->{port}");
|
|
|
|
my $redis = Mojo::Redis->new (
|
|
sprintf 'redis://%s:%s/1', $c->{server}, $c->{port},
|
|
);
|
|
|
|
$log->info ('[INFO] Registering connection-event callback');
|
|
|
|
$redis->on (
|
|
connection => sub {
|
|
my ($r, $connection) = @_;
|
|
|
|
$log->info ('[INFO] Triggering callback on new client connection');
|
|
|
|
# Залоггируем ошибку, если соединение внезапно порвалось.
|
|
$connection->on (
|
|
error => sub {
|
|
my ($conn, $error) = @_;
|
|
$log->error ("[ERROR] Redis connection error: $error");
|
|
return;
|
|
},
|
|
);
|
|
|
|
return;
|
|
},
|
|
);
|
|
|
|
my $pubsub = $redis->pubsub;
|
|
my $sub;
|
|
$log->info ('[INFO] Subscribing to redis channels');
|
|
|
|
foreach my $channel (@{$c->{channels}}) {
|
|
$log->debug ("[DEBUG] Subscribing to $channel");
|
|
|
|
$sub->{$channel} = $pubsub->json ($channel)->listen (
|
|
$channel => sub { $parse_message->(@_); },
|
|
);
|
|
}
|
|
|
|
Mojo::IOLoop::Signal->on (TERM => $__signal_handler);
|
|
Mojo::IOLoop::Signal->on (INT => $__signal_handler);
|
|
|
|
do { Mojo::IOLoop->start } until Mojo::IOLoop->is_running;
|
|
return;
|
|
}
|
|
|
|
1;
|
|
|
|
# vim: set ft=perl noet ai ts=4 sw=4 sts=4:
|