+ /info

+ /balance
+ /services

abonbot.pl

@@ -1,13 +1,13 @@
 #!/usr/bin/perl
 
-# Бот-исполнитель запросов техподдержки
-# Ю. Жиловец, 11 января 2023 года
+# Бот для абонентов
+# Ю. Жиловец, 29 мая 2024 года
 
 use Modern::Perl;
 use utf8;
 
 use EV;
-use AnyEvent;
+use Mojo::Base -strict, -signatures;
 use Mojolicious::Lite;
 use Mojo::UserAgent;
 use Data::Dumper;
@@ -15,8 +15,12 @@ use Mojo::Promise;
 use Mojo::JSON qw/j/;
 use NetAddr::IP;
 use HTML::Restrict;
-use Attribute::Handlers;
 use Redis;
+use Mojo::Promise;
+use Time::timegm qw/timegm/;
+use POSIX::strptime;
+
+use experimental qw/signatures/;
 
 use FindBin qw/$Bin/;
 use lib "$Bin/lib";
@@ -24,18 +28,15 @@ use lib "$Bin/modules";
 
 use darsan_auth;
 use darsan_client;
-
-our $log = Mojo::Log->new;
-our %aliases;
-
-use alias;
+use rabbit_async_rec;
 use commands;
+use fsa;
+use abon_client;
+use localization;
 
-my $NAME = "djinn";
+my $NAME = "abonbot";
 my $confdir = app->home.'/config/'.app->mode;
 
-use rabbit_async_rec;
-
 plugin yaml_config => {
   file      => "$confdir/$NAME.cfg",
   stash_key => 'config',
@@ -63,21 +64,17 @@ my $html_strip = HTML::Restrict->new(rules => {
 
 my $auth   = darsan_auth->as_server($config->{darsan}->{auth}, "system", "$confdir/system.private");
 our $client = darsan_client->new($auth, $config->{darsan}->{servers});
+$client->map($config->{darsan_map}) if $config->{darsan_map};
+
+our $redis = Redis->new(server => $config->{redis}, name=>"abonbot");
+
+our $abon_client = abon_client->new;
 
 my $term;
 my $int;
 my $hup;
 
-our $redis;
-
-if ($config->{redis} =~ m|/|)
-{
-  $redis = Redis->new(sock => $config->{redis}, name=>"poller");
-}
-else
-{
-  $redis = Redis->new(server => $config->{redis}, name=>"poller");
-}
+my $log = new Mojo::Log;
 
 Mojo::IOLoop->next_tick(sub
 {
@@ -91,6 +88,17 @@ Mojo::IOLoop->next_tick(sub
 my $ua = new Mojo::UserAgent;
 $ua->max_redirects(5);
 
+our $fsa;
+our $commands;
+
+my $locale_dir = "$Bin/locale";
+my $locales = localization::available_locales($locale_dir);
+my $locale_handles = localization->add_mo($locale_dir, $locales);
+
+our $kb_menu = [[
+  map { _($_->{name}) } grep {!$_->{hide_in_kb}} @$commands,
+]];
+
 ##########################
 
 =cut
@@ -111,38 +119,106 @@ hook after_dispatch => sub
 
 get "/health" => sub
 {
-  shift->render(text => "Djinn OK");
+  shift->render(text => "Abonbot OK");
 };
 
 post "/:token" => sub
 {
   my $c = shift;
 
-  $c->render(text=>"ok");
-
   unless ($c->param("token") eq $config->{token})
   {
     return $c->render(status=>401, text=>"Request from unknown URL");
   }
+  
+  $c->render(text=>"ok");
 
   my $body = j($c->req->body);
-  my $m = $body->{message} || $body->{edited_message};
-
-  my $chatid = $m->{chat}->{id};
+#say Dumper $body;
 
-  if ($m->{chat}->{type} ne "supergroup")
+  my ($from, $chatid, $cmd);
+  
+  if (my $m = $body->{message} || $body->{edited_message})
+  {
+    $from = $m->{from};
+    $chatid = $from->{id};
+    $cmd = $m->{text};
+    $from->{msgid} = $m->{message_id};
+  }
+  elsif ($m = $body->{callback_query})
+  {
+    $from = $m->{from};
+    $chatid = $from->{id};
+    $cmd = $m->{data};
+    $from->{msgid} = $m->{message}->{message_id};
+  }
+  else
   {
-    return notify($chatid, "Общение с ботом возможно только в чате");
+    return $log->error("Unknown message type");
   }
+  
+say ">>> $cmd";
+  restore_fsa_state($chatid, $from);
+  process_input($cmd, $chatid, $from);
+  save_fsa_state($chatid);
+};
 
-  my $from = $m->{from};
-  my $cmd = $m->{text};
-  my $msgid = $m->{message_id};
+=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
+        };
 
-  return unless substr($cmd, 0, 1) eq "/"; # Бот не должен мешать общению, даже если его добавили админом
+=cut
 
-  do_command($cmd, $chatid, {msgid=>$msgid, from=>$from});
-};
 
 ##################################
 
@@ -162,7 +238,7 @@ sub request
   my $action = shift;
   my $params = shift;
 
-  return $ua->post_p("https://api.telegram.org/bot$config->{token}/$action" => form => $params)
+   $ua->post_p("https://api.telegram.org/bot$config->{token}/$action" => json => $params)
   ->then(sub
   {
     my $tx = shift;
@@ -175,7 +251,7 @@ sub request
        $err->{url} = $tx->req->url->to_string;
        $err->{body} = $resp->body;
        $err->{body} = j($err->{body}) if $resp->headers->content_type eq "application/json";
-       die $err;
+       $log->error(Dumper $err);
      }
      else
      {
@@ -183,6 +259,18 @@ sub request
        $body = j($body) if $resp->headers->content_type eq "application/json";
        $body;
      }
+   })
+   ->catch(sub 
+   {
+     my $tx = shift;
+     my $resp = $tx->result;
+ 
+     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";
+     $log->error(Dumper $err);
    });
 }
 
@@ -199,9 +287,20 @@ sub notify
   };
 
   $params->{parse_mode} ||= "HTML";
-  $params->{reply_to_message_id} = $rest->{reply_to} if $rest->{reply_to};
+  $params->{reply_to} = $rest->{reply_to} if $rest->{reply_to};
   $params->{disable_notification} = 1 if $rest->{silent};
 
+  if ($rest->{menu})
+  {
+    $params->{reply_markup} = { keyboard => $rest->{menu} };
+    $params->{resize_keyboard} = Mojo::JSON->true;
+  }
+
+  if ($rest->{inline_menu})
+  {
+    $params->{reply_markup} = { inline_keyboard => $rest->{inline_menu} };
+  }
+
   my $disable_error_handler = delete $params->{disable_error_handler};
 
   if ($params->{parse_mode} eq "HTML")
@@ -221,6 +320,17 @@ sub notify
   return $promise;
 }
 
+sub reply($rec, @lines)
+{
+  return notify($rec->{id}, join("\n", @lines), {reply_to=>$rec->{msgid}});
+}
+
+sub reply_with($rec, $params, @lines)
+{
+  $params->{reply_to} = $rec->{msgid};
+  return notify($rec->{id}, join("\n", @lines), $params);
+}
+
 #################################
 
 sub do_command
@@ -233,17 +343,30 @@ sub do_command
 
   my ($c,@args) = split(/\s+/,$cmd);
   $c =~ s|^/||;
-  $c =~ s/\@MolDjinnBot$//;
+  $c =~ s/\@MolAbonbotBot$//;
+  
+  if ($chatid<0)
+  {
+    return notify($chatid, _("Этот бот не работает в чатах"), $rest);
+  }
 
-  my $sub = reference("command_$c") || $aliases{$c};
+  my $sub = refpath("command_$c");
 
   unless ($sub)
   {
-    return notify($chatid, "Неизвестная команда. Введите <b>/help</b>, чтобы увидеть список команд", $rest);
+    return notify($chatid, _("Неизвестная команда"), $rest);
   }
 
+  my $state;
   eval {
-    $sub->($c, \@args, $chatid, $rest);
+    my $res = $sub->($chatid, $fsa->notes("uid"), $rest);
+    if (ref $res eq "Mojo::Promise")
+    {
+      $res->catch(sub($err)
+      {
+        $log->error(Dumper $err);
+      });
+    }
   };
 
   if ($@)
@@ -269,6 +392,58 @@ 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};
+  return $locale_handles->{$lang}->maketext($str);
+}
+
+sub _($str)
+{
+  return _loc($fsa->notes("lang") || "ru", $str);
+}
+
+sub parse_time 
+{
+  no warnings;
+  my $s           = shift;
+  my $time_format = "%Y-%m-%d %H:%M:%S%z";
+
+  $s =~ /([+-])(\d{4})$/;
+  my $tz_sign = $1;
+  my $tz      = $2;
+  $s =~ s/[+-]\d{4}$//;
+
+  my $time = timegm(POSIX::strptime($s, $time_format));
+
+  if ($tz) {
+    my $h      = substr($tz, 0, 2);
+    my $s      = substr($tz, 2, 2);
+    my $offset = ($h * 60 + $s) * 60;
+    $offset    = -$offset if $tz_sign eq "+";
+    $time      += $offset;
+  }
+
+  return $time;
+}
+
+sub format_time($str)
+{
+  my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(parse_time($str));
+  return sprintf("%2d.%02d.%d %2d:%02d", $mday, $mon+1, $year+1900, $hour, $min);
+}
+
+sub format_date($str)
+{
+  my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(parse_time($str));
+  return sprintf("%2d.%02d.%d", $mday, $mon+1, $year+1900);
+}
+
 ######################################
 
 $log->info("Started (".app->mode.")");
