use attributes qw(reftype);
BEGIN {
- if($Config{'useithreads'} && $Config::threads) {
+ if($Config{'useithreads'} && $threads::threads) {
*share = \&share_enabled;
+ *cond_wait = \&cond_wait_enabled;
+ *cond_signal = \&cond_signal_enabled;
+ *cond_broadcast = \&cond_broadcast_enabled;
+ *unlock = \&unlock_enabled;
+ } else {
+ *share = \&share_disabled;
*cond_wait = \&cond_wait_disabled;
*cond_signal = \&cond_signal_disabled;
- *cond_broadcast = \&cond_broadcast_disabled;
+ *cond_broadcast = \&cond_broadcast_dosabled;
*unlock = \&unlock_disabled;
- *lock = \&lock_disabled;
- } else {
- *share = \&share_enabled;
}
}
require DynaLoader;
our @ISA = qw(Exporter DynaLoader);
-our @EXPORT = qw(share cond_wait cond_broadcast cond_signal unlock lock);
-our $VERSION = '0.01';
+our @EXPORT = qw(share cond_wait cond_broadcast cond_signal unlock);
+our $VERSION = '0.90';
our %shared;
my $value = $_[0];
my $ref = reftype($value);
if($ref eq 'SCALAR') {
- my $obj = \threads::shared::sv->new($$value);
- bless $obj, 'threads::shared::sv';
- $shared{$$obj} = $value;
- weaken($shared{$$obj});
+ my $obj = \threads::shared::sv->new($$value);
+ bless $obj, 'threads::shared::sv';
+ $shared{$$obj} = $value;
+ weaken($shared{$$obj});
+ } elsif($ref eq "ARRAY") {
+ tie @$value, 'threads::shared::av', $value;
+ } elsif($ref eq "HASH") {
+ tie %$value, "threads::shared::hv", $value;
} else {
die "You cannot share ref of type $_[0]\n";
}
}
}
+sub DESTROY {
+ my $self = shift;
+ _thrcnt_dec($$self);
+ delete($shared{$$self});
+}
+
package threads::shared::sv;
use base 'threads::shared';
+sub DESTROY {}
+
package threads::shared::av;
use base 'threads::shared';
+use Scalar::Util qw(weaken);
+sub TIEARRAY {
+ my $class = shift;
+ my $value = shift;
+ my $self = bless \threads::shared::av->new($value),'threads::shared::av';
+ $shared{$self->ptr} = $value;
+ weaken($shared{$self->ptr});
+ return $self;
+}
package threads::shared::hv;
use base 'threads::shared';
+use Scalar::Util qw(weaken);
+sub TIEHASH {
+ my $class = shift;
+ my $value = shift;
+ my $self = bless \threads::shared::hv->new($value),'threads::shared::hv';
+ $shared{$self->ptr} = $value;
+ weaken($shared{$self->ptr});
+ return $self;
+}
+package threads::shared;
bootstrap threads::shared $VERSION;
__END__
use threads::shared;
my($foo, @foo, %foo);
- share(\$foo);
- share(\@foo);
- share(\%hash);
+ share($foo);
+ share(@foo);
+ share(%hash);
my $bar = share([]);
$hash{bar} = share({});
- lock(\%hash);
- unlock(\%hash);
+ lock(%hash);
+ unlock(%hash);
cond_wait($scalar);
- cond_broadcast(\@array);
- cond_signal($scalar);
+ cond_broadcast(@array);
+ cond_signal(%hash);
=head1 DESCRIPTION
then be shared across different threads (and pseudoforks on
win32). They are used together with the threads module.
-=head2 EXPORT
+=head1 EXPORT
+
+C<share>, C<lock>, C<unlock>, C<cond_wait>, C<cond_signal>, C<cond_broadcast>
+
+=head1 FUNCTIONS
+
+=over 4
+
+=item share VARIABLE
+
+C<share> takes a value and marks it as shared, you can share an scalar, array, hash
+scalar ref, array ref and hash ref, C<share> will return the shared value.
+
+C<share> will traverse up references exactly I<one> level.
+C<share(\$a)> is equivalent to C<share($a)>, while C<share(\\$a)> is not.
+
+=item lock VARIABLE
+
+C<lock> places a lock on a variable until the lock goes out of scope. If
+the variable is locked by another thread, the C<lock> call will block until
+it's available. C<lock> is recursive, so multiple calls to C<lock> are
+safe--the variable will remain locked until the outermost lock on the
+variable goes out of scope or C<unlock> is called enough times to match
+the number of calls to <lock>.
+
+If a container object, such as a hash or array, is locked, all the elements
+of that container are not locked. For example, if a thread does a C<lock
+@a>, any other thread doing a C<lock($a[12])> won't block.
-share(), lock(), unlock(), cond_wait, cond_signal, cond_broadcast
+C<lock> will traverse up references exactly I<one> level.
+C<lock(\$a)> is equivalent to C<lock($a)>, while C<lock(\\$a)> is not.
+
+
+=item unlock VARIABLE
+
+C<unlock> takes a locked shared value and decrements the lock count.
+If the lock count is zero the variable is unlocked. It is not necessary
+to call C<unlock> but it can be usefull to reduce lock contention.
+
+C<unlock> will traverse up references exactly I<one> level.
+C<unlock(\$a)> is equivalent to C<unlock($a)>, while C<unlock(\\$a)> is not.
+
+=item cond_wait VARIABLE
+
+The C<cond_wait> function takes a B<locked> variable as a parameter,
+unlocks the variable, and blocks until another thread does a C<cond_signal>
+or C<cond_broadcast> for that same locked variable. The variable that
+C<cond_wait> blocked on is relocked after the C<cond_wait> is satisfied.
+If there are multiple threads C<cond_wait>ing on the same variable, all but
+one will reblock waiting to reaquire the lock on the variable. (So if
+you're only using C<cond_wait> for synchronization, give up the lock as
+soon as possible)
+
+It is important to note that the variable can be notified even if no
+thread C<cond_signal> or C<cond_broadcast> on the variable. It is therefore
+important to check the value of the variable and go back to waiting if the
+requirment is not fullfilled.
+
+=item cond_signal VARIABLE
+
+The C<cond_signal> function takes a B<locked> variable as a parameter and
+unblocks one thread that's C<cond_wait>ing on that variable. If more than
+one thread is blocked in a C<cond_wait> on that variable, only one (and
+which one is indeterminate) will be unblocked.
+
+If there are no threads blocked in a C<cond_wait> on the variable, the
+signal is discarded.
+
+=item cond_broadcast VARIABLE
+
+The C<cond_broadcast> function works similarly to C<cond_signal>.
+C<cond_broadcast>, though, will unblock B<all> the threads that are blocked
+in a C<cond_wait> on the locked variable, rather than only one.
=head1 BUGS
-Not stress tested!
-Does not support references
+C<bless> is not supported on shared references, in the current version
+C<bless> will only bless the thread local reference and the blessing
+will not propagate to the other threads, this is expected to be implmented
+in the future.
+
Does not support splice on arrays!
-The exported functions need a reference due to unsufficent prototyping!
=head1 AUTHOR
-Artur Bergman E<lt>artur at contiller.seE<gt>
+Arthur Bergman E<lt>arthur at contiller.seE<gt>
-threads is released under the same license as Perl
+threads::shared is released under the same license as Perl
+
+Documentation borrowed from Thread.pm
=head1 SEE ALSO
L<perl> L<threads>
=cut
+
+
+
+
+