1

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

それで、解決策は何ですか？何かの組合？共有変数が役に立たないようです。または、正しく使用していません。カウンターに「our」または「my」を使用しても違いはありません

4

2 に答える 2

1

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;
}
于 2012-08-20T13:48:09.897 に答える
1

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

-textvariable が正しく機能するように、割り当ては gui サブ内で行われます。

于 2012-08-22T10:00:15.603 に答える