Subject: | Overloading won't work on somplex structures |
Overloading operators won't work on shared structures that are more then
1 level deep.
Example/TestCase Attached.
Subject: | Set.pm |
package Set;
use strict;
# MultiThreading Support
use threads;
use threads::shared;
use overload (
q/@{}/ => sub { $_[0]->getArray() }, # Overload @{}
'fallback' => 1);
sub new {
my $class = shift;
my $self = {
# The items themselves.
items => [],
};
$self = bless $self, $class;
foreach my $item (@_) {
$self->add($item);
}
return $self;
}
sub add {
my ($self, $item) = @_;
# MultiThreading Support
lock ($self) if (is_shared($self));
lock ($item) if (is_shared($item));
$item = shared_clone($item) if ((is_shared($self)) && (!is_shared($item)));
push @{$self->{items}}, $item;
}
sub clear {
my ($self) = @_;
# MultiThreading Support
if (is_shared($self)) {
lock ($self);
$self->{items} = &share([]);
} else {
$self->{items} = [];
};
}
sub get {
my ($self, $index) = @_;
# MultiThreading Support
lock ($self) if (is_shared($self));
return $self->{items}[$index];
}
sub size {
my ($self) = @_;
# MultiThreading Support
lock ($self) if (is_shared($self));
return scalar(@{$self->{items}});
}
sub getArray {
my ($self) = @_;
# MultiThreading Support
lock ($self) if (is_shared($self));
return $self->{items};
}
1;
Subject: | test.pl |
#!/usr/bin/env perl
package main;
use strict;
use threads;
use threads::shared;
use Set;
sub new {
my ($class) = @_;
my %self = (
something => new Set()
);
return bless \%self, $class;
}
######################################
# Test 1
print "\nTesting sample 1 (simple)\n";
my $test1 = new Set();
$test1->add("hello1");
$test1->add("hello2");
$test1->add("hello3");
$test1 = shared_clone($test1);
# Dump($test1);
foreach my $item (@{$test1}) {
print $item . "\n";
};
print "Looks good!\n";
# Test 1 End.
######################################
######################################
# Test 2
print "\nTesting sample 2 (nested structure)\n";
my $test2 = new main();
$test2->{something}->add("hello1");
$test2->{something}->add("hello2");
$test2->{something}->add("hello3");
$test2 = shared_clone($test2);
my $something = $test2->{something};
foreach my $item (@{$something}) {
print $item . "\n";
};
# Test 2 End.
######################################