Perl 多线程 GTK+ 小程序

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、Linux 下使用本机 GUI 库和/或 GTK+、KDE ​​下的 C/C++ 中完全有效。 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++ 中完全不存在。 我有点失望。
有人有更多建议吗？ Perl 中的多线程 API 是如此不稳定吗？

最新更新。 这段代码有效：

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上资源不是很密集，但不优雅......应该只依赖操作系统同步原语）
2）我无法加入线程，否则小程序会崩溃
3) 鉴于 (​​2) 每次我按下按钮时都会出现巨大的内存泄漏

老实说，我看到的越多，我就越相信对于正确的应用程序开发，你不能依赖 Perl...但即使是从原型 -明智的观点有点糟糕。
我希望我做错了什么......在这种情况下，有人可以帮助我吗？

干杯，

Answer 1

正如threads::shared 文档中所述，你需要重新祝福共享对象。

更新：尝试以下变体

#!/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 的示例，但它们都初始化 工作线程 线程，然后它们将其状态切换为运行/停止...
并发开发的非常糟糕的例子。

还有更多建议吗？

干杯，