@@ -277,7 +452,23 @@ request("setWebhook",{url=>""})->then(sub
 {
   $log->info("Webhook to $config->{webhook}");
   return request("setWebhook", {url=>"$config->{webhook}/$config->{token}"});
-})->catch(sub
+})
+->then(sub
+{
+  my $list = [ map { {command=>$_->{command}, description=>$_->{description}} } @$commands ];
+  return request("setMyCommands", {language_code=>"ru", commands=>$list });  
+})
+->then(sub
+{
+  my @promises = map {
+    my $locale = $_;
+    my $list = [ map { {command=>$_->{command}, description=>_loc($locale, $_->{description})} } @$commands ];
+    request("setMyCommands", {language_code=>$_, commands=>$list })
+  } @$locales;
+  
+  return Mojo::Promise->all(@promises);
+})
+->catch(sub
 {
   $log->error(Dumper @_);
 });

build/abonbot.pot

@@ -0,0 +1,44 @@
+# Abonbot
+# Copyright (C) YEAR THE PACKAGE'S COPYRIGHT HOLDER
+# This file is distributed under the same license as the PACKAGE package.
+# FIRST AUTHOR <EMAIL@ADDRESS>, YEAR.
+#
+#, fuzzy
+msgid ""
+msgstr ""
+"Project-Id-Version: 1.00\n"
+"POT-Creation-Date: YEAR-MO-DA HO:MI+ZONE\n"
+"PO-Revision-Date: YEAR-MO-DA HO:MI+ZONE\n"
+"Last-Translator: FULL NAME <EMAIL@ADDRESS>\n"
+"Language-Team: LANGUAGE <LL@li.org>\n"
+"MIME-Version: 1.0\n"
+"Content-Type: text/plain; charset=UTF-8\n"
+"Content-Transfer-Encoding: 8bit\n"
+
+#: ../modules/localization.pm:53
+msgid "__Language-Name"
+msgstr ""
+
+#: ../modules/fsa.pm:20 ../modules/fsa.pm:24
+msgid "Вас приветствует провайдер"
+msgstr ""
+
+#: ../modules/fsa.pm:20
+msgid "Введите номер учетной записи или логин"
+msgstr ""
+
+#: ../abonbot.pl:236 ../modules/fsa.pm:83
+msgid "Неизвестная команда"
+msgstr ""
+
+#: ../modules/fsa.pm:62
+msgid "Ошибка авторизации. Сообщите в службу технической поддержки код"
+msgstr ""
+
+#: ../modules/fsa.pm:37
+msgid "Теперь введите пароль"
+msgstr ""
+
+#: ../abonbot.pl:229
+msgid "Этот бот не работает в чатах"
+msgstr ""

build/gettext

@@ -0,0 +1,6 @@
+PERL5LIB=$PERL5LIB:. xgettext.pl -v -v --use-gettext-style ../abonbot.pl \
+--directory=../config --directory=../modules \
+--output=abonbot.pot --plugin perl=pl --plugin yaml=cfg \
+
+
+ 

lib/darsan_auth.pm

@@ -3,7 +3,7 @@
 use Modern::Perl;
 
 # Авторизация для Дарсана
-# Ю. Жиловец, 17.02.2015
+# Ю. Жиловец, 17.02.2015, 12.05.2023
 
 package darsan_auth;
 
@@ -25,7 +25,7 @@ sub source_ip
 {   
   my $self = shift;
   my $ip = shift;
-  $self->{ua}->local_address($ip);
+  $self->{ua}->socket_options({LocalAddr => $ip});
 }
 
 sub as_server
@@ -45,8 +45,8 @@ sub as_server
     $private->use_pkcs1_padding;
   }
 
-  $auth_servers = [ $auth_servers ] unless ref $auth_servers;
-  return bless {auth_servers=>$auth_servers, name=>$name, private=>$private, error=>undef, ua=>new Mojo::UserAgent},$class;
+  my $auth_server = ref $auth_servers ? $auth_servers->[0] : $auth_servers;
+  return bless {auth_server=>$auth_server, name=>$name, private=>$private, error=>undef, ua=>new Mojo::UserAgent},$class;
 }
 
 sub as_user
@@ -56,8 +56,8 @@ sub as_user
   my $login = shift;
   my $password = shift;
 
-  $auth_servers = [ $auth_servers ] unless ref $auth_servers;
-  return bless {auth_servers=>$auth_servers, login=>$login, password=>$password, error=>undef, ua=>new Mojo::UserAgent},$class;
+  my $auth_server = ref $auth_servers ? $auth_servers->[0] : $auth_servers;
+  return bless {auth_server=>$auth_server, login=>$login, password=>$password, error=>undef, ua=>new Mojo::UserAgent},$class;
 }
 
 sub set_token
@@ -75,199 +75,125 @@ sub token
   my $self = shift;
   my $sub = shift;
  
-  my $deferred;
+  undef $self->{error};
+  return $self->{token} if $self->{token} && $self->{expire}>time();
 
-  if ($sub && $sub eq "promise")
+  my ($err,$token,$expire) = $self->_fetch_token_sync;
+  if ($err)
   {
-    $deferred = new Mojo::Promise;
-    $sub = sub {
-
-      my ($err,$body) = @_;
-      if ($err)
-      {
-        $deferred->reject($err);
-      }
-      else
-      {
-        $deferred->resolve($body);
-      }
-    };
+    $self->{error} = $err;
+    return undef;
   }
 
-  undef $self->{error};
-  if ($self->{token} && $self->{expire}>time())
-  {
-    if ($sub)
-    {
-      $sub->(undef,$self->{token});
-      return $deferred;
-    }
-    else
-    {
-      return $self->{token};
-    }
-  }
+  $self->{token} = $token;
+  $self->{expire} = $expire;
 
-  if ($sub)
-  {
-    $self->_token(sub {
-      my ($err,$token,$expire) = @_;
+  return $token;
+}
 
-      if ($err)
-      {
-        $self->{error} = $err;
-        return $sub->($err);
-      }
+sub token_p
+{
+  my $self = shift;
 
-      $self->{token} = $token;
-      $self->{expire} = $expire;
-      $sub->(undef,$token);
-    });
+  return Mojo::Promise->resolve($self->{token}) if $self->{token} && $self->{expire}>time();
 
-    return $deferred;
-  }
-  else
+  $self->_fetch_token_async->then(sub
   {
-    my ($err,$token,$expire) = $self->_token;
-    if ($err)
-    {
-      $self->{error} = $err;
-      return undef;
-    }
+    my ($token, $expire) = @_;
 
     $self->{token} = $token;
     $self->{expire} = $expire;
-
     return $token;
-  }
+  });
 }
 
-sub _token
+sub _token_query
 {
   my $self = shift;
-  my $sub = shift;
 
   if ($self->{login})
   {
-    return $self->_fetch_token($sub, "token",
-                               {ver=>2, login=>$self->{login}, password=>$self->{password}} );
+    return ( "$self->{auth_server}/token", {ver=>2, login=>$self->{login}, password=>$self->{password}} );
   }
   else
   {
     my $t = time();
     my $sign = $self->{private}->sign("$self->{name}/$t");
-    return $self->_fetch_token($sub, "server-token/$self->{name}",
-                               {ver=>2, time=>$t, sign=>ascii85_encode($sign)} );
+    return ( "$self->{auth_server}/server-token/$self->{name}", {ver=>2, time=>$t, sign=>ascii85_encode($sign)} );
   }
 }
 
-sub _fetch_token
+sub _fetch_token_sync
+{
+  my $self = shift;
+  my ($url, $form) = $self->_token_query;
+
+  my $tx = $self->{ua}->post($url => form => $form);
+  return $self->_parse_reply($tx);
+}
+
+sub _fetch_token_async
 {
   my $self = shift;
   my $sub = shift;
-  my $url = shift;
-  my $form = shift;
 
-  if ($sub)
+  my ($url, $form) = $self->_token_query;
+  
+  $self->{ua}->post_p($url => form => $form)
+  ->catch(sub
   {
-    $self->_fetch_token_async($sub,$url,$form);
-  }
-  else
+    my $err = shift;
+    die {url=>$url, code=>500, message=>$err, body=>""};
+  })
+  ->then(sub
   {
-    $self->_fetch_token_sync($url,$form);
-  }
+    my $tx = shift;
+    my ($error, $token, $expires) = $self->_parse_reply($tx);
+    die $error if $error;
+    return ($token, $expires);
+  })
 }
 
-sub _fetch_token_sync
+sub _parse_reply
 {
   my $self = shift;
-  my $url = shift;
-  my $form = shift;
-
-  my $tx;
-
-  LOOP: {
-  foreach my $server (@{ $self->{auth_servers} })
+  my $tx = shift;
+  
+  my $body = $tx->res->body;
+  $body = j($body) if $tx->res->headers->content_type  && $tx->res->headers->content_type =~ m|^application/json|;
+      
+  if (my $e = $tx->error)
   {
-    $tx = $self->{ua}->post("$server/$url" => form => $form);
-
-    last LOOP if $tx->result;
-    last if $tx->error && $tx->error->{status} && $tx->error->{status}==400;
+    $e->{code} ||= 500;
+    my $err = {url=>$tx->req->url."", code=>$e->{code}, message=>$e->{message}, body=>$tx->res->body};
+    return ($err);
   }
 
-  my $e = $tx->error;
-  $e->{code} ||= 500;
-  my $err = {code=>$e->{code}, message=> $e->{message}, body => $tx->res->body};
-  return ($err);
-}
-
-  my $body = j($tx->res->body);
   my $token = $body->{token};
   my $expires = $body->{expires};
-  my $exp = $self->parse_time($expires);
-
-  return (undef,$token,$exp);
-}
-
-sub _fetch_token_async
-{
-  my $self = shift;
-  my $sub = shift;
-  my $url = shift;
-  my $form = shift;
+  my $exp = parse_time($expires);
 
-  my $server = $self->{auth_servers}->[0];
-  $self->{ua}->post_p("$server/$url" => form => $form)
-    ->then(sub
-  {
-    my $tx = shift;
-    
-    if (my $e = $tx->error)
-    {
-      return $sub->( {code=>$e->{code}, url=>"$server/$url", message=>$e->{message}, body=>$tx->result->body} );
-    }
-                      
-    my $body = j($tx->result->body);
-    my $token = $body->{token};
-    my $expires = $body->{expires};
-    my $exp = $self->parse_time($expires);
-    $sub->(undef,$token,$exp);
-  })
-    ->catch(sub
-  {
-    my $e = shift;
-    unless (ref $e)
-    {
-      $sub->( {code=>500, url=>"$server/$url", message=>$e, body=>""} );
-    }
-    else
-    {
-      $e->{code} ||= 500;
-      $sub->( {code=>$e->{code}, url=>"$server/$url", message=>$e->{message}, body=>""} );
-    }
-  });
+  return (undef, $token, $exp);
 }
 
