abonbot/telegram.pl

#!/usr/bin/perl

# Бот и рассыльщик сообщений для Телеграм
# Ю. Жиловец, 6 ноября 2016 года
# 257663755 - это я
# -166458164 - чат MOL Prog

use Modern::Perl;
use utf8;

use EV;
use AnyEvent;
use Mojolicious::Lite;
use Mojo::UserAgent;
use Data::Dumper;
use Promises qw/deferred/;
use Mojo::JSON qw/j/;

my $NAME = "telegram";
my $confdir = "config/".app->mode;

use FindBin qw/$Bin/;
use lib "$Bin/lib";

use rabbit_async_rec;

plugin yaml_config => {
  file      => "$confdir/$NAME.cfg",
  stash_key => 'config',
};

our $config = app->config;

app->secrets(["Marsz, Marsz, Dabrowski"]);

my $log = new Mojo::Log;

my $term;
my $int;
my $hup;

my $rabbit;
Mojo::IOLoop->next_tick(sub 
{  
  $term = AnyEvent->signal(signal => "TERM", cb => \&terminate);
  $int = AnyEvent->signal(signal => "INT", cb => \&terminate);
  $hup = AnyEvent->signal(signal => "HUP", cb => \&terminate);

  $config->{rabbit}->{on_error} = sub { $log->error("[rabbit]".@_); terminate() };

  my $rabbit_args = $config->{rabbit};
  $rabbit_args->{product} = $NAME;

  $rabbit = new rabbit_async_rec($rabbit_args, sub
  {
    $rabbit->listen_queue($config->{queue}, $config->{bind}, \&incoming_message);
  });
});
                            
##########################

my $ua = new Mojo::UserAgent;
$ua->max_redirects(5);

##########################

=cut
hook before_dispatch => sub
{
  my $c = shift;
  say $c->req->to_string;
};
        
hook after_dispatch => sub
{
  my $c = shift;
  say $c->res->to_string;
};
=cut

##########################

get "/health" => sub
{
  shift->render(text => "Telegram OK");
};

post "/:token" => sub
{
  my $c = shift;
  
  unless ($c->param("token") eq $config->{token})
  {
    return $c->render(status=>401, text=>"Request from unknown URL");
  }
  
  my $body = j($c->req->body);
  my $m = $body->{message};
  
  my $chatid = $m->{chat}->{id};
  my $from = ($m->{from}->{first_name}||"") . " " . ($m->{from}->{last_name}||"") . " (" . ($m->{from}->{username}||"") . ")";
  my $cmd = $m->{text};
  my $msgid = $m->{message_id};
  
  $c->render(text=>"ok");
  
  do_command($cmd, $chatid, {msgid=>$msgid, from=>$from});
};

sub incoming_message
{
  my $m = shift;
  my $body = $m->{content};
  $log->debug($m->{routing_key}." ".Dumper($m->{content})) if $config->{debug};

  my $rk = $m->{routing_key};
  $rk =~ s/\./::/g;
  my $sub = reference($rk);
              
  unless ($sub)
  {
    $log->error("Unknown message: ".$rk);
    $rabbit->reject($m);
    return;
  }
                    
  eval {
    $sub->($body,$m);
  };

  if ($@)
  {
    $log->error(Dumper $@);
    $rabbit->reject($m);
  }
  else
  {
    $rabbit->ack($m);
    $log->debug("acknowledged") if $config->{debug};
  }
}

sub notify::telegram::send
{
  my $body = shift;
  my $to = $body->{to};
  $to = [ $to ] unless ref($to) eq "ARRAY";
  
  foreach (@$to)
  {
    notify($_, $body->{message}, $body);
  }
}

############################

sub command::help
{
  my $cmd = shift;
  my $args = shift;
  my $chatid = shift;
  my $rest = shift;
  
  notify($chatid,"*/my_id* Узнать свой идентификатор в Телеграме", $rest);
}

sub command::my_id
{
  my $cmd = shift;
  my $args = shift;
  my $chatid = shift;
  my $rest = shift;
  
  notify($chatid,"Ваш идентификатор в Телеграме: *$chatid*", $rest);
}

sub command::start
{
  my $cmd = shift;
  my $args = shift;
  my $chatid = shift;
  my $rest = shift;
  
  notify($chatid, "$config->{title}.\nДля получения списка команд наберите */help*");
}

#sub command::credit
#sub command::balance


############################

sub do_command
{
  my $cmd = shift;
  my $chatid = shift;
  my $rest = shift;
  
  my ($c,@args) = split(/ /,$cmd);
  $c =~ s|^/||;
  
  my $sub = reference("command::$c");
  unless ($sub)
  {
    return notify($chatid, "Неизвестная команда. Введите */help*, чтобы увидеть список команд", $rest);
  }
  
  eval {
    $sub->($c, \@args, $chatid, $rest);
  };
  
  if ($@)
  {
    $log->error("$cmd from $chatid [$rest->{from}]: $@");
    notify($chatid, "Ошибка при выполнении команды", $rest);
    return;
  }
}

sub terminate
{
  request("setWebhook",{url=>""})->then(sub
  {
    exit(0);
  })->catch(sub
  {
    $log->error(Dumper @_);
  });
}

sub request
{
  my $action = shift;
  my $params = shift;

  my $deferred = deferred;
  $ua->post("https://api.telegram.org/bot$config->{token}/$action" => form => $params => sub
  {
    my ($ua, $tx) = @_;
    my $resp = $tx->result;
         
    if ($resp->is_error)
    {
       my $err = {};
       $err->{code} = $resp->code;
       $err->{url} = $tx->req->url->to_string;
       $err->{body} = $resp->body;
       $err->{body} = j($err->{body}) if $resp->headers->content_type eq "application/json";
       $deferred->reject($err);
     }
     else
     {
       my $body = $resp->body;
       $body = j($body) if $resp->headers->content_type eq "application/json";
       $deferred->resolve($body);
     }
   });
  
  return $deferred->promise;
}

sub notify
{
  my $chatid = shift;
  my $message = shift;
  my $rest = shift || {};
  
  my $params = {
    chat_id => $chatid,
    text => $message,
  };
  
  $params->{parse_mode} = "Markdown" unless $rest->{parse_mode} && $rest->{parse_mode} eq "none";
  $params->{reply_to_message_id} = $rest->{msgid} if $rest->{msgid};
  
  return request("sendMessage", $params)->catch(sub
  {
    $log->error(Dumper $params,@_);
  });
}

sub refpath
{
  my $name = shift;
  $name =~ tr/.-/_/;
  $name =~ s|/|::|g;
  return reference($name);
}
        
sub reference
{
  my $name = shift;
  return exists(&{$name}) ? \&{$name} : undef;
}

##################################

$log->info("Started (".app->mode.")");

request("setWebhook",{url=>""})->then(sub
{
  $log->info("Webhook to $config->{webhook}");
  return request("setWebhook",{url=>"$config->{webhook}/$config->{token}"});
})->catch(sub
{
  $log->error(Dumper @_);
});

app->start;