|
|
@@ -7,7 +7,7 @@ use Modern::Perl;
|
|
|
use utf8;
|
|
|
|
|
|
use EV;
|
|
|
-use Mojo::Base -strict, -signatures;
|
|
|
+use Mojo::Base -strict, -signatures, -async_await;
|
|
|
use Mojolicious::Lite;
|
|
|
use Mojo::UserAgent;
|
|
|
use Data::Dumper;
|
|
|
@@ -30,7 +30,7 @@ use darsan_auth;
|
|
|
use darsan_client;
|
|
|
use rabbit_async_rec;
|
|
|
use commands;
|
|
|
-use fsa;
|
|
|
+use rules;
|
|
|
use abon_client;
|
|
|
use localization;
|
|
|
|
|
|
@@ -122,7 +122,7 @@ get "/health" => sub
|
|
|
shift->render(text => "Abonbot OK");
|
|
|
};
|
|
|
|
|
|
-post "/:token" => sub
|
|
|
+post "/:token" => async sub
|
|
|
{
|
|
|
my $c = shift;
|
|
|
|
|
|
@@ -136,20 +136,20 @@ post "/:token" => sub
|
|
|
my $body = j($c->req->body);
|
|
|
#say Dumper $body;
|
|
|
|
|
|
- my ($from, $chatid, $cmd);
|
|
|
+ my ($chatid, $line, $from);
|
|
|
|
|
|
if (my $m = $body->{message} || $body->{edited_message})
|
|
|
{
|
|
|
$from = $m->{from};
|
|
|
$chatid = $from->{id};
|
|
|
- $cmd = $m->{text};
|
|
|
+ $line = $m->{text};
|
|
|
$from->{msgid} = $m->{message_id};
|
|
|
}
|
|
|
elsif ($m = $body->{callback_query})
|
|
|
{
|
|
|
$from = $m->{from};
|
|
|
$chatid = $from->{id};
|
|
|
- $cmd = $m->{data};
|
|
|
+ $line = $m->{data};
|
|
|
$from->{msgid} = $m->{message}->{message_id};
|
|
|
}
|
|
|
else
|
|
|
@@ -157,68 +157,45 @@ post "/:token" => sub
|
|
|
return $log->error("Unknown message type");
|
|
|
}
|
|
|
|
|
|
-say ">>> $cmd";
|
|
|
- restore_fsa_state($chatid, $from);
|
|
|
- process_input($cmd, $chatid, $from);
|
|
|
- save_fsa_state($chatid);
|
|
|
-};
|
|
|
+ say ">>> $line";
|
|
|
+
|
|
|
+ my $fsa = make_fsa($chatid, $from);
|
|
|
+ say "*** restore fsa: ", $fsa->state;
|
|
|
+
|
|
|
+ eval {
|
|
|
+ say "*** current state = ", $fsa->state, Dumper $fsa->notes;;
|
|
|
+ my $new_state = await $fsa->switch($line, $from);
|
|
|
+ say "*** switched to ", $new_state, Dumper $fsa->notes;
|
|
|
+ };
|
|
|
+ report($from, $@) if $@;
|
|
|
|
|
|
-=cut
|
|
|
-$VAR1 = {
|
|
|
- 'callback_query' => {
|
|
|
- 'data' => '32320/set-credit',
|
|
|
- 'from' => {
|
|
|
- 'id' => 311683401,
|
|
|
- 'username' => 'AntonMetelkin2',
|
|
|
- 'first_name' => "\x{410}\x{43d}\x{442}\x{43e}\x{43d}",
|
|
|
- 'language_code' => 'ru',
|
|
|
- 'last_name' => "\x{41c}\x{435}\x{442}\x{451}\x{43b}\x{43a}\x{438}\x{43d}",
|
|
|
- 'is_bot' => bless( do{\(my $o = 0)}, 'JSON::PP::Boolean' )
|
|
|
- },
|
|
|
- 'chat_instance' => '4165635351277858977',
|
|
|
- 'id' => '1338670018114168009',
|
|
|
- 'message' => {
|
|
|
- 'reply_markup' => {
|
|
|
- 'inline_keyboard' => [
|
|
|
- [
|
|
|
- {
|
|
|
- 'callback_data' => '32320/set-credit',
|
|
|
- 'text' => "\x{42f} \x{441}\x{43e}\x{433}\x{43b}\x{430}\x{441}\x{435}\x{43d} \x{441} \x{443}\x{441}\x{43b}\x{43e}\x{432}\x{438}\x{44f}\x{43c}\x{438}"
|
|
|
- }
|
|
|
- ]
|
|
|
- ]
|
|
|
- },
|
|
|
- 'text' => "\x{412}\x{44b} \x{43c}\x{43e}\x{436}\x{435}\x{442}\x{435} \x{441}\x{430}\x{43c}\x{43e}\x{441}\x{442}\x{43e}\x{44f}\x{442}\x{435}\x{43b}\x{44c}\x{43d}\x{43e} \x{443}\x{441}\x{442}\x{430}\x{43d}\x{43e}\x{432}\x{438}\x{442}\x{44c} \x{43a}\x{440}\x{435}\x{434}\x{438}\x{442} \x{43d}\x{430} \x{434}\x{432}\x{430} \x{434}\x{43d}\x{44f}
|
|
|
-\x{41e}\x{433}\x{440}\x{430}\x{43d}\x{438}\x{447}\x{435}\x{43d}\x{438}\x{44f}: \x{442}\x{43e}\x{43b}\x{44c}\x{43a}\x{43e} \x{434}\x{43b}\x{44f} \x{444}\x{438}\x{437}\x{438}\x{447}\x{435}\x{441}\x{43a}\x{438}\x{445} \x{43b}\x{438}\x{446}, \x{43f}\x{440}\x{43e}\x{434}\x{43b}\x{435}\x{432}\x{430}\x{442}\x{44c} \x{43a}\x{440}\x{435}\x{434}\x{438}\x{442} \x{43f}\x{43e}\x{432}\x{442}\x{43e}\x{440}\x{43d}\x{43e} \x{434}\x{43e} \x{43e}\x{43f}\x{43b}\x{430}\x{442}\x{44b} \x{43d}\x{435}\x{43b}\x{44c}\x{437}\x{44f}. \x{41f}\x{440}\x{438} \x{441}\x{43b}\x{435}\x{434}\x{443}\x{44e}\x{449}\x{435}\x{439} \x{43e}\x{43f}\x{43b}\x{430}\x{442}\x{435} \x{43a}\x{440}\x{435}\x{434}\x{438}\x{442} \x{431}\x{443}\x{434}\x{435}\x{442} \x{43f}\x{43e}\x{433}\x{430}\x{448}\x{435}\x{43d}",
|
|
|
- 'entities' => [
|
|
|
- {
|
|
|
- 'type' => 'bold',
|
|
|
- 'offset' => 54,
|
|
|
- 'length' => 11
|
|
|
- }
|
|
|
- ],
|
|
|
- 'message_id' => 995,
|
|
|
- 'chat' => {
|
|
|
- 'last_name' => "\x{41c}\x{435}\x{442}\x{451}\x{43b}\x{43a}\x{438}\x{43d}",
|
|
|
- 'id' => 311683401,
|
|
|
- 'type' => 'private',
|
|
|
- 'username' => 'AntonMetelkin2',
|
|
|
- 'first_name' => "\x{410}\x{43d}\x{442}\x{43e}\x{43d}"
|
|
|
- },
|
|
|
- 'from' => {
|
|
|
- 'is_bot' => bless( do{\(my $o = 1)}, 'JSON::PP::Boolean' ),
|
|
|
- 'first_name' => "\x{41c}\x{430}\x{43a}\x{435}\x{435}\x{432}\x{43a}\x{430}-\x{41e}\x{43d}\x{43b}\x{430}\x{439}\x{43d}",
|
|
|
- 'id' => 7443432620,
|
|
|
- 'username' => 'MolAbonBot'
|
|
|
- },
|
|
|
- 'date' => 1723730668
|
|
|
- }
|
|
|
- },
|
|
|
- 'update_id' => 292858034
|
|
|
- };
|
|
|
+ save_fsa($fsa, $chatid);
|
|
|
+};
|
|
|
|
|
|
-=cut
|
|
|
+sub report($info, $err)
|
|
|
+{
|
|
|
+ if (ref $err eq "Mojo::Exception")
|
|
|
+ {
|
|
|
+ return secret_error($info, $err->message . Dumper $err->line);
|
|
|
+ }
|
|
|
+
|
|
|
+ if (ref $err eq "HASH" && exists $err->{code} && $err->{code}>=400 && $err->{code}<500 && ref $err->{body} eq "HASH")
|
|
|
+ {
|
|
|
+ reply($info, $err->{body}->{text_ru} || $err->{body}->{text});
|
|
|
+ }
|
|
|
+ else
|
|
|
+ {
|
|
|
+ secret_error($info, Dumper $err);
|
|
|
+ }
|
|
|
+}
|
|
|
|
|
|
+sub secret_error($info, $str)
|
|
|
+{
|
|
|
+ my $code = int(rand(10000));
|
|
|
+ $log->error("====== $code");
|
|
|
+ $log->error($str);
|
|
|
+ reply($info, _("Произошла ошибка. Сообщите в службу технической поддержки код") . " $code");
|
|
|
+}
|
|
|
|
|
|
##################################
|
|
|
|
|
|
@@ -274,31 +251,27 @@ sub request
|
|
|
});
|
|
|
}
|
|
|
|
|
|
-sub notify
|
|
|
+sub notify($info, $message, $args={})
|
|
|
{
|
|
|
- my $chatid = shift;
|
|
|
- my $message = shift;
|
|
|
- my $rest = shift || {};
|
|
|
-
|
|
|
my $params = {
|
|
|
- chat_id => $chatid,
|
|
|
+ chat_id => $info->{id},
|
|
|
text => $message,
|
|
|
disable_web_page_preview => 1,
|
|
|
};
|
|
|
|
|
|
$params->{parse_mode} ||= "HTML";
|
|
|
- $params->{reply_to} = $rest->{reply_to} if $rest->{reply_to};
|
|
|
- $params->{disable_notification} = 1 if $rest->{silent};
|
|
|
+ $params->{reply_to} = $args->{reply_to} if $args->{reply_to};
|
|
|
+ $params->{disable_notification} = 1 if $args->{silent};
|
|
|
|
|
|
- if ($rest->{menu})
|
|
|
+ if ($args->{menu})
|
|
|
{
|
|
|
- $params->{reply_markup} = { keyboard => $rest->{menu} };
|
|
|
+ $params->{reply_markup} = { keyboard => $args->{menu} };
|
|
|
$params->{resize_keyboard} = Mojo::JSON->true;
|
|
|
}
|
|
|
|
|
|
- if ($rest->{inline_menu})
|
|
|
+ if ($args->{inline_menu})
|
|
|
{
|
|
|
- $params->{reply_markup} = { inline_keyboard => $rest->{inline_menu} };
|
|
|
+ $params->{reply_markup} = { inline_keyboard => $args->{inline_menu} };
|
|
|
}
|
|
|
|
|
|
my $disable_error_handler = delete $params->{disable_error_handler};
|
|
|
@@ -320,62 +293,43 @@ sub notify
|
|
|
return $promise;
|
|
|
}
|
|
|
|
|
|
-sub reply($rec, @lines)
|
|
|
+sub reply($info, @lines)
|
|
|
{
|
|
|
- return notify($rec->{id}, join("\n", @lines), {reply_to=>$rec->{msgid}});
|
|
|
+ return notify($info, join("\n", @lines), {reply_to=>$info->{msgid}});
|
|
|
}
|
|
|
|
|
|
-sub reply_with($rec, $params, @lines)
|
|
|
+sub reply_with($info, $params, @lines)
|
|
|
{
|
|
|
- $params->{reply_to} = $rec->{msgid};
|
|
|
- return notify($rec->{id}, join("\n", @lines), $params);
|
|
|
+ $params->{reply_to} = $info->{msgid};
|
|
|
+ return notify($info, join("\n", @lines), $params);
|
|
|
}
|
|
|
|
|
|
#################################
|
|
|
|
|
|
-sub do_command
|
|
|
+async sub do_command
|
|
|
{
|
|
|
- my $cmd = shift;
|
|
|
- my $chatid = shift;
|
|
|
- my $rest = shift;
|
|
|
+ my ($fsa, $cmd, $info) = @_;
|
|
|
|
|
|
- local($Data::Dumper::Terse) = 1;
|
|
|
+ if ($info->{id}<0)
|
|
|
+ {
|
|
|
+ return reply($info, _("Этот бот не работает в чатах"));
|
|
|
+ }
|
|
|
|
|
|
my ($c,@args) = split(/\s+/,$cmd);
|
|
|
- $c =~ s|^/||;
|
|
|
$c =~ s/\@MolAbonbotBot$//;
|
|
|
-
|
|
|
- if ($chatid<0)
|
|
|
- {
|
|
|
- return notify($chatid, _("Этот бот не работает в чатах"), $rest);
|
|
|
- }
|
|
|
|
|
|
- my $sub = refpath("command_$c");
|
|
|
+ my $prefix = substr($c, 0, 1) eq "\x00" ? "callback" : "command";
|
|
|
+ $c =~ s|^\x00||;
|
|
|
+ $c =~ s|^/||;
|
|
|
+
|
|
|
+ my $sub = refpath("${prefix}_$c");
|
|
|
|
|
|
unless ($sub)
|
|
|
{
|
|
|
- return notify($chatid, _("Неизвестная команда"), $rest);
|
|
|
+ return reply($info, _("Неизвестная команда"));
|
|
|
}
|
|
|
|
|
|
- my $state;
|
|
|
- eval {
|
|
|
- my $res = $sub->($chatid, $fsa->notes("uid"), $rest);
|
|
|
- if (ref $res eq "Mojo::Promise")
|
|
|
- {
|
|
|
- $res->catch(sub($err)
|
|
|
- {
|
|
|
- $log->error(Dumper $err);
|
|
|
- });
|
|
|
- }
|
|
|
- };
|
|
|
-
|
|
|
- if ($@)
|
|
|
- {
|
|
|
- my $msg = ref $@ eq "HASH" ? Dumper($@) : $@;
|
|
|
- $log->error("$cmd from $chatid: $msg");
|
|
|
- notify($chatid, "Ошибка при выполнении команды $cmd: $msg");
|
|
|
- return;
|
|
|
- }
|
|
|
+ await $sub->($fsa, $info);
|
|
|
}
|
|
|
|
|
|
sub refpath
|
|
|
@@ -392,11 +346,6 @@ sub reference
|
|
|
return exists(&{$name}) ? \&{$name} : undef;
|
|
|
}
|
|
|
|
|
|
-sub make_key($id, $type)
|
|
|
-{
|
|
|
- return "ab-$id-$type";
|
|
|
-}
|
|
|
-
|
|
|
sub _loc($lang, $str)
|
|
|
{
|
|
|
return $str unless exists $locale_handles->{$lang};
|
|
|
@@ -405,6 +354,7 @@ sub _loc($lang, $str)
|
|
|
|
|
|
sub _($str)
|
|
|
{
|
|
|
+ return $str; #!!!
|
|
|
return _loc($fsa->notes("lang") || "ru", $str);
|
|
|
}
|
|
|
|