-sub parse_time
-{
+sub parse_time {
   no warnings;
-  my $self = shift;
-  my $s = shift;
+  my $s           = shift;
+  my $time_format = "%Y-%m-%d %H:%M:%S%z";
 
   $s =~ /([+-])(\d{4})$/;
   my $tz_sign = $1;
-  my $tz = $2;
+  my $tz      = $2;
   $s =~ s/[+-]\d{4}$//;
 
-  my $time = timegm(POSIX::strptime($s,"%Y-%m-%d %H:%M:%S%z"));
+  my $time = timegm(POSIX::strptime($s, $time_format));
 
-  if ($tz)
-  {
-    my $h = substr($tz,0,2);
-    my $s = substr($tz,2,2);
-    my $offset = ($h*60+$s)*60;
-    $offset = -$offset if $tz_sign eq "+";
-    $time += $offset;
+  if ($tz) {
+    my $h      = substr($tz, 0, 2);
+    my $s      = substr($tz, 2, 2);
+    my $offset = ($h * 60 + $s) * 60;
+    $offset    = -$offset if $tz_sign eq "+";
+    $time      += $offset;
   }
 
   return $time;

lib/darsan_client.pm

@@ -4,6 +4,8 @@ use Modern::Perl;
 
 # Клиент для Дарсана, версия 2
 # Ю. Жиловец, 17.02.2015
+# Версия 3
+# Ю. Жиловец, 1.05.2023
 
 package darsan_client;
 
@@ -37,10 +39,9 @@ sub error
 sub _query
 {
   my $self = shift;
+  my $is_promise = shift;
   my $method = shift;
-  my $url = shift;
-  my $sub = pop;
-  my @rest = @_;
+  my @args = @_;
 
   undef $self->{error};
 
@@ -51,133 +52,102 @@ sub _query
     $is_raw = 1;
   }
 
-  my $headers = {};
-  $headers = shift(@rest) if @rest && ref($rest[0]) eq "HASH";
-
-   my $make_query = sub
-   {
-      my $token = shift;  
-      $headers->{Authorization} = "Darsan2 $token";
-      return $self->{ua}->build_tx($method,$url,$headers,@rest);
-   };
-
-  if ($sub && $sub eq "promise")
-  {
-    return $self->_promise_query($make_query, $is_raw);
-  }
-  elsif ($sub)
+  my $tx = $self->{ua}->build_tx($method, @args);
+  
+  if ($is_promise)
   {
-    return $self->_async_query($sub, $make_query, $is_raw);
+    return $self->_promise_query($tx, $is_raw);
   }
   else
   {
-    return $self->_sync_query($make_query, $is_raw);
+    return $self->_sync_query($tx, $is_raw);
   }
 }
 
 sub _sync_query
 {
   my $self = shift;
-  my $make_query = shift;
+  my $tx = shift;
   my $is_raw = shift;
   
   my $token = $self->{auth}->token;
   if ($self->{auth}->error)
   {
-    $self->{error} = "darsan_auth: ".$self->{auth}->error;
+    $self->{error} = $self->{auth}->error;
     return undef;
   }
 
-  my $tx = $self->{ua}->start($make_query->($token));
-  my $resp = $tx->result;
-
- if ($resp->is_error)
- {
-    my $e = $tx->error; 
-    $e->{code} ||= 500;
-    $self->{error} = "$e->{code} $e->{message}/".substr($tx->res->body,0,500);
+  $tx->req->headers->authorization("Darsan2 $token");
+  $tx = $self->{ua}->start($tx);
+  my ($error, $body) = $self->_parse_reply($tx);
+  
+  if ($error)
+  {
+    $self->{error} = $error;
     return undef;
   }
 
-  return $resp if $is_raw;
-  return $resp->headers->content_type =~ m|application/json| ? j($resp->body) : $resp->body;
+  return $is_raw ? $tx->result : $body;
 }
 
-sub _async_query
+sub _promise_query
 {
   my $self = shift;
-  my $sub = shift;
-  my $make_query = shift;
+  my $tx = shift;
   my $is_raw = shift;
-  
-  $self->{auth}->token(sub 
+
+  return $self->{auth}->token_p->then(sub
   {
-      my ($err,$token) = @_;
-      return $sub->({code=>500, message=>"darsan_auth: cannot get token: $err->{message}"}) if $err;
-
-      my $tx = $self->{ua}->start($make_query->($token) => sub
-      { 
-        my ($ua, $tx) = @_;
-        my $resp = $tx->result;
-      
-        if ($resp->is_error)
-        {
-          my $e = $tx->error;
-          $e->{code} ||= 500;
-          my $error = { code=>$e->{code}, message=>$e->{message}, response=>$tx->res };
-          return $sub->($error);
-        }
-        
-        $sub->(undef,$is_raw ? $resp : j($resp->body));
-      });
+    my $token = shift;
+    $tx->req->headers->authorization("Darsan2 $token");
+    $self->{ua}->start_p($tx)
+  })->catch(sub
+  {  
+    my $err = shift;
+    die $err if ref $err;
+    die {code=>500, body=>"", url=>$tx->req->url."", message=>$err};
+  })
+  ->then(sub
+  { 
+    my $tx = shift;
+    my ($error, $body) = $self->_parse_reply($tx);
+
+    die $error if $error;
+    return $is_raw ? $tx->result : $body;
   });
 }
 
-sub _promise_query
+sub _parse_reply
 {
   my $self = shift;
-  my $make_query = shift;
-  my $is_raw = shift;
-  
-  return $self->{auth}->token("promise")->then(sub
-  {
-      my $token = shift;
-
-      my $tx = $self->{ua}->start_p($make_query->($token))->then(sub
-      { 
-        my $tx = shift;
-        my $resp = $tx->result;
-        
-        if ($resp->is_success)
-        {
-           $is_raw ? $resp : j($resp->body);
-        }
-        else
-        {
-          my $body = $resp->body;
-          utf8::decode($body);
-          die {code=>$resp->{code}, message=>$resp->{message}, body=>$body, content_type=>$resp->headers->header("Content-Type")};
-        }
-      });
-  }, sub 
+  my $tx = shift;
+
+  my $body = $tx->res->body;
+  my $cont = $tx->res->headers->content_type;
+  $body = j($body) if $cont  && ($cont =~ m|^application/json| || $cont =~ m|^application/error\+json|);
+
+  if (my $e = $tx->error)
   {
-    my $err = shift;
-    die {code=>500, message=>"darsan_auth: cannot get token from $err->{url}: $err->{code} $err->{message}"};
-  });
+    $e->{code} ||= 500;
+    my $err = {url=>$tx->req->url."", code=>$e->{code}, message=>$e->{message}, body=>$body};
+    return ($err);
+  }
+
+  return (undef, $body);
 }
 
+
 sub get
 {
   my $self = shift;
   my $topic = shift;
   my $path = shift;
   my $params = shift || {};
-  my $sub = shift;
   
   my $q = URI::Query->new($params);
   $q = "?$q" if $q;
   my $url = $self->_make_server($topic).$path.$q;
-  return $self->_query(GET => $url => $sub);
+  return $self->_query(0, GET => $url);
 }
 
 sub get_p
@@ -187,7 +157,10 @@ sub get_p
   my $path = shift;
   my $params = shift || {};
 
-  return $self->get($topic, $path, $params, "promise");
+  my $q = URI::Query->new($params);
+  $q = "?$q" if $q;
+  my $url = $self->_make_server($topic).$path.$q;
+  return $self->_query(1, GET => $url);
 }
 
 sub get_raw
@@ -196,12 +169,11 @@ sub get_raw
   my $topic = shift;
   my $path = shift;
   my $params = shift || {};
-  my $sub = shift;
             
   my $q = URI::Query->new($params);
   $q = "?$q" if $q;
   my $url = $self->_make_server($topic).$path.$q;
-  return $self->_query(GET_RAW => $url => $sub);
+  return $self->_query(0, GET_RAW => $url);
 }
 
 sub get_raw_p
@@ -211,7 +183,10 @@ sub get_raw_p
   my $path = shift;
   my $params = shift || {};
             
-  return $self->get_raw($topic, $path, $params, "promise");            
+  my $q = URI::Query->new($params);
+  $q = "?$q" if $q;
+  my $url = $self->_make_server($topic).$path.$q;
+  return $self->_query(1, GET_RAW => $url);
 }
 
 sub post
@@ -220,10 +195,9 @@ sub post
   my $topic = shift;
   my $path = shift;
   my $params = shift || {};
-  my $sub = shift;
   
   my $url = $self->_make_server($topic).$path;
-  return $self->_query(POST => $url => form => $params => $sub);
+  return $self->_query(0, POST => $url => form => $params);
 }
 
 sub post_p
@@ -233,7 +207,8 @@ sub post_p
   my $path = shift;
   my $params = shift || {};
 
-  return $self->post($topic, $path, $params, "promise");  
+  my $url = $self->_make_server($topic).$path;
+  return $self->_query(1, POST => $url => form => $params);
 }
 
 sub post_json
@@ -242,10 +217,9 @@ sub post_json
   my $topic = shift;
   my $path = shift;
   my $params = shift || {};
-  my $sub = shift;
   
   my $url = $self->_make_server($topic).$path;
