Perl Multithreaded GTK + applet

Question

我想编写一个Perl GTK +应用程序，它将：

0.1）按下按钮A
  0.2）禁用A
  0.3）启动线程1和2
  0.4）启动线程3

线程3执行以下操作：

3.1）加入主题1
  3.2）加入线程2
  3.3）启用A

线程3完成后，应再次启用按钮A.

现在，这种方法在Win32下的C / C ++中完全有效，Linux使用本机GUI库和/或GTK +，KDE。 GTK +和Perl的问题在于你不能在线程中共享按钮变量（例如，线程3不能执行点3.3）。

问题是threads::shared仅对基本类型 ，而不是Gtk2::Button等引用。

我再次尝试bless Gtk2::Button对象（如文档中所示），但我收到了错误消息：

my $thread_button = shared_clone(Gtk2::Button->new('_Threads'));
bless $thread_button => 'Gtk2::Button';
$hbox->pack_start($thread_button, FALSE, FALSE, 0);
my ($jobA, $jobB);
$thread_button->signal_connect( clicked => sub {
        $thread_button->set_sensitive(0);
        if (defined($jobA)) {
            $jobA->join();
        }
        if (defined($jobB)) {
            $jobB->join();
        }
        # spawn jobs
        $jobA = threads->create(\&async_func, 10);
        $jobB = threads->create(\&async_func, 10);
        threads->create(sub { 
            $jobA->join();
            $jobB->join();
            bless $thread_button => 'Gtk2::Button';
            $thread_button->set_sensitive(1);
            });
    });

我的代码好吗？ 我问，因为当它运行时，GUI将不会显示 Thread 按钮并报告以下错误：

Gtk-CRITICAL **: gtk_box_pack: assertion `GTK_IS_WIDGET (child)' failed at vbox.pl line 48. (Where I use pack_start)
GLib-GObject-WARNING **: invalid (NULL) pointer instance at vbox.pl line 67.
GLib-GObject-CRITICAL **: g_signal_connect_closure: assertion `G_TYPE_CHECK_INSTANCE (instance)' failed at vbox.pl line 67. (the signal_connect doesn't work)

显然这不适用于复杂的物体 我尝试了另一个修复，轮询在主（GTK）线程中调用的回调函数中运行的线程：

my $thread_button = Gtk2::Button->new('_Threads');
$hbox->pack_start($thread_button, FALSE, FALSE, 0);
my ($jobA, $jobB);
$thread_button->signal_connect( clicked => sub {
        $thread_button->set_sensitive(0);
        # spawn jobs
        $jobA = threads->create(\&async_func, 10);
        $jobB = threads->create(\&async_func, 10);
        Glib::Timeout->add(3000, sub { 
                print "TIMER\n";
                if (defined($jobA)) {
                    if (! $jobA->is_running()) {
                        print "jobA is not running!\n";
                        $jobA->join();
                        undef $jobA;
                    }
                }
                if (defined($jobB)) {
                    if (! $jobB->is_running()) {
                        print "jobB is not running!\n";
                        #$jobB->join();
                        undef $jobB;
                    }
                }
                if (!defined($jobA) && !defined($jobB)) {
                    print "Both jobs have terminated!\n";
                    $thread_button->set_sensitive(1);
                    return 0;
                }
                return 1;
                });
    });

请注意以下事项：
1）我必须在第二个帖子上评论 join

#$jobB->join();

否则小程序会崩溃 2）显然它可以工作，但是当我第二次点击重新启用的按钮时，线程创建会破坏应用程序

这很不稳定。我认为Perl更基于C语言，但C / C ++中完全没有这种巨大的不稳定性。我有点失望。
有没有人有更多的建议？ 多线程API在Perl中是 unnstable 吗？

最新更新。 此代码有效：

my $thread_button = Gtk2::Button->new('_Threads');
$hbox->pack_start($thread_button, FALSE, FALSE, 0);
my ($jobA, $jobB);
$thread_button->signal_connect( clicked => sub {
        $thread_button->set_sensitive(0);
        # spawn jobs
        $jobA = threads->create(\&async_func, 10);
        $jobB = threads->create(\&async_func, 10);
        Glib::Timeout->add(100, sub { 
                if (!$jobA->is_running() && !$jobB->is_running()) {
                    print "Both jobs have terminated!\n";
                    $thread_button->set_sensitive(1);
                    return 0;
                }
                return 1;
                });
    });

但：
1）我必须轮询线程（在现代CPU上不是非常耗费资源但 NOT 优雅......一个应该只依赖OS同步原语）
2）我无法加入线程，否则applet崩溃了 3）给定（2）每次按下按钮都会有大量内存泄漏

老实说，我越是看到这一点，我就越相信，对于合适的应用程序开发者，你不能依赖Perl ......但即使从原型方面来看，它也有点糟糕。
我希望我做错了......在这种情况下，有人可以帮助我吗？

干杯，

Answer 1

如threads::shared docs中所述，您需要重新祝福共享对象。

更新：尝试以下变体

#!/usr/bin/perl

package Button;

use strict;  use warnings;
# Trivial class because I do not have GTK2

sub new { bless \ my $self => $_[0] }
sub enable     { ${ $_[0] } = 1; return }
sub disable    { ${ $_[0] } = 0; return }
sub is_enabled { ${ $_[0] } ? 1 : 0 }

package main;

use strict;  use warnings;
use threads; use threads::shared;

my $buttonA = shared_clone( Button->new );
my $button_class = ref $buttonA;

$buttonA->disable;

my @thr = map { threads->create(
    sub {
        print "thread $_ started\n";
        sleep rand 3;
        print "thread $_ finished\n";
        return; }
) } (1, 2);

my $thr3 = threads->create( sub {
        $_->join for @_ ;
        bless $buttonA => $button_class;
        $buttonA->enable;
    }, @thr,
);

$thr3->join;

printf "buttonA is %s\n", $buttonA->is_enabled ? 'enabled' : 'disabled';

另一种方法是将回调传递给$thr3：

my $buttonA = Button->new;
share($buttonA);
$buttonA->disable;

# start the other threads

my $thr3 = threads->create( sub {
        my $callback = shift;
        $_->join for @_ ;
        $callback->();
    }, sub { $buttonA->enable }, @thr,
);

两个版本的代码都会产生输出：

thread 1 started
thread 2 started
thread 1 finished
thread 2 finished
buttonA is enabled

Answer 2

我在perl中读过几个关于线程和GTK的例子，但是所有这些都初始化了 worker 线程，然后他们将状态切换为run / halt ...
并发开发的非常糟糕的例子。

还有其他建议吗？

干杯，