Обновление метки из потока в Perl

Question

Я использую Perl на Linux-боксе, и у меня есть 2 устройства - ПК (Linux-бокс) и маршрутизатор / dsl-thingy - в моей локальной сети по IP-адресам 192.168.1.1 & 192.168.1.2 и я пытаюсь перечислить или показать прогресс проверки ping такого + теста 8 других несуществующих устройств с приведенным ниже кодом, но у меня проблемы с обновлением StatusLabel, любая помощь ...

for($i=1;$i<=10;++$i) { # --- $i<$VarClients --- 254
my $thr_List = ("ping$i");
$thr_List = threads->create(\&pingingthreads, "$i");
} 

sub pingingthreads{

     my @pingpong = ping("$localAddress$i", '-c 1', '-i .2'); # -i may not count for much?
     print "Pinging: $localAddress$i\n"; # output goes from address1 - address10 ok

     $StatusLabel = "Pinging: $localAddress$i";  # only the last responding one(device) seems to be shown in my statuslabel?!
     $val = ($val + 10); # 0.392156863
     print "$val\% done...\n"; # goes to 100% for me ok

    # $indicatorbar->value( $val ); # I have a ProgressBar and it gets stuck on 20% also

    if ($val == 100){$val = 0;
    } # reset after scanning
    # then after the last ping, update the statusLable:
        #my @ParamList = ('something', 'testing', 7, 8, 9);
        #$thr5 = threads->create(\&updateStatusLable, @ParamList); # starting a thread within a thread ???

# ping response text...
for( @pingpong ) { # need to do something for none responding clients & any time laps/ping latency..., or *** ???
$pong=$_; 
chop ($pong);           # Get rid of the trailling \n   ??
if ($pong =~ m/1 packets transmitted, 1 received, 0% packet loss/) {   
    push(@boxs, "$localAddress$i");
} else{
# see the other lines from the ping's output
# print "$pong\n";
}
}
}
# For $localAddress$i icmp_seq=1 Destination Host Unreachable ???

--------------------- # StatusBar/progress label & bar ----------------
my $sb = $main->StatusBar();        
$sb->addLabel( -textvariable => \$StatusLabel,
    -relief => 'flat',
    -font => $font, 
    -foreground => "$statusbartextColour",
    );


my $indicatorbar = $sb->ProgressBar( -padx=>2, -pady=>2, -borderwidth=>2,
          -troughcolor=>"$Colour2", 
        -colors=>[ 0, "$indicatorcolour" ],
          -length=>106, 
        -relief => 'flat',
        -value => "$val",
         )->pack;

  # $val = 0;
  # $indicatorbar->value( $val );

=====================================
my $StatusLabel :shared = ();
my $val :shared = (0); # var for progress bar value

Я загрузил свой полный код здесь (http://cid -99cdb89630050fff.office.live.com / browse.aspx / .Public), если необходимо, его в Boxy.zip ...

Answer 1

По умолчанию данные в потоках Perl private ; Обновление переменной в одном потоке не изменит значения этой переменной в других потоках (или в основном потоке). Вы захотите объявить $val как общую переменную. См. threads::shared.

Я вижу, что вы объявили $val общим в нижней части скрипта, поэтому я не видел его, пока не стало слишком поздно. Не случайно, интерпретатор Perl также не увидит эту декларацию, пока не станет слишком поздно. Лучшие 95% вашей программы манипулируют глобальной, частной переменной потока $var, а не лексической, общей $var, которую вы объявляете в конце вашего скрипта. Переместите это объявление в начало скрипта.

Поместив use strict в начало вашей программы, вы поймете это и сэкономите минуты, если не часы, скорби.

Answer 2

Сначала извините за ответ здесь, но я потерял мой файл cookie или возможность отвечать и редактировать и т. Д ...

Спасибо, ikegami, мне придется некоторое время поиграть с примером, чтобы посмотреть, смогу ли я что-то придумать и смешать с тем, что я делаю ... но на первый взгляд выглядит просто отлично ... Спасибо, очень много.

Мне удалось обновить $ StatusLabel, используя:

# in 3 seconds maybe do a fade to: Ready...
my @ParamList = ('ping', 'testing', 4, 5, 6);
$thr2 = threads->create(\&updateStatusLable, @ParamList);

sub updateStatusLable {
# should probably check if threads are running already first???
# and if so ***/*** them ???

my @InboundParameters = @_;
my $tid = threads->tid();
# my $thr_object = threads->self(); # Get a thread's object
# print("This is a new thread\($tid\)... and I am counting to 3...\n");
sleep(3);
    $StatusLabel = "Ready..."; # print "Am now trying to change the status bar's label to \"Ready...\"\n";
# try updating better/smoother... My main window needs "focus and a mouse move" I think
    # for the new text to appear...

   # print('Recieved the parameters:  ', join(', ', @InboundParameters), ".\n" );
   # $returnedvalue = "the thread should return this...";
   # return($returnedvalue); # try returning any value just to test/see how...
}

но попробую ваш метод ... Еще раз спасибо.

Answer 3

Ты не. Фреймворки GUI, как правило, не являются поточно-ориентированными. Вы передаете информацию потоку, в котором вместо этого выполняется GUI. Пример * +1003 *