-  return $self->_query(POST => $url => { "Content-Type"=>"application/json" } => j($params) => $sub);
+  return $self->_query(0, POST => $url => { "Content-Type"=>"application/json" } => j($params));
 }
 
 sub post_json_p
@@ -256,7 +230,7 @@ sub post_json_p
   my $params = shift || {};
   
   my $url = $self->_make_server($topic).$path;
-  return $self->_query(POST => $url => { "Content-Type"=>"application/json" } => j($params) => "promise");
+  return $self->_query(1, POST => $url => { "Content-Type"=>"application/json" } => j($params));
 }
 
 sub delete
@@ -265,10 +239,9 @@ sub delete
   my $topic = shift;
   my $path = shift;
   my $params = shift || {};
-  my $sub = shift;
 
   my $url = $self->_make_server($topic).$path;
-  return $self->_query(DELETE => $url => form => $params => $sub);
+  return $self->_query(0, DELETE => $url => form => $params);
 }
 
 sub delete_p
@@ -278,7 +251,8 @@ sub delete_p
   my $path = shift;
   my $params = shift || {};
 
-  $self->delete($topic, $path, $params, "promise");  
+  my $url = $self->_make_server($topic).$path;
+  return $self->_query(1, DELETE => $url => form => $params);
 }
 
 sub put
@@ -287,10 +261,9 @@ sub put
   my $topic = shift;
   my $path = shift;
   my $params = shift || {};
-  my $sub = shift;
   
   my $url = $self->_make_server($topic).$path;
-  return $self->_query(PUT => $url => form => $params => $sub);
+  return $self->_query(0, PUT => $url => form => $params);
 }
 
 sub put_p
@@ -300,7 +273,30 @@ sub put_p
   my $path = shift;
   my $params = shift || {};
 
-  $self->put_p($topic, $path, $params, "promise");  
+  my $url = $self->_make_server($topic).$path;
+  return $self->_query(1, PUT => $url => form => $params);
+}
+
+sub put_json
+{
+  my $self = shift;
+  my $topic = shift;
+  my $path = shift;
+  my $params = shift || {};
+  
+  my $url = $self->_make_server($topic).$path;
+  return $self->_query(0, PUT => $url => { "Content-Type"=>"application/json" } => j($params));
+}
+
+sub put_json_p
+{
+  my $self = shift;
+  my $topic = shift;
+  my $path = shift;
+  my $params = shift || {};
+
+  my $url = $self->_make_server($topic).$path;
+  return $self->_query(1, PUT => $url => { "Content-Type"=>"application/json" } => j($params));
 }
 
 sub patch
@@ -309,10 +305,9 @@ sub patch
   my $topic = shift;
   my $path = shift;
   my $params = shift || {};
-  my $sub = shift;
 
   my $url = $self->_make_server($topic).$path;
-  return $self->_query(PATCH => $url => form => $params => $sub);
+  return $self->_query(0, PATCH => $url => form => $params);
 }
 
 sub patch_json
@@ -321,10 +316,9 @@ sub patch_json
   my $topic = shift;
   my $path = shift;
   my $params = shift || {};
-  my $sub = shift;
 
   my $url = $self->_make_server($topic).$path;
-  return $self->_query(PATCH => $url => { "Content-Type"=>"application/json" } => j($params) => $sub);
+  return $self->_query(0, PATCH => $url => { "Content-Type"=>"application/json" } => j($params));
 }
 
 sub patch_p
@@ -334,7 +328,8 @@ sub patch_p
   my $path = shift;
   my $params = shift || {};
 
-  $self->patch($topic, $path, $params, "promise");  
+  my $url = $self->_make_server($topic).$path;
+  return $self->_query(1, PATCH => $url => form => $params);
 }
 
 sub patch_json_p
@@ -344,7 +339,8 @@ sub patch_json_p
   my $path = shift;
   my $params = shift || {};
 
-  $self->patch_json($topic, $path, $params, "promise");  
+  my $url = $self->_make_server($topic).$path;
+  return $self->_query(1, PATCH => $url => { "Content-Type"=>"application/json" } => j($params));
 }
 
 sub map
@@ -368,4 +364,18 @@ sub _make_server
   return $server;
 }
 
+sub clone
+{
+  my $self = shift;
+  return bless { %$self }, "darsan_client";
+}
+
+sub auth
+{
+  my $self = shift;
+  my $auth = shift;
+  $self->{auth} = $auth;
+  return $self;
+}
+
 1;

modules/abon_client.pm

@@ -0,0 +1,60 @@
+use Modern::Perl;
+use utf8;
+
+use Mojo::Base -strict, -signatures, -async_await;
+
+our $redis;
+our $client;
+our $config;
+
+package abon_client;
+
+use darsan_client;
+
+my $auth = abon_auth->new;
+
+sub new($class)
+{
+  my $client = darsan_client->new(undef, $config->{darsan}->{servers});
+  $client->map($config->{darsan_map}) if $config->{darsan_map};
+  return bless {client => $client}, $class;
+}
+
+our $AUTOLOAD;
+sub AUTOLOAD($self, $tel_id, @rest)
+{
+  # Remove qualifier from original method name...
+  my $called =  $AUTOLOAD =~ s/.*:://r;
+    
+  return $self->{client}->auth($auth->telegram($tel_id))->$called(@rest);
+}
+
+package abon_auth;
+
+sub new($class)
+{
+  return bless {telegram=>undef}, $class;
+}
+
+sub telegram($self, $tel_id)
+{
+  $self->{telegram} = $tel_id;
+  return $self;
+}
+
+async sub token_p
+{
+  my $self = shift;
+  my $key = "ab-$self->{telegram}-token";
+  
+  my $tok = $redis->get($key);
+  return $tok if $tok;
+  
+  my $res = await $client->post_p("client", "/telegram/$self->{telegram}/token");
+  $redis->set($key, $res->{token});
+  $redis->expireat($key, darsan_auth::parse_time($res->{expires})-5);
+  
+  return $res->{token};
+}
+
+1;

modules/alias.pm

@@ -1,14 +0,0 @@
-use Modern::Perl;
-use utf8;
-
-use Attribute::Handlers;
-
-our %aliases;
-
-sub Alias :ATTR(BEGIN)
-{
-  my ($package, $symbol, $referent, $attr, $data) = @_;
-  $aliases{$data->[0]} = $referent;
-}
-
-1;

modules/bdcom.pm

