Question

我想要一个gui来显示我的变量的值，所以我可以看它工作。下面的代码会增加$ counter，但标签不会像'textvaraible'那样更新。问题可能是范围，线程在变量$ counter的单独副本上工作，当你结束脚本INT_handler打印5时，显示原始变量没有变化。

#!/usr/bin/perl
use threads; use threads::shared; use warnings;

my $counter :shared = 5;
$counter_t = threads->create(\&counter); # counting thread
use Tk;
print "gui thread started\n";
my $mw = MainWindow->new;
$mw->geometry("100x100");
$label = $mw->Label(-textvariable => \$counter)->pack(qw/-anchor nw -padx 10/);

$SIG{'INT'} = 'INT_handler';

sub counter{    
    print "counter thread started\n";
    while(1){       
        sleep(1);
        $counter++;
        print $counter . "\n";
    }
}

MainLoop;

sub INT_handler {
    print "\nCounter value is " . $counter . "\n";
    exit(0);
}

那么，解决方案是什么？某种联盟？共享变量似乎没有帮助，或者我没有正确使用它。使用“我们的”或“我的”作为计数器没有什么区别

Answer 1

一种方法是使用Thread :: Queue - 所有线程都将信息推入（入队）到结果队列，你将在主代码中处理它：

sub start {

    my @result;

    $queue= Thread::Queue->new;
    $queue_processed = Thread::Queue->new;

    my @domains = get_domains($domains_filename);

    $queue->enqueue(@domains);

    my @threads= map { threads->create( sub { create_thread($_) } ) } ( 1 .. $CONFIG{NUMBER_OF_THREADS} );

    $_->detach for (@threads);

    my $counter = 0;

    while ( $counter < scalar @domains ) {

    my $result = $queue_processed->dequeue_nb;

    if ($result) {

        if ( $result->{status} ) {

        $txt_processed_domains->configure(-state => "normal");
        $txt_processed_domains->insert_end( $result->{domain} . ".com" . " => " . "Available!" );
        $txt_processed_domains->see("end");
        $txt_processed_domains->configure(-state => "disabled");
        Tkx::update();
        $counter++;

        Win32::Sound::Volume('100%');
        Win32::Sound::Play( $CONFIG{SOUND_FILE} );
        Win32::Sound::Stop();

        my $response = Tkx::tk___messageBox( -type => "yesno", -message => $result->{domain} . ".com" . " is " . "Available! Continue?", -icon => "question", -title => "Domain found" );

        unless ( $response eq 'yes' ) {

            exit;
        }
        }
        else {

        $txt_processed_domains->configure(-state => "normal");
        $txt_processed_domains->insert_end( $result->{domain} . ".com" . " => " . "Already taken!" );
        $txt_processed_domains->itemconfigure( $counter, -background => "#f0f0ff" );
        $txt_processed_domains->see("end");
        $txt_processed_domains->configure(-state => "disabled");
        Tkx::update();
        $counter++;
        }
    }

    }

    Tkx::tk___messageBox( -message => "Completed!" );
}

sub create_thread {

    my $thread_id = shift;

    my ($domain);

    while( $domain = $queue->dequeue_nb ) {

    my $mech = MyMech->new( autocheck => 1 );
    $mech->quiet(0);

    $mech->get( $CONFIG{BASE_URL} . "domains/search.aspx?domainToCheck=$domain&tld=..com" );

    if ( $mech->content() =~ m{is\s+available!}is ) {

        open my $fh, ">>", $result_filename or die "Couldn't create result file! $!";

        #$queue_processed->enqueue( "$domain.com => Available!" );
        $queue_processed->enqueue( { status => 1, domain => $domain, } );

        print $fh "$domain.com\n";
        close $fh;
    }
    else {

        $queue_processed->enqueue( { status => 0, domain => $domain, } );
    }

    #sleep $CONFIG{DELAY_BETWEEN_REQUESTS};
    }

    return 1;
}

Answer 2

http://www.perlmonks.org/?node_id=585533

回答了我的问题

#!/usr/bin/perl
use warnings;
use strict;
use threads;
use threads::shared;

# for shared vars .....
# declare, share then assign value
my $ret;
share $ret;
$ret = 0;
my $val = 0;
#create thread before any tk code is called
my $thr = threads->create( \&worker );

gui();    

# tk code only in main
sub gui {
    use Tk;
    my $mw = MainWindow->new();
    my $label = $mw->Label(
         -textvariable => \$val )->pack();

    $mw->repeat(10,sub{
              $val = $ret;              
             });
    MainLoop;
}

# no Tk code in thread
sub worker {
   for(1..10){
     print "$_\n"; 
     $ret = $_;
     sleep 1; 
    }
   $ret = 'thread done, ready to join';
   print "$ret\n";
}

赋值发生在gui sub中，以便-text变量正常工作

将数据传递给tk gui

2 个答案: