aleesa-bot/aleesa-webapp
Archived
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Compare commits

base: aleesa-bot:v1.3
Branches Tags
aleesa-bot:master
aleesa-bot:v1.6 aleesa-bot:v1.5 aleesa-bot:v1.4 aleesa-bot:v1.3 aleesa-bot:v1.2 aleesa-bot:v1.1 aleesa-bot:v1.0
..
compare: aleesa-bot:v1.6
Branches Tags
aleesa-bot:master
aleesa-bot:v1.6 aleesa-bot:v1.5 aleesa-bot:v1.4 aleesa-bot:v1.3 aleesa-bot:v1.2 aleesa-bot:v1.1 aleesa-bot:v1.0

8 Commits
v1.3 ... v1.6

Author SHA1 Message Date
eleksir
f25a4d9ea3 Fix redis message processing, duh 2022-06-21 23:14:01 +03:00
eleksir
3d6be5ae04 Fix !drink for newer perl, also delete unused/obsolete code 2022-06-21 23:00:37 +03:00
eleksir
4c6a1ea4cd Bump version of Mojolicious 9.24 -> 9.26 2022-06-21 22:58:21 +03:00
eleksir
a891c7ed6f Fix !drink command, kind of 2022-05-25 20:40:14 +03:00
eleksir
0daaa6f568 Update cpanfile: bump Mojolicious version 9.22 -> 9.24, drop Protocol::Redis::XS 2022-04-24 02:06:44 +03:00
eleksir
209c9f1ad7 Use less substrs, more deeply tidy incoming json data 2022-04-18 17:24:14 +03:00
eleksir
44a22a3382 Fix a bit code formatting in Client.pm 2022-04-18 17:22:56 +03:00
eleksir
b6a4aaa4c1 Fix handling formating for telegram 2022-04-17 17:09:53 +03:00
3 changed files with 147 additions and 106 deletions
Expand all files Collapse all files

4
cpanfile
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';
@@ -22,7 +23,7 @@ requires 'Log::Any::Adapter', '==1.710';
requires 'Log::Any::For::Std', '==0.05'; requires 'Log::Any::For::Std', '==0.05';
requires 'Math::Random::Secure', '==0.080001'; requires 'Math::Random::Secure', '==0.080001';
requires 'MIME::Base64', '==3.16'; requires 'MIME::Base64', '==3.16';
requires 'Mojolicious', '==9.22'; requires 'Mojolicious', '==9.26';
requires 'Mojo::IOLoop::Signal', '==0.003'; requires 'Mojo::IOLoop::Signal', '==0.003';
# Чтобы заткнуть Mojo::UserAgent::Cached # Чтобы заткнуть Mojo::UserAgent::Cached
requires 'Mojo::Log', '0'; requires 'Mojo::Log', '0';
@@ -30,6 +31,5 @@ requires 'Mojo::Redis', '==3.27';
requires 'Mojo::UserAgent', '0'; requires 'Mojo::UserAgent', '0';
requires 'Mojo::UserAgent::Cached', '==1.18'; requires 'Mojo::UserAgent::Cached', '==1.18';
requires 'POSIX', '0'; requires 'POSIX', '0';
requires 'Protocol::Redis::XS', '0';
requires 'URI::Encode::XS', '==0.11'; requires 'URI::Encode::XS', '==0.11';
requires 'URI::URL', '==5.10'; requires 'URI::URL', '==5.10';