@@ -1,317 +0,0 @@
-use Modern::Perl;
-use utf8;
-
-use telnet;
-
-use Mojo::Base -strict, -async_await;
-use Data::Dumper;
-
-our $log;
-
-sub bdcom_extract_onu_num {
-    my $onu_name = shift;
-
-    $onu_name =~ m|EPON0/\d+:(\d+)|;
-
-    return $1;
-}
-
-sub bdcom_extract_onu_info {
-    my @lines = @_;
-
-    return map([substr($_, 0, 11), split(' ', substr($_, 11, -1))], @lines[3..@lines-3]);
-}
-
-async sub bdcom_login {
-    my $t        = shift;
-    my $login    = shift;
-    my $password = shift;
-
-    await $t->connect;
-
-    await $t->reply(qr/Username:/, $login);
-    await $t->reply(qr/Password:/, $password);
-
-    my @greeting = await $t->waitfor(qr/>/);
-    my $version = "C";
-
-    for (@greeting)
-    {
-        $version = $1 if /Welcome to BDCOM P3310(\w)/;
-    }
-
-    $t->print("enable");
-
-    my @next = await $t->waitfor(qr/#|password:/);
-
-    if (grep {$_ =~ /password:/} @next)
-    {
-        $t->print($password);
-        await $t->waitfor(qr/#/);
-    }
-
-    $t->prompt(qr/#/);
-
-    await $t->cmd("terminal length 0");
-    await $t->cmd("terminal width 200");
-
-};
-
-async sub bdcom_get_onu_info
-{
-    my $t = shift;
-    my $tree = shift;
-
-    my @inactive_onu = await $t->cmd("show epon inactive-onu interface ePON 0/$tree");
-    $inactive_onu[0] =~ m|Interface EPON0/\d+ has bound (\d+)|;
-    my $inactive_count = $1 || "?";
-    if (@inactive_onu <= 1) {
-        $inactive_count = 0;
-    }
-
-    my @active_onu = await $t->cmd("show epon active-onu interface ePON 0/$tree");
-    $active_onu[0] =~ m|Interface EPON0/\d+ has bound (\d+)|;
-    my $active_count = $1 || "?";
-    if (@active_onu <= 1) {
-        $active_count = 0;
-    }
-
-    my $total_count = $active_count + $inactive_count;
-
-    my @in_onu_info = bdcom_extract_onu_info(@inactive_onu);
-    my @compact_in_onu_info = map( [bdcom_extract_onu_num(@$_[0]), @$_[1]], @in_onu_info );
-    #@compact_in_onu_info = map( join(" ", @$_), @compact_in_onu_info);
-
-#    say Dumper @active_onu;
-    my @a_onu_info = bdcom_extract_onu_info(@active_onu);
-#    say "test2";
-    my @compact_a_onu_info = map( [bdcom_extract_onu_num(@$_[0]), @$_[1]], @a_onu_info );
-    #@compact_a_onu_info = map( join(" ", @$_), @compact_a_onu_info);
-
-
-    my %res = (
-        'total_cnt'    => $total_count,
-        'active_cnt'   => $active_count,
-        'inactive_cnt' => $inactive_count,
-        'active'       => [ @compact_a_onu_info ],
-        'inactive'     => [ @compact_in_onu_info ],
-    );
-
-    return %res;
-};
-
-async sub bdcom_fun_purge_tree
-{
-    my $t = shift;
-    my $tree = shift;
-    my $onu_info = shift;
-    my %onu_info = %{$onu_info};
-
-    await $t->cmd("config");
-    await $t->cmd("interface EPON0/$tree");
-
-#    say Dumper %onu_info;
-
-    foreach my $i ( @{$onu_info{'inactive'}} ) {
-#        say Dumper @$i[1];
-        my $onu_mac = @$i[1];
-#        say Dumper $onu_mac;
-        my @tmp = await $t->cmd("no epon bind-onu mac $onu_mac");
-#        say ADumper @tmp;
-    }
-
-    my @deleted_onu = map { sprintf("%2d %s", $_->[0], $_->[1]) } @{$onu_info{inactive}};
-
-    await $t->cmd("exit");
-
-    return @deleted_onu;
-};
-
-async sub bdcom_inspect
-{
-    my $ip = shift;
-    my $login = shift;
-    my $password = shift;
-    my $tree = shift;
-
-  ############################
-
-    my $t = new telnet($ip);
-#  $t->debug(1);
-    await bdcom_login($t, $login, $password);
-
-  #######################
-
-    my %onu_info = await bdcom_get_onu_info($t, $tree);
-
-    $t->close;
-
-    my $res = "Всего: $onu_info{'total_cnt'};
-Количество активных ONU: $onu_info{'active_cnt'};
-Количество неактивных ONU: $onu_info{'inactive_cnt'};
-\n";
-
-    $res = $res . "Неактивные ONU:\n" . join("\n", map( join(" ", @$_), @{$onu_info{'inactive'}} ) ) . "\n\n";
-
-    $res = $res . "Активные ONU:\n" . join("\n", map( join(" ", @$_), @{$onu_info{'active'}} ) );
-
-    return $res;
-};
-
-async sub bdcom_onu
-{
-    my $ip = shift;
-    my $login = shift;
-    my $password = shift;
-    my $tree = shift;
-
-  ############################
-
-    my $t = new telnet($ip);
-#  $t->debug(1);
-
-    await bdcom_login($t, $login, $password);
-
-    #######################
-
-    my %onu_info = await bdcom_get_onu_info($t, $tree);
-
-    $t->close;
-
-    my $res = "Всего: $onu_info{'total_cnt'};
-Количество активных ONU: $onu_info{'active_cnt'};
-Количество неактивных ONU: $onu_info{'inactive_cnt'};
-\n";
-
-    return $res;
-};
-
-async sub bdcom_purge
-{
-    my $ip = shift;
-    my $login = shift;
-    my $password = shift;
-    my $tree = shift;
-    my $save = shift;
-
-  ############################
-
-    my $t = new telnet($ip);
-#    $t->debug(1);
-
-    await bdcom_login($t, $login, $password);
-
-  #######################
-
-    my %onu_info = await bdcom_get_onu_info($t, $tree);
-
-    if ($onu_info{'inactive_cnt'} == 0) {
-        $t->close;
-        return "Нечего чистить";
-    }
-
-    my @deleted_onu = await bdcom_fun_purge_tree($t, $tree, \%onu_info);
-
-    %onu_info = await bdcom_get_onu_info($t, $tree);
-
-    if ($save) {
-        await $t->cmd("write all");
-    }
-
-    $t->close;
-
-    my $res = "Осталось ONU: $onu_info{'total_cnt'}\n";
-
-    if ( $onu_info{'active_cnt'} != $onu_info{'total_cnt'} ) {
-        $res = $res . "Общее количество ONU и количество активных ONU не совпадает.
-Лучше обратиться к Вашему системному администратору\n";
-    }
-
-    $res = $res . "Удалённые ONU: " . scalar @deleted_onu . "\n";
-
-    $log->info("IP $ip TREE $tree\n" . join("\n", @deleted_onu));
-
-    return $res;
-};
-
-async sub bdcom_purgeall
-{
-    my $ip = shift;
-    my $login = shift;
-    my $password = shift;
-    my $tree_count = shift;
-    my $save = shift;
-
-  ############################
-    my @res;
-
-    my $t = new telnet($ip);
-#    $t->debug(1);
-
-    await bdcom_login($t, $login, $password);
-
-  #######################
-
-    for (my $tree=1; $tree <= $tree_count; $tree++) {
-        my $res = "Дерево $tree\n";
-
-        my %onu_info = await bdcom_get_onu_info($t, $tree);
-
-        if ($onu_info{'inactive_cnt'} == 0) {
-            $res = $res . "Не имеет неактивных ONU\n";
-            push @res, $res;
-            next;
-        }
-
-        my @deleted_onu = await bdcom_fun_purge_tree($t, $tree, \%onu_info);
-
-#        say Dumper @deleted_onu;
-
-        %onu_info = await bdcom_get_onu_info($t, $tree);
-
-        $res = $res . "Осталось ONU: $onu_info{'total_cnt'}\n";
-        $res = $res . "Удалённые ONU: " . scalar @deleted_onu . "\n";
-
-        $log->info("IP $ip TREE $tree\n" . join("\n", @deleted_onu));
-
-        push @res, $res;
-
-    }
-
-    if ($save) {
-        await $t->cmd("write all");
-    }
-
-    $t->close;
-
-    return \@res;
-};
-
-
-
-async sub bdcom_save
-{
-    my $ip = shift;
-    my $login = shift;
-    my $password = shift;
-
-  ############################
-
-    my $t = new telnet($ip);
-#    $t->debug(1);
-
-    await bdcom_login($t, $login, $password);
-
-  #######################
-
-    await $t->cmd("write all");
-
-    $t->close;
-
-    my $res = "Сохранено\n";
-
-    return $res;
-};
-
-
-1;

modules/cdata.pm

@@ -1,262 +0,0 @@
-use Modern::Perl;
-use utf8;
-
-use telnet;
-
-use Mojo::Base -strict, -async_await;
-use Data::Dumper;
-
-our $log;
-
-sub cdata_extract_onu_info {
-    my @lines = @_;
-
-#    say Dumper @lines;
-
-    my @onu_info = @lines[4..@lines-5];
-
-    return map([ split(' ', $_) ], @onu_info );
-};
-
-async sub cdata_login
-{
-    my $t        = shift;
-    my $login    = shift;
-    my $password = shift;
-
-    await $t->connect;
-
-    await $t->reply(qr/User name:/, $login);
-    await $t->reply(qr/User password:/, $password);
-
-    $t->print("enable");
-    await $t->waitfor("#");
-    $t->prompt(qr/#\s?$/);
-
-    await $t->cmd("config");
-    await $t->cmd("vty output show-all");
-
-};
-
-async sub cdata_get_onu_info
-{
-    my $t    = shift;
-    my $tree = shift;
-
-    await $t->cmd("interface epon 0/0");
-    my @lines = await $t->cmd("show ont info $tree all");
-
-    my $onu_count_line = @lines[@lines-3];
-
-    $onu_count_line =~ m|Total: (\d+), online (\d+)|;
-    my $total_onu_cnt   = $1;
-    my $online_onu_cnt  = $2;
-    my $offline_onu_cnt = $total_onu_cnt - $online_onu_cnt;
-
-    if ($lines[2] =~ /Error/) {
-        $total_onu_cnt   = 0;
-        $online_onu_cnt  = 0;
-        $offline_onu_cnt = 0;
-    }
-
-    await $t->cmd("exit");
-
-    my @onu_info = cdata_extract_onu_info(@lines);
-
-    my @online_onu = grep { @$_[5] =~ "online" }  @onu_info;
-    @online_onu = map [@$_[2,3]], @online_onu;
-
-    my @offline_onu = grep { @$_[5] =~ "offline|powerdown" }  @onu_info;
-    @offline_onu = map [@$_[2,3]], @offline_onu;
-
-    my %res = (
-        'total_cnt'    => $total_onu_cnt,
-        'active_cnt'   => $online_onu_cnt,
-        'inactive_cnt' => $offline_onu_cnt,
-        'active'       => [ @online_onu ],
-        'inactive'     => [ @offline_onu ],
-    );
-
-    return %res;
-
-};
-
-async sub cdata_fun_purge_tree
-{
-    my $t        = shift;
-    my $tree     = shift;
-    my $onu_info = shift;
-    my %onu_info = %{$onu_info};
-
-
-    #say Dumper \%onu_info;
-
-    await $t->cmd("interface epon 0/0");
-
-    foreach my $i ( @{$onu_info{'inactive'}} ) {
-        #say Dumper @$i[0];
-        my $onu_num = @$i[0];
-#        say Dumper $onu_num;
-        my @tmp = await $t->cmd("ont delete $tree $onu_num");
-        #say Dumper @tmp;
-    }
-
-    await $t->cmd("exit");
-
-    my @deleted_onu = map { sprintf("%2d %s", $_->[0], $_->[1]) } @{$onu_info{inactive}};
-
-    return @deleted_onu;
-};
-
-async sub cdata_inspect
-{
-    my $ip = shift;
-    my $login = shift;
-    my $password = shift;
-    my $tree = shift;
-
-    my $t = new telnet($ip);
-#    $t->debug(1);
-
-    await cdata_login($t, $login, $password);
-
-    my %onu_info = await cdata_get_onu_info($t, $tree);
-
-#    say Dumper \%onu_info;
-    
-    $t->close;
-
-    my $res = "Всего: $onu_info{'total_cnt'}
-Количество активных ONU: $onu_info{'active_cnt'}
-Количество неактивных ONU: $onu_info{'inactive_cnt'}
-\n";
-
-    $res = $res . "Неактивные ONU:\n" . join("\n", map( join(" ", @$_), @{$onu_info{'inactive'}} ) ) . "\n\n";
-
-    $res = $res . "Активные ONU:\n" . join("\n", map( join(" ", @$_), @{$onu_info{'active'}} ) );
-
-    return $res;
-};
-
-async sub cdata_onu
-{
-    my $ip = shift;
-    my $login = shift;
-    my $password = shift;
-    my $tree = shift;
-
-    my $t = new telnet($ip);
-#    $t->debug(1);
-
-    await cdata_login($t, $login, $password);
-
-    my %onu_info = await cdata_get_onu_info($t, $tree);
-
-    $t->close;
-
-    my $res = "Всего: $onu_info{'total_cnt'}
-Количество активных ONU: $onu_info{'active_cnt'}
-Количество неактивных ONU: $onu_info{'inactive_cnt'}
-\n";
-
-    return $res;
-};
-
-async sub cdata_purge
-{
-    my $ip = shift;
-    my $login = shift;
-    my $password = shift;
-    my $tree = shift;
-    my $save = shift;
-
-    my $t = new telnet($ip);
-#    $t->debug(1);
-
-    await cdata_login($t, $login, $password);
-
-    my %onu_info = await cdata_get_onu_info($t, $tree);
-
-    if ($onu_info{'inactive_cnt'} == 0) {
-        $t->close;
-        return "Нечего чистить.";
-    }
-
-    my @deleted_onu = await cdata_fun_purge_tree($t, $tree, \%onu_info);
-
-    %onu_info = await cdata_get_onu_info($t, $tree);
-
-    if ($save) {
-        await $t->cmd("save");
-    }
-
-    $t->close;
-
-    my $res = "Осталось ONU: $onu_info{'total_cnt'}\n";
-
-    if ( $onu_info{'active_cnt'} != $onu_info{'total_cnt'} ) {
-        $res = $res . "Общее количество ONU и количество активных ONU не совпадает.
-Лучше обратиться к Вашему системному администратору\n";
-    }
-
-    $res = $res . "Удалённые ONU: " . scalar @deleted_onu . "\n";
-
-    $log->info("IP $ip TREE $tree\n" . join("\n", @deleted_onu));
-
-
-    return $res;
-};
-
-async sub cdata_purgeall
-{
-    my $ip = shift;
-    my $login = shift;
-    my $password = shift;
-    my $tree_count = shift;
-    my $save = shift;
-
-    my @res;
-
-    my $t = new telnet($ip);
-#    $t->debug(1);
-
-    await cdata_login($t, $login, $password);
-
-    for (my $tree=1; $tree <= $tree_count; $tree++) {
-        my $res = "Дерево $tree\n";
-
-        my %onu_info = await cdata_get_onu_info($t, $tree);
-
-#        say Dumper %onu_info;
-
-        if ($onu_info{'inactive_cnt'} == 0) {
-            $res = $res . "Не имеет неактивных ONU\n";
-            push @res, $res;
-            next;
-        }
-
-        my @deleted_onu = await cdata_fun_purge_tree($t, $tree, \%onu_info);
-
-#        say Dumper @deleted_onu;
-
-        %onu_info = await cdata_get_onu_info($t, $tree);
-
-        $res = $res . "Осталось ONU: $onu_info{'total_cnt'}\n";
-        $res = $res . "Удалённые ONU: " . scalar @deleted_onu . "\n";
-
-        $log->info("IP $ip TREE $tree\n" . join("\n", @deleted_onu));
-
-        push @res, $res;
-
-    }
-
-    if ($save) {
-        await $t->cmd("save");
-    }
-
-    $t->close;
-
-    return \@res;
-};
-
-1;

modules/commands.pm

@@ -1,357 +1,198 @@
 use Modern::Perl;
-use AnyEvent;
 use utf8;
 
-use Mojo::Base -strict, -async_await;
+use Mojo::Base -strict, -async_await, -signatures;
 use Data::Dumper;
 
-use bdcom;
-use cdata;
-
 our $client;
-our $redis;
-our $db;
-
-##############################################
+our $fsa;
+our $abon_client;
 
-sub command_help :Alias("помощь")
+sub __
 {
-  my $cmd = shift;
-  my $args = shift;
-  my $chatid = shift;
-  my $rest = shift;
-
-# TEMP
-# <b>/purge-all-trees</b> <i>ip-адрес-устройства</i> - Очистить все деревья PON
-#
-  notify($chatid, <<"---", $rest);
-<b>/purge</b> <i>ip-адрес-устройства номер-дерева</i> - Очистить дерево PON
-<b>/почистить</b> <i>ip-адрес-устройства номер-дерева</i>
-<b>/purge_all_trees</b> <i>ip-адрес-устройства</i> - Очистить ВСЕ деревья
-<b>/почистить_все_деревья</b> <i>ip-адрес-устройства</i> - Очистить ВСЕ деревья
-<b>/inspect</b> <i>ip-адрес-устройства номер-дерева</i> - Информация об ONU на дереве
-<b>/проверить</b> <i>ip-адрес-устройства номер-дерева</i>
-<b>/onu</b> <i>ip-адрес-устройства номер-дерева</i> - Краткая информация ONU на дереве
-<b>/ону</b> <i>ip-адрес-устройства номер-дерева</i>
----
+  @_;
 }
 
-async sub command_find :Alias("где")
-{
-  my $cmd = shift;
-  my $args = shift;
-  my $chatid = shift;
-  my $rest = shift;
-
-  my $onu_mac = uc $args->[0];
-
-  return notify($chatid, "Не указан MAC ONU") unless $onu_mac;
-
-  my $olts;
-  eval {
-      $olts = await $client->get_p("device", "/pon");
-  };
-
-  my @keys = $redis->keys("gpon-*");
-
-  my $search_res = 0;
-
-  foreach my $x (@keys) {
-    my %values = $redis->hgetall($x);
-    my $record = \%values;
-
-    if ( $record->{mac} && $record->{mac} =~ $onu_mac ) {
-        my @key_parts = split("-", $x);
-        my $dev_id = @key_parts[1];
-
-        my @olt_f = grep { $dev_id == $_->{entity} } @$olts;
-        my $olt = @olt_f[0];
+##############################################
 
-        unless ($olt) {
-            notify($chatid, "Не существует OLT id=$dev_id") unless $olt;
-        } else {
-            notify($chatid, "$olt->{name} ($olt->{ip}) $record->{name} (MAC-ONU: $record->{mac})");
-            $search_res = 1;
-        }
-    }
-  }
+our $commands = [
+  {command=>"help", name=>__("Помощь"), description=>__("Список доступных команд"), hide_in_kb=>1},
+  {command=>"info", name=>__("Информация"), description=>__("Информация о пользователе")},
+  {command=>"balance", name=>__("Баланс"), description=>__("Проверка баланса")},
+  {command=>"service", name=>__("Сервисы"), description=>__("Подключенные сервисы")},
+  {command=>"credit", name=>__("Кредит"), description=>__("Установка кредита")},
+  {command=>"logout", name=>__("Выход"), description=>__("Выход")},
+];
 
-  return notify($chatid, "Не нашёл MAC ONU=\"$onu_mac\"") unless $search_res;
+##############################################
 
+sub command_help($chatid, $uid, $rest)
+{
+  my @list = map { "<b>/$_->{command}</b> " . _($_->{description}) } @$commands;
+  notify($chatid, join("\n", @list), $rest);
 }
 
-# inspect 172.25.7.1 2 - посмотреть информацию об ONU на дереве 2 устройства 172.25.7.1
-async sub command_inspect :Alias("проверить")
+sub command_start($chatid, $uid, $from)
 {
-  my $cmd = shift;
-  my $args = shift;
-  my $chatid = shift;
-  my $rest = shift;
-
-  my $ip = $args->[0];
-  my $tree = $args->[1];
-
-  return notify($chatid, "Не указан IP-адрес") unless $ip;
-  return notify($chatid, "Не указан номер дерева") unless $tree;
-
-  return notify($chatid, "Неправильный IP-адрес: $ip") unless is_valid_ip($ip);
+  set_new_state("");
+}
 
-  my $res;
-  eval {
-    $res = await $client->get_p("device", "/pon?query=ip=\"$ip\"");
-  };
-  return notify($chatid, "Ошибка: " . parse_error($@)) if $@;
-  return notify($chatid, "Устройство с ip=$ip не найдено") if @$res<1;
-  
-  my $dev = $res->[0];
+sub command_logout($chatid, $uid, $rest)
+{
+  notify($chatid, _("Благодарим за использование нашего бота"));
 
-  my $sub;  
-  if ($dev->{type} =~ /^BDCOM/)
-  {
-    $sub = reference("bdcom_inspect");
-#    $sub = sub { bdcom->inspect(@_) };
-  }
-  elsif ($dev->{type} =~ /^C-DATA/)
+  $client->del("client", "/client/$uid/telegram");
+  if (my $err = $client->error)
   {
-    $sub = reference("cdata_inspect");
+    report($chatid, $err);
   }
 
-  return notify($chatid, "Неправильный номер дерева: $tree") unless is_valid_tree($dev->{type}, $tree);
-  
-  return notify($chatid, "Устройство $ip '$dev->{name}' неизвестного типа $dev->{type}") unless $sub;
-  
-#  notify($chatid, "Смотрю дерево $tree на устройстве $ip '$dev->{name}'");
+  $fsa->notes(uid => undef);
+  set_new_state("logged_out");
+}
 
-  my $text;
-  eval {
-    $text = await $sub->($ip, $dev->{login}, $dev->{password}, $tree);
-  };
+async sub command_balance
+{
+  my ($chatid, $uid, $rest) = @_;
+  my $money = await $abon_client->get_p($chatid, "client", "/client/$uid/money?human=1");
+  my $cur = $money->{human};
   
-  return notify($chatid, "$ip '$dev->{name}': $@") if $@;
+  my @lines = (
+    sprintf("<u>%s:</u> <b>%.2f $cur</b> (%s %.2f $cur + %s %.2f $cur) ",
+      _("Ваш баланс"), $money->{balance}, ("депозит"), $money->{deposit}, _("кредит"), $money->{credit}),
+  );
   
-  notify($chatid, "$ip '$dev->{name}' дерево $tree
-<code>$text</code>");
-
-};
-
-# onu 172.25.7.1 2 - получить короткую информацию об ONU на дереве 2 устройства 172.25.7.1
-async sub command_onu :Alias("ону")
-{
-  my $cmd = shift;
-  my $args = shift;
-  my $chatid = shift;
-  my $rest = shift;
+  push @lines, sprintf("<u>%s:</u> %s", _("Оплачено до"), format_date($money->{last_day})) if $money->{last_day} ne "-";
+  push @lines, sprintf("<u>%s:</u> %d%%", _("Скидка"), $money->{reduction}) if $money->{reduction};
 
-  my $ip = $args->[0];
-  my $tree = $args->[1];
+  push @lines, sprintf("<u>%s:</u> <b>%.2f $cur</b>  %s (%s)", 
+    _("Последнее снятие"), $money->{last_withdrawal}->{sum}, format_time($money->{last_withdrawal}->{date}), $money->{last_withdrawal}->{comment})
+    if $money->{last_withdrawal}->{sum};
+  push @lines, sprintf("<u>%s:</u> <b>%.2f $cur</b>  %s", _("Последний платеж"), $money->{last_payment}->{sum}, format_time($money->{last_payment}->{date}))
+    if $money->{last_payment}->{sum};
 
-  return notify($chatid, "Не указан IP-адрес") unless $ip;
-  return notify($chatid, "Не указан номер дерева") unless $tree;
-
-  return notify($chatid, "Неправильный IP-адрес: $ip") unless is_valid_ip($ip);
-
-  my $res;
-  eval {
-    $res = await $client->get_p("device", "/pon?query=ip=\"$ip\"");
-  };
-  return notify($chatid, "Ошибка: " . parse_error($@)) if $@;
-  return notify($chatid, "Устройство с ip=$ip не найдено") if @$res<1;
-  
-  my $dev = $res->[0];
-
-  my $sub;  
-  if ($dev->{type} =~ /^BDCOM/)
-  {
-    $sub = reference("bdcom_onu");
-  }
-  elsif ($dev->{type} =~ /^C-DATA/)
+  for (keys %{ $money->{accounts} })
   {
-    $sub = reference("cdata_onu");
+    push @lines, sprintf("<u>%s:</u> <b>%.2f $cur</b>", $_, $money->{accounts}->{$_});
   }
+    
+  reply($rest, @lines);    
+}
 
-  return notify($chatid, "Неправильный номер дерева: $tree") unless is_valid_tree($dev->{type}, $tree);
-  
-  return notify($chatid, "Устройство $ip '$dev->{name}' неизвестного типа $dev->{type}") unless $sub;
-  
-#  notify($chatid, "Смотрю дерево $tree на устройстве $ip '$dev->{name}'");
-
-  my $text;
-  eval {
-    $text = await $sub->($ip, $dev->{login}, $dev->{password}, $tree);
-  };
-  
-  return notify($chatid, "$ip '$dev->{name}': $@") if $@;
-  
-  notify($chatid, "$ip '$dev->{name}' дерево $tree
-<code>$text</code>");
-
-};
-
-# purge 172.1.1.1 2 - почистить дерево 2 на ПОН
-async sub command_purge :Alias("почистить")
+async sub command_info
 {
-  my $cmd = shift;
-  my $args = shift;
-  my $chatid = shift;
-  my $rest = shift;
-
-  my $ip = $args->[0];
-  my $tree = $args->[1];
-
-  return notify($chatid, "Не указан IP-адрес") unless $ip;
-  return notify($chatid, "Не указан номер дерева") unless $tree;
+  my ($chatid, $uid, $rest) = @_;
+  my $client = await $abon_client->get_p($chatid, "client", "/client/$uid");
+  reply($rest, 
+    sprintf("<u>%s</u>: %d", _("Лицевой счет"), $client->{uid}),
+    sprintf("<u>%s</u>: %s", _("Логин"), $client->{login}),
+    sprintf("<u>%s</u>: %s", _("ФИО"), $client->{fio}),
+    sprintf("<u>%s</u>: %s", _("Адрес"), $client->{address}),
+    sprintf("<u>%s</u>: %s", _("Телефон"), $client->{phone}),
+  );
+}
 
-  return notify($chatid, "Неправильный IP-адрес: $ip") unless is_valid_ip($ip);
-  
-  my $res;
-  eval {
-    $res = await $client->get_p("device", "/pon?query=ip=\"$ip\"");
-  };
-  return notify($chatid, "Ошибка: " . parse_error($@)) if $@;
-  return notify($chatid, "Устройство с ip=$ip не найдено") if @$res<1;
-  
-  my $dev = $res->[0];
+async sub command_credit
+{
+  my ($chatid, $uid, $rest) = @_;
+  my $money = await $abon_client->get_p($chatid, "client", "/client/$uid/money?human=1");
 
-  my $sub;  
-  if ($dev->{type} =~ /^BDCOM/)
-  {
-    $sub = reference("bdcom_purge");
-  }
-  elsif ($dev->{type} =~ /^C-DATA/)
+  if ($money->{credit} > 0)
   {
-    $sub = reference("cdata_purge");
+    return reply($rest, sprintf("%s <b>%.2f %s</b>", _("У вас уже установлен кредит"), $money->{credit}, $money->{human}));
   }
-
-  return notify($chatid, "Неправильный номер дерева: $tree") unless is_valid_tree($dev->{type}, $tree);
-  
-  return notify($chatid, "Устройство $ip '$dev->{name}' неизвестного типа $dev->{type}") unless $sub;
-  
-  notify($chatid, "Очищаю дерево $tree на устройстве $ip '$dev->{name}'");
-
-  my $text;
-  eval {
-      $text = await $sub->($ip, $dev->{login}, $dev->{password}, $tree, 1);
-  };
-  
-  return notify($chatid, "$ip '$dev->{name}': $@") if $@;
   
-  notify($chatid, "$ip '$dev->{name}' дерево $tree
-<code>$text</code>");
-
-};
+  reply_with($rest, {
+    inline_menu => [[
+      { text=>_("Я согласен с условиями"), callback_data=>"/set-credit" },
+    ]],
+  },
+    _("Вы можете самостоятельно установить кредит на два дня"),
+    _("<b>Ограничения</b>: только для физических лиц, продлевать кредит повторно до оплаты нельзя. При следующей оплате кредит будет погашен"),
+  );
+}
 
-# purge_all_trees 172.1.1.1 - почистить все деревья на устройстве 172.1.1.1
-async sub command_purge_all_trees :Alias("почистить_все_деревья")
+async sub command_set_credit
 {
-    my $cmd = shift;
-    my $args = shift;
-    my $chatid = shift;
-    my $rest = shift;
-
-    my $ip = $args->[0];
-
-    return notify($chatid, "Не указан IP-адрес") unless $ip;
+  my ($chatid, $uid, $rest) = @_;
 
-    return notify($chatid, "Неправильный IP-адрес: $ip") unless is_valid_ip($ip);
-
-    my $res;
-    eval {
-        $res = await $client->get_p("device", "/pon?query=ip=\"$ip\"");
-    };
-    return notify($chatid, "Ошибка: " . parse_error($@)) if $@;
-    return notify($chatid, "Устройство с ip=$ip не найдено") if @$res<1;
+  my $res = await $abon_client->post_p($chatid, "client", "/client/$uid/credit", {human=>1});
+  return reply($rest, _("Кредит не имеет смысла для бесплатных тарифных планов")) if $res->{credit} == 0;
   
-    my $dev = $res->[0];
-
-    my $sub;
-    if ($dev->{type} =~ /^BDCOM/)
-    {
-        $sub = reference("bdcom_purgeall");
-    }
-    elsif ($dev->{type} =~ /^C-DATA/)
-    {
-        $sub = reference("cdata_purgeall");
-    }
-
-    my $tree_count = get_tree_count($dev->{type});
-
-    notify($chatid, "$ip '$dev->{name}'\nВыполняю очистку ВСЕХ деревьев.\nОперация может быть долгой. Ожидайте.\nКоличество деревьев: $tree_count");
-
-    return notify($chatid, "Устройство $ip '$dev->{name}' неизвестного типа $dev->{type}") unless $sub;
+  await reply($rest, 
+    sprintf("%s <b>%.2f %s</b>", _("Установлен кредит "), $res->{credit}, $res->{human}), 
+    "",
+  );
   
-    my $res_ref;
-    eval {
-        $res_ref = await $sub->($ip, $dev->{login}, $dev->{password}, $tree_count, 1);
-#        say Dumper @{$res_ref};
-    };
-
-    return notify($chatid, "$ip '$dev->{name}': $@") if $@;
-
-# Also note that your bot will not be able to send more than 20 messages per minute to the same group.
-    my $w;
-    $w = AnyEvent->timer (after => 1, interval => 3, cb => sub {
-        if (scalar @{$res_ref} == 0) {
-            undef $w;
-        }
-
-        my $text = shift @{$res_ref};
-        if ($text) {
-            notify($chatid, "$ip '$dev->{name}'
-<code>$text</code>");
-        }
-
-    });
-
-};
-
-###################################
-
-sub is_valid_ip
-{
-  return $_[0] =~ /^(?:(?:25[0-5]|2[0-4][0-9]|[01]?[0-9][0-9]?)\.){3}(?:25[0-5]|2[0-4][0-9]|[01]?[0-9][0-9]?)$/;
+  command_balance($chatid, $uid, $rest);
 }
 
-sub get_tree_count
+=cut
+$VAR1 = [
+          {
+            'tariff' => {
+                        'monthly' => '0',
+                        'dayly' => '0',
+                        'entity' => 1000,
+                        'speed' => 0,
+                        'name_ru' => "\x{414}\x{43b}\x{44f} \x{441}\x{43e}\x{442}\x{440}\x{443}\x{434}\x{43d}\x{438}\x{43a}\x{43e}\x{432} MOL"
+                      },
+            'name' => 'pppoe',
+            'name_ru' => 'PPPoE',
+            'entity' => 32320,
+            'disabled' => 0
+          },
+          {
+            'tariff' => {
+                        'speed' => 0,
+                        'name_ru' => "\x{414}\x{43b}\x{44f} \x{441}\x{43e}\x{442}\x{440}\x{443}\x{434}\x{43d}\x{438}\x{43a}\x{43e}\x{432} MOL",
+                        'entity' => 1000,
+                        'monthly' => '0',
+                        'dayly' => '0'
+                      },
+            'name' => 'ipoe',
+            'entity' => 17,
+            'name_ru' => 'IPoE',
+            'disabled' => 0
+          }
+        ];
+=cut
+
+async sub command_service
 {
-    my $devtype = shift;
-    if ($devtype =~ /^BDCOM P3608/) {
-        return 8;
-    } elsif ($devtype =~ /^BDCOM P3600-08/) {
-        return 8;
-    } elsif ($devtype =~ /^BDCOM P3600-16/) {
-        return 16;
-    } elsif ($devtype =~ /^BDCOM P3616/) {
-        return 16;
-    } elsif ($devtype =~ /^BDCOM P3310/) {
-        return 4;
-    } elsif ($devtype =~ /^C-DATA FD1208/) {
-        return 8;
-    } elsif ($devtype =~ /^C-DATA FD1216/) {
-        return 16;
-    }
-    else
-    {
-      return 0;
-    }
-}
+  my ($chatid, $uid, $rest) = @_;
+  
+  my $res = await $abon_client->get_p($chatid, "client", "/client/$uid/service?human=1&as-array=1");
+  my @list = map { sprintf("<u>%s:</u> %s (%s '%s')", $_->{name_ru},  format_wd($_->{tariff}, $_->{human}), _("тариф"), $_->{tariff}->{name_ru}) } 
+     grep { !$_->{disabled} } @$res;
+  
+  reply($rest, @list);
+};
 
-sub is_valid_tree
+sub format_wd($rec, $cur)
 {
-    my $devtype = shift;
-    my $tree_num = shift;
+  return _("бесплатно") if $rec->{dayly} == 0 && $rec->{monthly} == 0;
 
-    my $tree_count = get_tree_count($devtype);
+  my $m = sprintf("<b>%.2f $cur</b> %s", $rec->{monthly}, _("в месяц")) if $rec->{monthly} != 0;
+  my $d = sprintf("<b>%.2f $cur</b> %s", $rec->{dayly}, _("в месяц")) if $rec->{dayly} != 0;
 
-    return ($tree_num <= $tree_count) && ($tree_num > 0);
+  return ("$m + $d") if $m && $d;
+  return $m if $m;
+  return $d if $d;  
 }
 
+################################################
+
 sub parse_error
 {
   my $e = shift;
-
   return $e unless ref $e;
   
   return "$e->{code} $e->{message} $e->{body}";
 }
 
 1;
+
+# что будет, если, к примеру, установка кредита вернет ошибку?
+# сервисы
+# перевод денег

modules/fsa.pm

@@ -0,0 +1,196 @@
+use Modern::Perl;
+use Data::Dumper;
+use Mojo::Base -strict, -signatures;
+
+use FSA::Rules;
+
+our $redis;
+our $config;
+our $client;
+our $commands;
+our $kb_menu;
+
+my %main = (
+   logged_out => {
+     rules => [
+       logged_out => sub($state, $line, $chatid, $rest)
+       {
+         if ($line ne "/start")
+         {
+           notify($chatid, _("Для начала работы наберите <b>/start</b>"), $rest);
+           return 1;
+         }
+
+         return undef;
+       },
+       
+       dummy => sub($state, $line, $chatid, $rest)
+       {
+         my $res = $client->get("client", "/telegram/$chatid/client");
+         if (my $err = $client->error)
+         {
+            if ($err->{code}==410)
+            {
+              reply($rest, _("Вас приветствует провайдер") . " " . $config->{provider});
+              reply($rest, _("Введите номер учетной записи или логин"));
+              $state->result("ask_login");
+            }
+            else
+            {
+              report($chatid, $err);
+              $state->result("error");
+            }
+         }
+         else
+         {
+           $state->result("logined");
+           $state->notes(uid => $res->{uid});
+         }
+  
+         return undef;
+       },
+       
+       needs_login => sub($state, $line, $chatid, $rest)
+       {
+         return $state->result eq "ask_login";
+       },
+       
+       logged_out => sub($state, $line, $chatid, $rest)
+       {
+         return $state->result eq "error";
+       },
+
+       command => 1,
+     ],
+   },
+
+   needs_login => { 
+     rules => [
+       needs_password => sub($state, $login, $chatid, $rest)
+       {
+         $state->notes(login => $login);
+         reply($rest, _("Теперь введите пароль"));
+         1;
+       },
+     ],
+   },
+
+   needs_password => {
+     rules => [
+       logged_out => sub($state, $password, $chatid, $rest)
+       {
+         my $login = $state->notes("login");
+         my $res = $client->post("client", "/telegram/client", {login=>$login, password=>$password, telegram_id=>$chatid});
+         $state->notes(login => undef);
+
+         if (my $err = $client->error)
+         {
+           report($chatid, $err);
+           return 1;
+         }
+         
+         my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
+         my $greet = $hour>=4 && $hour<=10 ? _("Доброе утро") : $hour>10 && $hour<6 ? _("Добрый день") : _("Добрый вечер");
+
+         reply($rest, "$greet, " . $res->{fio});
+         $state->notes(uid => $res->{uid});
+
+         return undef;
+       },  
+
+       command => 1,
+     ],
+   },
+   
+   command => {
+     rules => [
+       command => sub($state, $line, $chatid, $rest)
+       {
+         do_command($line, $chatid, $rest);
+         1;
+       }
+     ],
+   },
+   
+   dummy => {
+   },
+);
+
+our $fsa = FSA::Rules->new(%main);
+
+sub report($chatid, $err)
+{
+  if ($err->{code}>=400 && $err->{code}<500 && ref $err->{body} eq "HASH")
+  {
+    notify($chatid, $err->{body}->{text_ru});
+  }
+  else
+  {
+    my $code = int(rand(10000));
+    say STDERR "====== $code";
+    say STDERR Dumper $err;
+    notify($chatid, _("Ошибка авторизации. Сообщите в службу технической поддержки код") . " $code");
+  }
+}
+
+######################
+ 
+sub save_fsa_state($id)
+{
+  my $ks = make_key($id, "state");
+  my $kn = make_key($id, "notes");
+
+  $redis->set($ks, $fsa->curr_state->name);
+  $redis->expire($ks, 3600*24);
+  $fsa->notes(chatid => undef);
+say "saving state ", $fsa->curr_state->name, Dumper map { ($_, $fsa->notes->{$_}) } grep { defined $fsa->notes->{$_} } keys %{ $fsa->notes };  
+  $redis->hmset($kn, map { ($_, $fsa->notes->{$_}) } grep { defined $fsa->notes->{$_} } keys %{ $fsa->notes });
+  $redis->expire($kn, 3600*24);
+}
+
+sub restore_fsa_state($chat, $from)
+{
+  my $state = $redis->get(make_key($chat, "state"));
+  set_fsa_state($state, $chat, $from);
+}
+
+sub set_fsa_state($state, $chat, $from)
+{
+  if ($state)
+  {
+    my $notes = { $redis->hgetall(make_key($chat, "notes")) };
+    $fsa->notes($_ => $notes->{$_}) for keys %$notes;
+    $fsa->notes(chatid => $chat);
+    $fsa->curr_state($state);
+    say "restore ", $state, Dumper make_key($chat, "notes"), $notes;
+  }
+  else
+  {
+    $fsa->reset;
+    $fsa->notes(chatid => $chat);
+    $fsa->notes(lang => $from->{language_code});
+    $fsa->start;
+  }
+}
+
+sub process_input($line, $chatid, $rest)
+{
+  say "*** current state = ", $fsa->curr_state->name;
+  $fsa->switch($line, $chatid, $rest);
+
+  if (defined (my $new_state = $fsa->notes("new_state")))
+  {
+    say "*** mandatory switching to $new_state";
+    set_fsa_state($new_state, $chatid, $rest);
+    $fsa->notes(new_state => undef);
+  }
+
+  say "*** Switched to ", $fsa->curr_state->name;
+}
+
+sub set_new_state($name)
+{
+  $fsa->notes(new_state => $name);
+}
+
+1;

modules/localization.pm

@@ -0,0 +1,67 @@
+use Modern::Perl;
+
+package localization;
+
+use base 'Locale::Maketext';
+
+use Locale::Maketext::Lexicon {
+    "i-default" => ['Auto'],
+    _auto => 1,
+    _decode => 1,
+    _style => 'gettext',
+};
+
+sub init
+{
+  my $class = shift;
+  $class->fail_with(sub 
+  { 
+    my($lh, $key, @params) = @_;
+    $key =~ /^_"([^"]*)"$/; #"
+    return $lh->maketext($1||$key, @params);
+  });
+}
+
+sub add
+{
+  my $class = shift;
+  my $locale = shift;
+  my $file = shift;
+  
+  Locale::Maketext::Lexicon->import({
+    $locale => [Gettext => $file],
+    _auto => 1,
+    _decode => 1,
+    _style => 'gettext',
+  });
+}
+
+sub add_mo
+{
+  my $class = shift;
+  my $dir = shift;
+  my $locales = shift;
+  
+  my $handles = {};
+  
+  foreach my $lan (@$locales)
+  {
+    $class->add($lan, "$dir/$lan.mo");
+    $handles->{$lan} = $class->get_handle($lan);
+  }
+  
+  return $handles;
+}
+
+sub available_locales
+{
+  my $dir = shift;
+  return [ map { m|(\w+)\.mo$|; $1 } glob("$dir/*.mo") ];
+}
+
+sub fallback_languages
+{
+  return ("ru","i-default");
+}
+
+1;

run

@@ -1 +1,3 @@
-MOJO_CLIENT_DEBUG=1 MOJO_LOG_LEVEL=debug morbo abonbot.pl daemon --mode test --listen http://*:2218
+perl -c abonbot.pl
+MOJO_CLIENT_DEBUG=1 
+MOJO_LOG_LEVEL=debug morbo -v -w ./ -w ./modules ./abonbot.pl daemon --mode test --listen http://*:2218