Perl Multithreaded GTK+ applet - perl

Question

I'd like to write a Perl GTK+ application which will:
0.1) Press button A
0.2) Disable A
0.3) start threads 1 and 2
0.4) start thread 3
Thread 3 does the following:
3.1) join thread 1
3.2) join thread 2
3.3) Enable A
On completion of thread 3, the button A should be enabled again.
Now, this kind of approach is perfectly valid in C/C++ under Win32, Linux using native GUI libraries and/or GTK+, KDE. Problem with GTK+ and Perl is that you can't share the button variable within threads (eg. point 3.3 can't be performed by thread 3).
The problem is that threads::shared works only on base types, not on references like Gtk2::Button.
I tried to bless the Gtk2::Button object again (as shown in the docs), but I got an error:
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);
});
});
Is my code ok?
I'm asking because when it runs the GUI won't display the Thread button and report the following error:
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)
Apparently this doesn't work with complex objects.
I've tried another fix, polling for the running threads inside a callback function invoked in the main (GTK) thread:
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;
});
});
Please note the following things:
1) I have to comment the join on the second thread
#$jobB->join();
Otherwise the applet will crash.
2) Apparently it works, but when I click on the re-enabled button for the second time, the thread creation crahses the application
This is a lot unstable. I thought Perl was more C based, but this huge instability is totally absent in C/C++. I'm a bit disappointed.
Does anyone have more suggestions?
Is the multithread API such unnstable in Perl?
Latest update.
This code works:
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;
});
});
But:
1) I have to poll for threads (not very resources intensive on modern CPUs but NOT elegant ... one should rely only on OS sync primitives)
2) I can't join threads otherwise the applet crashes
3) Given (2) there are huge memory leaks every time I push the button
Honestly the more I see this the more I'm convinced that for proper app dev you can't rely on Perl...but even from a prototype-wise point of view it kinda sucks.
I hope I'm doing something wrong...in this case, could anyone please help me?
Cheers,

Answer 1

As explained in the threads::shared docs, you need to re-bless shared objects.
Update: Try the following variation
#!/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';
Another alternative is to pass a callback to $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,
);
Both versions of the code produce the output:
thread 1 started
thread 2 started
thread 1 finished
thread 2 finished
buttonA is enabled

Answer 2

I've read a couple of examples about threads and GTK in perl, but all of them initialize worker threads and then they'll switch their status to run/halt...
Very bad example of concurrent development.
Any more suggestions?
Cheers,