abonbot/modules/commands.pm

use Modern::Perl;
use Time::HiRes qw( usleep );
use utf8;

use Mojo::AsyncAwait;
use Data::Dumper;

use bdcom;
use cdata;

our $client;

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

sub command_help :Alias("помощь")
{
  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>
---
}

# inspect 172.25.7.1 2 - посмотреть информацию об ONU на дереве 2 устройства 172.25.7.1
async command_inspect => sub :Alias("проверить")
{
  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);

  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_inspect");
#    $sub = sub { bdcom->inspect(@_) };
  }
  elsif ($dev->{type} =~ /^C-DATA/)
  {
    $sub = reference("cdata_inspect");
  }

  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>");

};

# onu 172.25.7.1 2 - получить короткую информацию об ONU на дереве 2 устройства 172.25.7.1
async command_onu => sub :Alias("ону")
{
  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);

  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/)
  {
    $sub = reference("cdata_onu");
  }

  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 command_purge => sub :Alias("почистить")
{
  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);
  
  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_purge");
  }
  elsif ($dev->{type} =~ /^C-DATA/)
  {
    $sub = reference("cdata_purge");
  }

  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>");

};

# purge_all_trees 172.1.1.1 - почистить все деревья на устройстве 172.1.1.1
async command_purge_all_trees => sub :Alias("почистить_все_деревья")
{
    my $cmd = shift;
    my $args = shift;
    my $chatid = shift;
    my $rest = shift;

    my $ip = $args->[0];

    return notify($chatid, "Не указан IP-адрес") unless $ip;

    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_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;
  
    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 $@;

    foreach my $text (@{$res_ref}) {
        await notify($chatid, "$ip '$dev->{name}'
<code>$text</code>");
#Telegram не даёт отправлять боту больше 20-ти сообщений в секунду, выставляем некоторую задержку
        sleep(1);

    }

};

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

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]?)$/;
}

sub get_tree_count
{
    my $devtype = shift;
    if ($devtype =~ /^BDCOM P3608/) {
        return 8;
    } elsif ($devtype =~ /^BDCOM P3600-08/) {
        return 8;
    } 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;
    }

    return 0;
}

sub is_valid_tree
{
    my $devtype = shift;
    my $tree_num = shift;

    my $tree_count = get_tree_count($devtype);

    return ($tree_num <= $tree_count) && ($tree_num > 0);
}

sub parse_error
{
  my $e = shift;

  return $e unless ref $e;
  
  return "$e->{code} $e->{message} $e->{body}";
}

1;