[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