|
@@ -16,6 +16,7 @@ use Mojo::JSON qw/j/;
|
|
|
use NetAddr::IP;
|
|
use NetAddr::IP;
|
|
|
use HTML::Restrict;
|
|
use HTML::Restrict;
|
|
|
use Attribute::Handlers;
|
|
use Attribute::Handlers;
|
|
|
|
|
+use Redis;
|
|
|
|
|
|
|
|
use FindBin qw/$Bin/;
|
|
use FindBin qw/$Bin/;
|
|
|
use lib "$Bin/lib";
|
|
use lib "$Bin/lib";
|
|
@@ -67,13 +68,24 @@ my $term;
|
|
|
my $int;
|
|
my $int;
|
|
|
my $hup;
|
|
my $hup;
|
|
|
|
|
|
|
|
-Mojo::IOLoop->next_tick(sub
|
|
|
|
|
-{
|
|
|
|
|
|
|
+our $redis;
|
|
|
|
|
+
|
|
|
|
|
+if ($config->{redis} =~ m|/|)
|
|
|
|
|
+{
|
|
|
|
|
+ $redis = Redis->new(sock => $config->{redis}, name=>"poller");
|
|
|
|
|
+}
|
|
|
|
|
+else
|
|
|
|
|
+{
|
|
|
|
|
+ $redis = Redis->new(server => $config->{redis}, name=>"poller");
|
|
|
|
|
+}
|
|
|
|
|
+
|
|
|
|
|
+Mojo::IOLoop->next_tick(sub
|
|
|
|
|
+{
|
|
|
$term = AnyEvent->signal(signal => "TERM", cb => \&terminate);
|
|
$term = AnyEvent->signal(signal => "TERM", cb => \&terminate);
|
|
|
$int = AnyEvent->signal(signal => "INT", cb => \&terminate);
|
|
$int = AnyEvent->signal(signal => "INT", cb => \&terminate);
|
|
|
$hup = AnyEvent->signal(signal => "HUP", cb => \&terminate);
|
|
$hup = AnyEvent->signal(signal => "HUP", cb => \&terminate);
|
|
|
});
|
|
});
|
|
|
-
|
|
|
|
|
|
|
+
|
|
|
##########################
|
|
##########################
|
|
|
|
|
|
|
|
my $ua = new Mojo::UserAgent;
|
|
my $ua = new Mojo::UserAgent;
|
|
@@ -87,7 +99,7 @@ hook before_dispatch => sub
|
|
|
my $c = shift;
|
|
my $c = shift;
|
|
|
say $c->req->to_string;
|
|
say $c->req->to_string;
|
|
|
};
|
|
};
|
|
|
-
|
|
|
|
|
|
|
+
|
|
|
hook after_dispatch => sub
|
|
hook after_dispatch => sub
|
|
|
{
|
|
{
|
|
|
my $c = shift;
|
|
my $c = shift;
|
|
@@ -107,12 +119,12 @@ post "/:token" => sub
|
|
|
my $c = shift;
|
|
my $c = shift;
|
|
|
|
|
|
|
|
$c->render(text=>"ok");
|
|
$c->render(text=>"ok");
|
|
|
-
|
|
|
|
|
|
|
+
|
|
|
unless ($c->param("token") eq $config->{token})
|
|
unless ($c->param("token") eq $config->{token})
|
|
|
{
|
|
{
|
|
|
return $c->render(status=>401, text=>"Request from unknown URL");
|
|
return $c->render(status=>401, text=>"Request from unknown URL");
|
|
|
}
|
|
}
|
|
|
-
|
|
|
|
|
|
|
+
|
|
|
my $body = j($c->req->body);
|
|
my $body = j($c->req->body);
|
|
|
my $m = $body->{message} || $body->{edited_message};
|
|
my $m = $body->{message} || $body->{edited_message};
|
|
|
|
|
|
|
@@ -122,13 +134,13 @@ post "/:token" => sub
|
|
|
{
|
|
{
|
|
|
return notify($chatid, "Общение с ботом возможно только в чате");
|
|
return notify($chatid, "Общение с ботом возможно только в чате");
|
|
|
}
|
|
}
|
|
|
-
|
|
|
|
|
|
|
+
|
|
|
my $from = $m->{from};
|
|
my $from = $m->{from};
|
|
|
my $cmd = $m->{text};
|
|
my $cmd = $m->{text};
|
|
|
my $msgid = $m->{message_id};
|
|
my $msgid = $m->{message_id};
|
|
|
-
|
|
|
|
|
|
|
+
|
|
|
return unless substr($cmd, 0, 1) eq "/"; # Бот не должен мешать общению, даже если его добавили админом
|
|
return unless substr($cmd, 0, 1) eq "/"; # Бот не должен мешать общению, даже если его добавили админом
|
|
|
-
|
|
|
|
|
|
|
+
|
|
|
do_command($cmd, $chatid, {msgid=>$msgid, from=>$from});
|
|
do_command($cmd, $chatid, {msgid=>$msgid, from=>$from});
|
|
|
};
|
|
};
|
|
|
|
|
|
|
@@ -155,7 +167,7 @@ sub request
|
|
|
{
|
|
{
|
|
|
my $tx = shift;
|
|
my $tx = shift;
|
|
|
my $resp = $tx->result;
|
|
my $resp = $tx->result;
|
|
|
-
|
|
|
|
|
|
|
+
|
|
|
if ($resp->is_error)
|
|
if ($resp->is_error)
|
|
|
{
|
|
{
|
|
|
my $err = {};
|
|
my $err = {};
|
|
@@ -179,24 +191,24 @@ sub notify
|
|
|
my $chatid = shift;
|
|
my $chatid = shift;
|
|
|
my $message = shift;
|
|
my $message = shift;
|
|
|
my $rest = shift || {};
|
|
my $rest = shift || {};
|
|
|
-
|
|
|
|
|
|
|
+
|
|
|
my $params = {
|
|
my $params = {
|
|
|
chat_id => $chatid,
|
|
chat_id => $chatid,
|
|
|
text => $message,
|
|
text => $message,
|
|
|
disable_web_page_preview => 1,
|
|
disable_web_page_preview => 1,
|
|
|
};
|
|
};
|
|
|
-
|
|
|
|
|
|
|
+
|
|
|
$params->{parse_mode} ||= "HTML";
|
|
$params->{parse_mode} ||= "HTML";
|
|
|
$params->{reply_to_message_id} = $rest->{reply_to} if $rest->{reply_to};
|
|
$params->{reply_to_message_id} = $rest->{reply_to} if $rest->{reply_to};
|
|
|
$params->{disable_notification} = 1 if $rest->{silent};
|
|
$params->{disable_notification} = 1 if $rest->{silent};
|
|
|
|
|
|
|
|
my $disable_error_handler = delete $params->{disable_error_handler};
|
|
my $disable_error_handler = delete $params->{disable_error_handler};
|
|
|
-
|
|
|
|
|
|
|
+
|
|
|
if ($params->{parse_mode} eq "HTML")
|
|
if ($params->{parse_mode} eq "HTML")
|
|
|
{
|
|
{
|
|
|
$params->{text} = $html_strip->process($params->{text});
|
|
$params->{text} = $html_strip->process($params->{text});
|
|
|
}
|
|
}
|
|
|
-
|
|
|
|
|
|
|
+
|
|
|
my $promise = request("sendMessage", $params);
|
|
my $promise = request("sendMessage", $params);
|
|
|
unless ($disable_error_handler)
|
|
unless ($disable_error_handler)
|
|
|
{
|
|
{
|
|
@@ -205,7 +217,7 @@ sub notify
|
|
|
$log->error(Dumper $params,@_);
|
|
$log->error(Dumper $params,@_);
|
|
|
});
|
|
});
|
|
|
}
|
|
}
|
|
|
-
|
|
|
|
|
|
|
+
|
|
|
return $promise;
|
|
return $promise;
|
|
|
}
|
|
}
|
|
|
|
|
|
|
@@ -216,9 +228,9 @@ sub do_command
|
|
|
my $cmd = shift;
|
|
my $cmd = shift;
|
|
|
my $chatid = shift;
|
|
my $chatid = shift;
|
|
|
my $rest = shift;
|
|
my $rest = shift;
|
|
|
-
|
|
|
|
|
|
|
+
|
|
|
local($Data::Dumper::Terse) = 1;
|
|
local($Data::Dumper::Terse) = 1;
|
|
|
-
|
|
|
|
|
|
|
+
|
|
|
my ($c,@args) = split(/\s+/,$cmd);
|
|
my ($c,@args) = split(/\s+/,$cmd);
|
|
|
$c =~ s|^/||;
|
|
$c =~ s|^/||;
|
|
|
$c =~ s/\@MolDjinnBot$//;
|
|
$c =~ s/\@MolDjinnBot$//;
|
|
@@ -229,11 +241,11 @@ sub do_command
|
|
|
{
|
|
{
|
|
|
return notify($chatid, "Неизвестная команда. Введите <b>/help</b>, чтобы увидеть список команд", $rest);
|
|
return notify($chatid, "Неизвестная команда. Введите <b>/help</b>, чтобы увидеть список команд", $rest);
|
|
|
}
|
|
}
|
|
|
-
|
|
|
|
|
|
|
+
|
|
|
eval {
|
|
eval {
|
|
|
$sub->($c, \@args, $chatid, $rest);
|
|
$sub->($c, \@args, $chatid, $rest);
|
|
|
};
|
|
};
|
|
|
-
|
|
|
|
|
|
|
+
|
|
|
if ($@)
|
|
if ($@)
|
|
|
{
|
|
{
|
|
|
my $msg = ref $@ eq "HASH" ? Dumper($@) : $@;
|
|
my $msg = ref $@ eq "HASH" ? Dumper($@) : $@;
|
|
@@ -250,7 +262,7 @@ sub refpath
|
|
|
$name =~ s|/|::|g;
|
|
$name =~ s|/|::|g;
|
|
|
return reference($name);
|
|
return reference($name);
|
|
|
}
|
|
}
|
|
|
-
|
|
|
|
|
|
|
+
|
|
|
sub reference
|
|
sub reference
|
|
|
{
|
|
{
|
|
|
my $name = shift;
|
|
my $name = shift;
|