0

我想编写一个 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++、使用原生 GUI 库的 Linux 和/或 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: 断言 `GTK_IS_WIDGET (child)' 在 vbox.pl 第 48 行失败。（我使用 pack_start 的地方）
GLib-GObject-WARNING **：vbox.pl 第 67 行的无效（NULL）指针实例。
GLib-GObject-CRITICAL **：g_signal_connect_closure：断言“G_TYPE_CHECK_INSTANCE（实例）”在 vbox.pl 第 67 行失败。（signal_connect 不起作用）

显然这不适用于复杂的对象。
我尝试了另一种修复方法，轮询在主（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）我必须在第二个线程上评论加入

#$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……但即使从原型的角度来看，它也有点糟糕。
我希望我做错了什么......在这种情况下，有人可以帮助我吗？

干杯，

4

2 回答 2

2

如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,
);

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

线程 1 开始
线程 2 开始
线程 1 完成
线程2完成
按钮A已启用
于 2009-08-17T15:28:57.940 回答
0

我已经阅读了几个关于 perl 中的线程和 GTK 的示例，但是它们都初始化了工作线程，然后它们会将它们的状态切换为运行/停止......
并发开发的非常糟糕的例子。

还有什么建议吗？

干杯，

于 2009-08-19T09:10:27.367 回答