implement purge_all_trees and fix cdata_extract_onu_info

modules/bdcom.pm

@@ -98,6 +98,33 @@ async bdcom_get_onu_info => sub
     return %res;
 };
 
+async bdcom_fun_purge_tree => sub
+{
+    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 bdcom_inspect => sub
 {
     my $ip = shift;
@@ -181,19 +208,7 @@ async bdcom_purge => sub
         return "Нечего чистить";
     }
 
-    await $t->cmd("config");
-    await $t->cmd("interface EPON0/$tree");
-
-    foreach my $i ( @{$onu_info{'inactive'}} ) {
-#        say Dumper @$i[1];
-        my $onu_mac = @$i[1];
-        my @tmp = await $t->cmd("no epon bind-onu mac $onu_mac");
-#        say Dumper @tmp;
-    }
-
-    my @deleted_onu = map { sprintf("%2d %s", $_->[0], $_->[1]) } @{$onu_info{inactive}};
-
-    await $t->cmd("exit");
+    my @deleted_onu = await bdcom_fun_purge_tree($t, $tree, \%onu_info);
 
     %onu_info = await bdcom_get_onu_info($t, $tree);
 
@@ -215,5 +230,82 @@ async bdcom_purge => sub
     return $res;
 };
 
+async bdcom_purgeall => sub
+{
+    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:\n" . join("\n", @deleted_onu) if @deleted_onu > 0;
+
+        push @res, $res;
+
+    }
+
+    if ($save) {
+        await $t->cmd("write all");
+    }
+
+    $t->close;
+
+    return \@res;
+};
+
+
+
+async bdcom_save => sub
+{
+    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

@@ -9,7 +9,9 @@ use Data::Dumper;
 sub cdata_extract_onu_info {
     my @lines = @_;
 
-    my @onu_info = @lines[6..@lines-5];
+#    say Dumper @lines;
+
+    my @onu_info = @lines[4..@lines-5];
 
     return map([ split(' ', $_) ], @onu_info );
 };
@@ -77,6 +79,33 @@ async cdata_get_onu_info => sub
 
 };
 
+async cdata_fun_purge_tree => sub
+{
+    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 cdata_inspect => sub
 {
     my $ip = shift;
@@ -151,20 +180,7 @@ async cdata_purge => sub
         return "Нечего чистить.";
     }
 
-    #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];
-        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}};
+    my @deleted_onu = await cdata_fun_purge_tree($t, $tree, \%onu_info);
 
     %onu_info = await cdata_get_onu_info($t, $tree);
 
@@ -186,4 +202,54 @@ async cdata_purge => sub
     return $res;
 };
 
+async cdata_purgeall => sub
+{
+    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:\n" . join("\n", @deleted_onu) if @deleted_onu > 0;
+
+        push @res, $res;
+
+    }
+
+    if ($save) {
+        await $t->cmd("save");
+    }
+
+    $t->close;
+
+    return \@res;
+};
+
 1;

modules/commands.pm

@@ -1,4 +1,5 @@
 use Modern::Perl;
+use Time::HiRes qw( usleep );
 use utf8;
 
 use Mojo::AsyncAwait;
@@ -24,6 +25,8 @@ sub command_help :Alias("помощь")
   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 на дереве
@@ -191,6 +194,63 @@ async command_purge => sub :Alias("почистить")
 
 };
 
+# 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

run

@@ -1 +1 @@
-MOJO_CLIENT_DEBUG=1 MOJO_LOG_LEVEL=debug morbo djinn.pl daemon --mode test --listen http://*:2217
+MOJO_CLIENT_DEBUG=1 MOJO_LOG_LEVEL=debug morbo djinn.pl daemon --mode alakiza_test --listen http://*:2217