Use less substrs, more deeply tidy incoming json data

This commit is contained in:
eleksir
2022-04-18 17:24:14 +03:00
parent 44a22a3382
commit 209c9f1ad7
2 changed files with 86 additions and 46 deletions

View File

@@ -2,6 +2,7 @@
requires 'Carp', '==1.50'; requires 'Carp', '==1.50';
requires 'CHI', '==0.61'; requires 'CHI', '==0.61';
requires 'CHI::Driver::BerkeleyDB', '==0.05'; requires 'CHI::Driver::BerkeleyDB', '==0.05';
requires 'Clone', '==0.45';
requires 'Cwd', '==3.75'; requires 'Cwd', '==3.75';
requires 'Cwd::utf8', '==0.011'; requires 'Cwd::utf8', '==0.011';
requires 'DateTime', '==1.55'; requires 'DateTime', '==1.55';

View File

@@ -8,6 +8,7 @@ use utf8;
use open qw (:std :utf8); use open qw (:std :utf8);
# Модули для работы приложения # Модули для работы приложения
use Clone qw (clone);
use Data::Dumper qw (Dumper); use Data::Dumper qw (Dumper);
use Log::Any qw ($log); use Log::Any qw ($log);
use Math::Random::Secure qw (irand); use Math::Random::Secure qw (irand);
@@ -24,23 +25,51 @@ use Exporter qw (import);
our @EXPORT_OK = qw (RunWebApp); our @EXPORT_OK = qw (RunWebApp);
my $c = LoadConf (); my $c = LoadConf ();
my $fwd_cnt = $c->{'forward_max'} // 5; my $fwd_cnt = 5;
if (defined $c->{'forward_max'}) {
$fwd_cnt = $c->{'forward_max'};
}
# Основной парсер # Основной парсер
my $parse_message = sub { my $parse_message = sub {
my $self = shift; my $self = shift;
my $m = shift; my $m = shift;
my $answer = $m;
$answer->{from} = 'webapp'; $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 $send_to = $m->{plugin};
my $reply; my $reply;
# Если $answer->{misc}->{answer} не существует, то проставим его как 1, предполагаем, что по-умолчанию ответ от нас
# всё-таки ожидают. Если что - уточним ниже.
if (defined $answer->{misc}) { 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}) { unless (defined $answer->{misc}->{fwd_cnt}) {
$answer->{misc}->{fwd_cnt} = 1; $answer->{misc}->{fwd_cnt} = 1;
} else { } else {
if ($answer->{misc}->{fwd_cnt} > $fwd_cnt) { if ($answer->{misc}->{fwd_cnt} > $fwd_cnt) {
$log->error ('Forward loop detected, discarding message.'); $log->error ('[ERROR] Forward loop detected, discarding message.');
$log->debug (Dumper $m); $log->debug (Dumper $m);
return; return;
} else { } else {
@@ -48,108 +77,120 @@ my $parse_message = sub {
} }
} }
unless (defined $answer->{misc}->{answer}) { unless (defined $answer->{misc}->{good_morning}) {
$answer->{misc}->{answer} = 1; $answer->{misc}->{good_morning} = 0;
} }
unless (defined $answer->{misc}->{csign}) { unless (defined $answer->{misc}->{msg_format}) {
$answer->{misc}->{csign} = '!'; $answer->{misc}->{msg_format} = 0;
}
unless (defined $answer->{misc}->{username}) {
$answer->{misc}->{username} = 'user';
} }
} else { } else {
$answer->{misc}->{answer} = 1; $answer->{misc}->{answer} = 1;
$answer->{misc}->{csign} = '!'; $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}->{msg_format} = 0;
$answer->{misc}->{username} = 'user';
} }
$log->debug ('[DEBUG] Incoming message ' . Dumper($m)); if (length $m->{message} <= length $answer->{csign}) {
$log->info (sprintf 'Unable to process unknown message: %s', $m->{message});
return;
}
if (substr ($m->{message}, 1) eq 'buni') { if (substr ($m->{message}, 0, length ($answer->{csign})) ne $answer->{csign}) {
$log->info (sprintf 'Unable to process unknown message: %s', $m->{message});
return;
}
my $cmd = substr $m->{message}, length ($answer->{csign});
if ($cmd eq 'buni') {
if (($m->{plugin} eq 'telegram') && $answer->{misc}->{msg_format}) { if (($m->{plugin} eq 'telegram') && $answer->{misc}->{msg_format}) {
$reply = sprintf '[buni](%s)', Buni (); $reply = sprintf '[buni](%s)', Buni ();
} else { } else {
$reply = Buni (); $reply = Buni ();
} }
} elsif (substr ($m->{message}, 1) eq 'anek' || substr ($m->{message}, 1) eq 'анек' || substr ($m->{message}, 1) eq 'анекдот') { } elsif ($cmd eq 'anek' || $cmd eq 'анек' || $cmd eq 'анекдот') {
if (($m->{plugin} eq 'telegram') && $answer->{misc}->{msg_format}) { if (($m->{plugin} eq 'telegram') && $answer->{misc}->{msg_format}) {
$reply = "```\n" . Anek () . "\n```"; $reply = "```\n" . Anek () . "\n```";
} else { } else {
$reply = Anek (); $reply = Anek ();
} }
} elsif (substr ($m->{message}, 1) eq 'cat' || substr ($m->{message}, 1) eq 'кис') { } elsif ($cmd eq 'cat' || $cmd eq 'кис') {
if (($m->{plugin} eq 'telegram') && $answer->{misc}->{msg_format}) { if (($m->{plugin} eq 'telegram') && $answer->{misc}->{msg_format}) {
my @cats = ('龴ↀ◡ↀ龴', '=^..^=', '≧◔◡◔≦ ','^ↀᴥↀ^'); my @cats = ('龴ↀ◡ↀ龴', '=^..^=', '≧◔◡◔≦ ','^ↀᴥↀ^');
$reply = sprintf '[%s](%s)', $cats[irand ($#cats + 1)], Kitty (); $reply = sprintf '[%s](%s)', $cats[irand ($#cats + 1)], Kitty ();
} else { } else {
$reply = Kitty (); $reply = Kitty ();
} }
} elsif (substr ($m->{message}, 1) eq 'drink' || substr ($m->{message}, 1) eq 'праздник') { } elsif ($cmd eq 'drink' || $cmd eq 'праздник') {
$reply = Drink (); $reply = Drink ();
} elsif (substr ($m->{message}, 1) eq 'fox' || substr ($m->{message}, 1) eq 'лис') { } elsif ($cmd eq 'fox' || $cmd eq 'лис') {
if (($m->{plugin} eq 'telegram') && $answer->{misc}->{msg_format}) { if (($m->{plugin} eq 'telegram') && $answer->{misc}->{msg_format}) {
$reply = sprintf '[-^^,--,~](%s)', Fox (); $reply = sprintf '[-^^,--,~](%s)', Fox ();
} else { } else {
$reply = Fox (); $reply = Fox ();
} }
} elsif (substr ($m->{message}, 1) eq 'frog' || substr ($m->{message}, 1) eq 'лягушка') { } elsif ($cmd eq 'frog' || $cmd eq 'лягушка') {
if (($m->{plugin} eq 'telegram') && $answer->{misc}->{msg_format}) { if (($m->{plugin} eq 'telegram') && $answer->{misc}->{msg_format}) {
my @art = qw (frog toad лягушка); my @art = qw (frog toad лягушка);
$reply = sprintf '[%s](%s)', $art [irand ($#art + 1)], Frog (); $reply = sprintf '[%s](%s)', $art [irand ($#art + 1)], Frog ();
} else { } else {
$reply = Frog (); $reply = Frog ();
} }
} elsif (substr ($m->{message}, 1) eq 'horse' || substr ($m->{message}, 1) eq 'лошадь' || substr ($m->{message}, 1) eq 'лошадка') { } elsif ($cmd eq 'horse' || $cmd eq 'лошадь' || $cmd eq 'лошадка') {
if (($m->{plugin} eq 'telegram') && $answer->{misc}->{msg_format}) { if (($m->{plugin} eq 'telegram') && $answer->{misc}->{msg_format}) {
my @art = qw (horse лошадь лошадка); my @art = qw (horse лошадь лошадка);
$reply = sprintf '[%s](%s)', $art [irand ($#art + 1)], Horse (); $reply = sprintf '[%s](%s)', $art [irand ($#art + 1)], Horse ();
} else { } else {
$reply = Horse (); $reply = Horse ();
} }
} elsif (substr ($m->{message}, 1) eq 'monkeyuser') { } elsif ($cmd eq 'monkeyuser') {
if (($m->{plugin} eq 'telegram') && $answer->{misc}->{msg_format}) { if (($m->{plugin} eq 'telegram') && $answer->{misc}->{msg_format}) {
$reply = sprintf '[monkeyuser](%s)', Monkeyuser (); $reply = sprintf '[monkeyuser](%s)', Monkeyuser ();
} else { } else {
$reply = Monkeyuser (); $reply = Monkeyuser ();
} }
} elsif (substr ($m->{message}, 1) eq 'owl' || substr ($m->{message}, 1) eq 'сова' || substr ($m->{message}, 1) eq 'сыч') { } elsif ($cmd eq 'owl' || $cmd eq 'сова' || $cmd eq 'сыч') {
if (($m->{plugin} eq 'telegram') && $answer->{misc}->{msg_format}) { if (($m->{plugin} eq 'telegram') && $answer->{misc}->{msg_format}) {
$reply = sprintf '[{ O v O }](%s)', Owl (); $reply = sprintf '[{ O v O }](%s)', Owl ();
} else { } else {
$reply = Owl (); $reply = Owl ();
} }
} elsif (substr ($m->{message}, 1) eq 'rabbit' || substr ($m->{message}, 1) eq 'bunny' || substr ($m->{message}, 1) eq 'кролик') { } elsif ($cmd eq 'rabbit' || $cmd eq 'bunny' || $cmd eq 'кролик') {
if (($m->{plugin} eq 'telegram') && $answer->{misc}->{msg_format}) { if (($m->{plugin} eq 'telegram') && $answer->{misc}->{msg_format}) {
$reply = sprintf '[(\_/)](%s)', Rabbit (); $reply = sprintf '[(\_/)](%s)', Rabbit ();
} else { } else {
$reply = Rabbit (); $reply = Rabbit ();
} }
} elsif (substr ($m->{message}, 1) eq 'snail' || substr ($m->{message}, 1) eq 'улитка') { } elsif ($cmd eq 'snail' || $cmd eq 'улитка') {
if (($m->{plugin} eq 'telegram') && $answer->{misc}->{msg_format}) { if (($m->{plugin} eq 'telegram') && $answer->{misc}->{msg_format}) {
my @art = qw ('-'_@_ @╜ @_'-'); my @art = qw ('-'_@_ @╜ @_'-');
$reply = sprintf '[%s](%s)', $art [irand ($#art + 1)], Snail (); $reply = sprintf '[%s](%s)', $art [irand ($#art + 1)], Snail ();
} else { } else {
$reply = Snail (); $reply = Snail ();
} }
} elsif (substr ($m->{message}, 1) eq 'xkcd') { } elsif ($cmd eq 'xkcd') {
if (($m->{plugin} eq 'telegram') && $answer->{misc}->{msg_format}) { if (($m->{plugin} eq 'telegram') && $answer->{misc}->{msg_format}) {
$reply = sprintf '[xkcd](%s)', Xkcd (); $reply = sprintf '[xkcd](%s)', Xkcd ();
} else { } else {
$reply = Xkcd (); $reply = Xkcd ();
} }
} elsif (substr ($m->{message}, 1, 2) eq 'w ' || substr ($m->{message}, 1, 2) eq 'п ') { } elsif ($cmd =~ /^(w|weather|п|погода|погодка|погадка)\s+(.+)$/gui) {
my $city = substr $m->{message}, 2; my $city = $2;
$reply = Weather ($city); $reply = Weather ($city);
} elsif (substr ($m->{message}, 1, 8) eq 'weather ' || substr ($m->{message}, 1, 8) eq 'погодка ' || substr ($m->{message}, 1, 8) eq 'погадка ') { } elsif ($cmd eq 'tits' ||
my $city = substr $m->{message}, 9; $cmd eq 'boobs' ||
$reply = Weather ($city); $cmd eq 'tities' ||
} elsif (substr ($m->{message}, 1, 7) eq 'погода ') { $cmd eq 'boobies' ||
my $city = substr $m->{message}, 8; $cmd eq 'сиси' ||
$reply = Weather ($city); $cmd eq 'сисечки') {
} elsif (substr ($m->{message}, 1) eq 'tits' ||
substr ($m->{message}, 1) eq 'boobs' ||
substr ($m->{message}, 1) eq 'tities' ||
substr ($m->{message}, 1) eq 'boobies' ||
substr ($m->{message}, 1) eq 'сиси' ||
substr ($m->{message}, 1) eq 'сисечки') {
if ($m->{plugin} eq 'telegram') { if ($m->{plugin} eq 'telegram') {
my @art = ('(. )( .)', '( . Y . )', '(o)(o)', '( @ )( @ )', '(.)(.)'); my @art = ('(. )( .)', '( . Y . )', '(o)(o)', '( @ )( @ )', '(.)(.)');
my $oboobs = Oboobs (); my $oboobs = Oboobs ();
@@ -158,11 +199,11 @@ my $parse_message = sub {
} else { } else {
$reply = Oboobs (); $reply = Oboobs ();
} }
} elsif (substr ($m->{message}, 1) eq 'butt' || } elsif ($cmd eq 'butt' ||
substr ($m->{message}, 1) eq 'booty' || $cmd eq 'booty' ||
substr ($m->{message}, 1) eq 'ass' || $cmd eq 'ass' ||
substr ($m->{message}, 1) eq 'попа' || $cmd eq 'попа' ||
substr ($m->{message}, 1) eq 'попка') { $cmd eq 'попка') {
if ($m->{plugin} eq 'telegram') { if ($m->{plugin} eq 'telegram') {
my @art = ('(__(__)', '(_!_)', '(__.__)'); my @art = ('(__(__)', '(_!_)', '(__.__)');
my $obutts = Obutts (); my $obutts = Obutts ();
@@ -240,10 +281,8 @@ sub RunWebApp {
); );
} }
Mojo::IOLoop::Signal->on ( Mojo::IOLoop::Signal->on (TERM => $__signal_handler);
TERM => $__signal_handler, Mojo::IOLoop::Signal->on (INT => $__signal_handler);
INT => $__signal_handler,
);
do { Mojo::IOLoop->start } until Mojo::IOLoop->is_running; do { Mojo::IOLoop->start } until Mojo::IOLoop->is_running;
return; return;