190
lib/WebApp.pm
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;
$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->{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,111 +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} = '!';
}
} else {
$answer->{misc}->{answer} = 1;
$answer->{misc}->{csign} = '!';
$answer->{misc}->{msg_format} = 0; $answer->{misc}->{msg_format} = 0;
} }
$log->debug ('[DEBUG] Incoming message ' . Dumper($m)); 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 (substr ($m->{message}, 1) eq 'buni') { 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 (); $reply = Buni ();
} elsif (substr ($m->{message}, 1) eq 'anek' || substr ($m->{message}, 1) eq 'анек' || substr ($m->{message}, 1) eq 'анекдот') { }
if ($m->{plugin} eq 'telegram') { } elsif ($cmd eq 'anek' || $cmd eq 'анек' || $cmd eq 'анекдот') {
if (($m->{plugin} eq 'telegram') && $answer->{misc}->{msg_format}) {
$reply = "```\n" . Anek () . "\n```"; $reply = "```\n" . Anek () . "\n```";
$answer->{misc}->{msg_format} = 1;
} 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') { if (($m->{plugin} eq 'telegram') && $answer->{misc}->{msg_format}) {
my @cats = ('龴ↀ◡ↀ龴', '=^..^=', '≧◔◡◔≦ ','^ↀᴥↀ^'); my @cats = ('龴ↀ◡ↀ龴', '=^..^=', '≧◔◡◔≦ ','^ↀᴥↀ^');
my $cat = Kitty (); $reply = sprintf '[%s](%s)', $cats[irand ($#cats + 1)], Kitty ();
$reply = sprintf '[%s](%s)', $cats[irand ($#cats + 1)], $cat;
$answer->{misc}->{msg_format} = 1;
} 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') { if (($m->{plugin} eq 'telegram') && $answer->{misc}->{msg_format}) {
my $fox = Fox (); $reply = sprintf '[-^^,--,~](%s)', Fox ();
$reply = sprintf '[-^^,--,~](%s)', $fox;
$answer->{misc}->{msg_format} = 1;
} 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') { if (($m->{plugin} eq 'telegram') && $answer->{misc}->{msg_format}) {
my @art = qw (frog toad лягушка); my @art = qw (frog toad лягушка);
my $frog = Frog (); $reply = sprintf '[%s](%s)', $art [irand ($#art + 1)], Frog ();
$reply = sprintf '[%s](%s)', $art [irand ($#art + 1)], $frog;
$answer->{misc}->{msg_format} = 1;
} 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') { if (($m->{plugin} eq 'telegram') && $answer->{misc}->{msg_format}) {
my @art = qw (horse лошадь лошадка); my @art = qw (horse лошадь лошадка);
my $horse = Horse (); $reply = sprintf '[%s](%s)', $art [irand ($#art + 1)], Horse ();
$reply = sprintf '[%s](%s)', $art [irand ($#art + 1)], $horse;
$answer->{misc}->{msg_format} = 1;
} 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}) {
$reply = sprintf '[monkeyuser](%s)', Monkeyuser ();
} else {
$reply = Monkeyuser (); $reply = Monkeyuser ();
} elsif (substr ($m->{message}, 1) eq 'owl' || substr ($m->{message}, 1) eq 'сова' || substr ($m->{message}, 1) eq 'сыч') { }
if ($m->{plugin} eq 'telegram') { } elsif ($cmd eq 'owl' || $cmd eq 'сова' || $cmd eq 'сыч') {
my $owl = Owl (); if (($m->{plugin} eq 'telegram') && $answer->{misc}->{msg_format}) {
$reply = sprintf '[{ O v O }](%s)', $owl; $reply = sprintf '[{ O v O }](%s)', Owl ();
$answer->{misc}->{msg_format} = 1;
} 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') { if (($m->{plugin} eq 'telegram') && $answer->{misc}->{msg_format}) {
my $rabbit = Rabbit (); $reply = sprintf '[(\_/)](%s)', Rabbit ();
$reply = sprintf '[(\_/)](%s)', $rabbit;
$answer->{misc}->{msg_format} = 1;
} 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') { if (($m->{plugin} eq 'telegram') && $answer->{misc}->{msg_format}) {
my @art = qw ('-'_@_ @╜ @_'-'); my @art = qw ('-'_@_ @╜ @_'-');
my $snail = Snail (); $reply = sprintf '[%s](%s)', $art [irand ($#art + 1)], Snail ();
$reply = sprintf '[%s](%s)', $art [irand ($#art + 1)], $snail;
$answer->{misc}->{msg_format} = 1;
} 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}) {
$reply = sprintf '[xkcd](%s)', Xkcd ();
} else {
$reply = Xkcd (); $reply = Xkcd ();
} elsif (substr ($m->{message}, 1, 2) eq 'w ' || substr ($m->{message}, 1, 2) eq 'п ') { }
my $city = substr $m->{message}, 2; } elsif ($cmd =~ /^(w|weather|п|погода|погодка|погадка)\s+(.+)$/gui) {
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 ();
@@ -161,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 ();
@@ -243,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;

39
lib/WebApp/Client.pm
View File

@@ -176,7 +176,7 @@ sub Buni {
@a = $p->get_tag ('meta'); ## no critic (Variables::RequireLocalizedPunctuationVars) @a = $p->get_tag ('meta'); ## no critic (Variables::RequireLocalizedPunctuationVars)
if (defined $a[0][1]->{property} && $a[0][1]->{property} eq 'og:image') { if (defined $a[0][1]->{property} && $a[0][1]->{property} eq 'og:image') {
$ret = sprintf '[buni](%s)', $a[0][1]->{content}; $ret = $a[0][1]->{content};
last; last;
} }
@@ -193,7 +193,7 @@ sub Drink {
my $r; my $r;
my $ret = 'Не знаю праздников - вджобываю весь день на шахтах, как проклятая.'; my $ret = 'Не знаю праздников - вджобываю весь день на шахтах, как проклятая.';
my ($dayNum, $monthNum) = (localtime ())[3, 4]; my ($dayNum, $monthNum) = (localtime ())[3, 4];
my $url = sprintf 'https://kakoysegodnyaprazdnik.ru/baza/%s/%s', $MONTH[$monthNum], $dayNum; my $url = 'https://prazdniki-segodnya.ru/';
# Those POSIX assholes just forgot to add unix timestamps without TZ offset, so... # Those POSIX assholes just forgot to add unix timestamps without TZ offset, so...
my ($mday, $mon, $year) = (gmtime ())[3, 4, 5]; my ($mday, $mon, $year) = (gmtime ())[3, 4, 5];
@@ -254,28 +254,33 @@ sub Drink {
if ($r->is_success) { if ($r->is_success) {
my $p = HTML::TokeParser->new(\$r->body); my $p = HTML::TokeParser->new(\$r->body);
my @a; my @a;
my @holyday; my %holiday;
do { do {
$#a = -1; $#a = -1;
@a = $p->get_tag('span'); ## no critic (Variables::RequireLocalizedPunctuationVars) @a = $p->get_tag ('div'); ## no critic (Variables::RequireLocalizedPunctuationVars)
if ($#{$a[0]} > 2 && defined $a[0][1]->{itemprop} && $a[0][1]->{itemprop} eq 'text') { if ($#{$a[0]} > 2) {
push @holyday,'* ' . decode ('UTF-8', $p->get_trimmed_text ('/span')); my @shitty_array = $a[0];
foreach my $item (@shitty_array) {
if (ref $item) {
foreach my $item1 (@{$item}) {
my %h = eval { %{$item1} };
if (defined ($h{class}) && $h{class} eq 'list-group-item text-monospace') {
$holiday {'* ' . decode ('UTF-8', $p->get_trimmed_text ('/div'))} = 1;
}
}
}
}
} }
} while ($#{$a[0]} > 1); } while ($#{$a[0]} > 1);
if ($#holyday > 0) { if (int (keys (%holiday)) > 0) {
# cut off something weird, definely not a "holyday" $ret = join "\n", sort (keys (%holiday));
$#holyday = $#holyday - 1;
}
if ($#holyday > 0) {
$ret = join "\n", @holyday;
} }
} else { } else {
$log->warn (sprintf '[WARN] Kakoysegodnyaprazdnik server return status %s with message: %s', $r->code, $r->message); $log->warn (sprintf '[WARN] prazdniki-segodnya.ru server return status %s with message: %s', $r->code, $r->message);
} }
return $ret; return $ret;
@@ -314,7 +319,7 @@ sub Monkeyuser {
} while ($#{$a[0]} > 1); } while ($#{$a[0]} > 1);
if ($#link > 0) { if ($#link > 0) {
$ret = sprintf '[MonkeyUser](https://www.monkeyuser.com%s)', $link [irand (1 + $#link)]; $ret = sprintf 'https://www.monkeyuser.com%s', $link [irand (1 + $#link)];
} }
} else { } else {
$log->warn (sprintf '[WARN] MonkeyUser server return status %s with message: %s', $r->{status}, $r->{reason}); $log->warn (sprintf '[WARN] MonkeyUser server return status %s with message: %s', $r->{status}, $r->{reason});
@@ -536,7 +541,7 @@ sub Xkcd {
} while ($c < 3 || $status >= 404); } while ($c < 3 || $status >= 404);
if ($status == 200) { if ($status == 200) {
return sprintf '[xkcd.ru](%s)', $location; return $location;
} }
return 'Комикс-стрип нарисовать не так-то просто :('; return 'Комикс-стрип нарисовать не так-то просто :(';