package threads::shared;
+use 5.007_003;
use strict;
use warnings;
use Config;
-use Scalar::Util qw(weaken);
-use attributes qw(reftype);
BEGIN {
- if($Config{'useithreads'} && $threads::threads) {
- *share = \&share_enabled;
+ unless ($Config{useithreads}) {
+ my @caller = caller(2);
+ die <<EOF;
+$caller[1] line $caller[2]:
+
+This Perl hasn't been configured and built properly for the threads
+module to work. (The 'useithreads' configuration option hasn't been used.)
+
+Having threads support requires all of Perl and all of the modules in
+the Perl installation to be rebuilt, it is not just a question of adding
+the threads module. (In other words, threaded and non-threaded Perls
+are binary incompatible.)
+
+If you want to the use the threads module, please contact the people
+who built your Perl.
+
+Cannot continue, aborting.
+EOF
+ }
+}
+
+require Exporter;
+our @ISA = qw(Exporter);
+our @EXPORT = qw(share cond_wait cond_broadcast cond_signal _refcnt _id _thrcnt);
+our $VERSION = '0.90';
+
+use Attribute::Handlers;
+
+
+if ($Config{'useithreads'}) {
*cond_wait = \&cond_wait_enabled;
*cond_signal = \&cond_signal_enabled;
*cond_broadcast = \&cond_broadcast_enabled;
- *unlock = \&unlock_enabled;
- } else {
+ require XSLoader;
+ XSLoader::load('threads::shared',$VERSION);
+}
+else {
*share = \&share_disabled;
*cond_wait = \&cond_wait_disabled;
*cond_signal = \&cond_signal_disabled;
- *cond_broadcast = \&cond_broadcast_dosabled;
- *unlock = \&unlock_disabled;
- }
+ *cond_broadcast = \&cond_broadcast_disabled;
}
-require Exporter;
-require DynaLoader;
-our @ISA = qw(Exporter DynaLoader);
-
-our @EXPORT = qw(share cond_wait cond_broadcast cond_signal unlock);
-our $VERSION = '0.90';
-
-our %shared;
sub cond_wait_disabled { return @_ };
sub cond_signal_disabled { return @_};
sub cond_broadcast_disabled { return @_};
-sub unlock_disabled { 1 };
-sub lock_disabled { 1 }
sub share_disabled { return @_}
-sub share_enabled (\[$@%]) { # \]
- 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});
- } 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 CLONE {
- return unless($_[0] eq "threads::shared");
- foreach my $ptr (keys %shared) {
- if($ptr) {
- thrcnt_inc($shared{$ptr},$threads::origthread);
- }
- }
-}
+$threads::shared::threads_shared = 1;
-sub DESTROY {
- my $self = shift;
- _thrcnt_dec($$self);
- delete($shared{$$self});
-}
+sub _thrcnt { 42 }
-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;
+sub threads::shared::tie::SPLICE
+{
+ die "Splice not implemented for shared arrays";
}
-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;
+sub UNIVERSAL::shared : ATTR {
+ my ($package, $symbol, $referent, $attr, $data, $phase) = @_;
+ share($referent);
}
-package threads::shared;
-bootstrap threads::shared $VERSION;
-
__END__
=head1 NAME
=head1 SYNOPSIS
+ use threads;
use threads::shared;
- my($foo, @foo, %foo);
- share($foo);
- share(@foo);
+ my($scalar, @array, %hash);
+ share($scalar);
+ share(@array);
share(%hash);
my $bar = share([]);
$hash{bar} = share({});
=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> takes a value and marks it as shared. You can share a scalar, array,
+hash, scalar ref, array ref or 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.
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
+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
=item unlock VARIABLE
-C<unlock> takes a locked shared value and decrements the lock count.
+C<unlock> takes a B<locked> variable 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.
+to call C<unlock> but it can be useful 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.
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
+one will reblock waiting to reacquire 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.
+requirement is not fulfilled.
=item cond_signal VARIABLE
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.
+=back
+
+=head1 NOTES
+
+threads::shared is designed to disable itself silently if threads are
+not available. If you want access to threads, you must C<use threads>
+before you C<use threads::shared>. threads will emit a warning if you
+use it after threads::shared.
+
=head1 BUGS
-C<bless> is not supported on shared references, in the current version
+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.
+will not propagate to the other threads. This is expected to be
+implemented in a future version of Perl.
Does not support splice on arrays!