Perl Multithreaded GTK+ applet

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

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,

Answer 2

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