[Kde-perl] PerlQt and perl threads

David Greaves david at dgreaves.com
Sun Oct 10 14:18:13 CEST 2004


Hi

I'm having some problems with using threads and PerlQt.

Is this a known issue?

It mostly works but I'm unable to 'join' or 'detach' threads.

detaching gives a segfault when the detached thread ends.
joining gives 'DESTROY created new reference to dead object ' 
Qt::HBoxLayout' during global destruction.'

Any suggestions?

I have a little(ish) test case:

################################################
use strict;

package Button;
use Qt;
use Qt::isa qw(Qt::PushButton);
use Qt::attributes qw(onClickSub);
use Qt::slots wasClicked => [];

sub NEW
{
  shift->SUPER::NEW(@_[0..2]);
  this->connect(this, SIGNAL 'clicked()', SLOT 'wasClicked()');
  onClickSub = @_[3];
}

sub wasClicked
{
   if (onClickSub) {
       my $s = onClickSub; # &{onClickSub)(this); doesn't seem to work
       &$s(this);
   }
}

package MyThread;

use threads;
use threads::shared qw (share);
use Thread::Queue;

# Keep a pool of threads that are in use
my %pool;

sub get {
    my $proto = shift;
    my $class = ref($proto) || $proto;

    my $id = shift;
    print "MyThread: Id is $id\n";
    # Return thread from pool if possible
    return $pool{$id} if defined($pool{$id});

    print "Making a new $class\n";
    my $self  = &share({});
    bless ($self, $class);
    share ($self);
    my $q : shared = Thread::Queue->new;

    $self->{ID}   = $id;
    $self->{Q} = \$q;
    $self->{STATUS} = "new";
    $self->{TID} =  threads->new(\&MyThread::_T, $self)->tid;
    do {
    threads->yield;
    } until $self->isReady;
    $pool{$id} = $self;
    return $self;
}

sub _T {
    my $self=shift;
    print $self->{ID}." _T started\n";
    $self->_ready;
    threads->yield;
    my $q = $self->{Q};
    while ((my $data = $$q->dequeue) ne "Stop") {
    $self->_busy;
    print $self->{ID}." Popped '$data'' off the queue\n";
    for my $i (1..5) { print $self->{ID}.".\n"; sleep 1;}
    print $self->{ID}." Finished ".$self->{TID}."\n";
    $self->_ready;
    }
    print "Ending ".$self->{TID}."\n";
    return 1;
}

sub _busy {
    my $self=shift;
    $self->{STATUS}="Busy";
}
sub _ready {
    my $self=shift;
    $self->{STATUS}="Ready";
}

sub isReady {
    my $self=shift;
    return $self->{STATUS} eq "Ready";
}

sub Start {
    my $self=shift;
    ${$self->{Q}}->enqueue("Go");
}

sub cleanup_d {
    foreach my $h (keys %pool) {
    my $obj = $pool{$h};
    print "Detaching $h : ".$obj->{TID}."\n";
    ${$obj->{Q}}->enqueue("Stop");
    my $thr= threads->object($obj->{TID});
    $thr->detach if $thr;
    print "Detached $h : ".$obj->{TID}."\n";
    }
}

sub cleanup_j {
    foreach my $h (keys %pool) {
    my $obj = $pool{$h};
    print "Joining $h : ".$obj->{TID}."\n";
    ${$obj->{Q}}->enqueue("Stop");
    my $thr= threads->object($obj->{TID});
    $thr->join if $thr;
    print "Joined $h : ".$obj->{TID}."\n";
    }
}


package main;

use Qt;
use Button;

# Called from a Button object
sub startT {
    my $caller = shift;
    my $id = caller->text();
    print STDERR "startT : $id\n";
    my $thr = MyThread->get($id);
    if ($thr->isReady) {
    $thr->Start;
    print STDERR "Thread : $id : Started\n";
    } else {
    print STDERR "Thread : $id : Already running\n";
    }
}

# Called from a Button object
sub detach {
    my $caller = shift;
    print STDERR "Cleaning up\n";
    MyThread->cleanup_d();
    print STDERR "Done cleaning up\n";
}
# Called from a Button object
sub join {
    my $caller = shift;
    print STDERR "Cleaning up\n";
    MyThread->cleanup_j();
    print STDERR "Done cleaning up\n";
}

## Main

my $a = Qt::Application(\@ARGV);
my $f = Qt::Frame();
$f->resize(200,200);

my $l = Qt::HBoxLayout($f);
$l->setAutoAdd(1);

Button("1", $f, undef, \&startT);
Button("2", $f, undef, \&startT);
Button("Detach", $f, undef, \&detach);
Button("Join", $f, undef, \&join);

$a->setMainWidget($f);
$f->show;
exit $a->exec;


################################################

David


More information about the Kde-perl mailing list