[PerlChina] 请 教t kx线 程

Wed, 17 Nov 2010 05:08:31 -0800 

仿照人家的源码

#!/usr/bin/perl -w
use strict;
use warnings;
use threads;
use threads::Shared;
use Tkx;

my $child_finished_flag: shared = 0;
my $child_request_flag: shared = 0;

my $ChildThread = threads->create( \&child_thread );
$ChildThread->detach();

my $mw = Tkx::widget->new(".");
$mw->g_wm_title("4 Test");

my $container = $mw->new_ttk__frame;
my $frame = $container->new_ttk__frame();

my $testt = $frame->new_ttk__entry(-textvariable => \my $test);
my $ok = $frame->new_ttk__button(-text => "Test...", -command =>
\&process);
$container->g_grid(-column => 0, -row => 0);
$frame->g_grid(-column => 0, -row => 0, -sticky => "w");

$testt->g_grid(-column => 0, -row => 0);
$ok->g_grid(-column => 0, -row => 1);

Tkx::MainLoop();

sub process {
    $child_request_flag= 1;
    &check_status_1;
}
#
sub check_status_1 {
    Tkx::after(500, sub {
        if ($child_finished_flag== 1) {
            $child_finished_flag = 0;
            $child_request_flag = 0;
            print "child_request finished\n";
        }
        else {
            &check_status_2;
            print "child_request processing\n";
            }
        });
}
#
sub check_status_2 {
    Tkx::after(500, sub {
    &check_status_1;
    });
}
#
sub child_thread {
    while (1) {
        sleep 2;
        if ($child_request_flag== 1) {
             print "begin child_request\n";
             &test;
             $child_finished_flag= 1;
             }else {
                 print "waiting for child_request\n";
             }
    }
}

sub test {
      $test=  $testt->get();
      print "test is: $test\n";
}

在entry中输入任意字符
点击command
Thread 1 terminated abnormally: Can't call method "get" on an
undefined value at demo.pl line 69.
子线程中为何没法get？
在tk的那个线程就算是get了获得的值 shared后 貌似也无法传递过来？
一头雾水。。。
谢谢

-- 
您收到此邮件是因为您订阅了 Google 网上论坛的“PerlChina Mongers 讨论组”论坛。
要向此网上论坛发帖，请发送电子邮件至 [email protected]。
要取消订阅此网上论坛，请发送电子邮件至 [email protected]。
若有更多问题，请通过 http://groups.google.com/group/perlchina?hl=zh-CN 访问此网上论坛。

回复