从Perl中的线程更新标签

时间:2011-09-02 14:24:10

标签: linux multithreading perl

我在linux机箱上使用perl,我有两台设备 - 一台电脑(Linux机箱)和一台路由器/ dsl-thingy - 在我的本地网上,地址为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中...

3 个答案:

答案 0 :(得分:3)

默认情况下,Perl线程中的数据是私有;对一个线程中的变量的更新不会更改其他线程(或主线程)中该变量的值。您需要将$val声明为共享变量。 见threads::shared

我看到你已经在脚本的底部声明了$val,所以直到为时已晚,我才看到它。并非巧合的是,Perl解释器也不会看到这个声明,直到为时已晚。您的程序的前95%正在操作全局的线程私有变量$var,而不是您在脚本末尾声明的词汇,共享$var。将此声明移到脚本的顶部。

use strict放在程序的顶部会抓住这个并为你节省几分钟,甚至几小时的悲伤。

答案 1 :(得分:0)

你没有。 GUI框架往往不是线程安全的。您将信息传递给运行GUI的线程。 Example

答案 2 :(得分:0)

首先很抱歉在这里回复,但丢失了我的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...
}

但会尝试你的方法......再次感谢。