abonbot/modules/commands.pm

use Modern::Perl;
use AnyEvent;
use utf8;

use Mojo::Base -strict, -async_await;
use Data::Dumper;

use bdcom;
use cdata;

our $client;
our $redis;
our $db;

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

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>
---
}

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;
        }
    }
  }

  return notify($chatid, "Не нашёл MAC ONU=\"$onu_mac\"") unless $search_res;

}

# inspect 172.25.7.1 2 - посмотреть информацию об ONU на дереве 2 устройства 172.25.7.1
async sub command_inspect :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 sub command_onu :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 sub command_purge :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 sub command_purge_all_trees :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 $@;

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

sub get_tree_count
{
    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;
    }
}

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;