Interpreter Threads: Passing nested objects to a thread

[Samuel]

Hi,

When trying to do pass an object tree to a thread, the problem is that
threads::share() does not support nested objects. Is there a
workaround to still make the object available? Test case appended
below.

What this code does:
-----------------
$ perl test2.pl
The above works.
Waiting.
Result: Invalid value for shared scalar at test2.pl line 28.

Waiting.
Done.
-----------------
(I marked line 28 in the code below.)

-Samuel



------------------------
#!/usr/bin/perl
use strict;

my $obj = new TestClass(new TestClass());
$obj->exec();
print "The above works.\n";

my $worker = new Worker();
$worker->add($obj);
$worker->run();

while ($worker->is_running()) { print "Waiting.\n"; sleep 1; }
print "Done.\n";

package TestClass;
sub new {
my($class, $child) = @_;
$class = ref($class) || $class;
my $self = {};
bless $self, $class;
$self->{list} = qw//;
push(@{$self->{list}}, $child) if $child;
return $self;
}

sub exec {
my($self) = @_;
for (@{$self->{list}}) { $_->exec() } # This is line 28.
}


package Worker;
use threads;
use threads::shared;

sub new {
my($class, %args) = @_;
$class = ref($class) || $class;
my $self = {};
bless $self, $class;
$self->{threads} = &share([]);
$self->{queue} = &share([]);
return $self;
}

sub add {
my ($self, $command) = @_;
push(@{$self->{queue}}, &share($command));
}

sub run {
my ($self) = @_;
my $main_loop = threads->create(sub{$self->_main_loop()});
push(@{$self->{threads}}, &share($main_loop));
}

sub _main_loop {
my($self) = @_;

# Walk through all actions and start them in separate threads.
while (my $command = shift @{$self->{queue}}) {
eval q{$command->exec()};
print "Result: $@\n";
sleep 2;
}

shift @{$self->{threads}};
return 1;
}

sub is_running {
my($self) = @_;
return 1 if @{$self->{threads}} > 0;
return 0;
}

 

[Samuel]

When trying to do pass an object tree to a thread, the problem is that
threads::share() does not support nested objects. Is there a
workaround to still make the object available?

Answering my own question, I found a workaround that involves
modifying every object in the tree as follows:

package TestClass;
use threads;
use threads::shared;

sub new {
my($class, $child) = @_;
$class = ref($class) || $class;
my $self = {};
&share($self);
bless $self, $class;
$self->{list} = &share([]);
push(@{$self->{list}}, &share($child)) if $child;
return $self;
}

It's a hack, but it can work in some cases. If there is a solution
that works without modifying objects I would like to know.

-Samuel