This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Simon's new perlapi scheme, I hope I got all the pieces.
[perl5.git] / ext / threads / shared / shared.pm
CommitLineData
b050c948
AB
1package threads::shared;
2
3use strict;
4use warnings;
5use Config;
6use Scalar::Util qw(weaken);
7use attributes qw(reftype);
8
9BEGIN {
9ece3ee6 10 if($Config{'useithreads'} && $threads::threads) {
b050c948 11 *share = \&share_enabled;
6f942b98
AB
12 *cond_wait = \&cond_wait_enabled;
13 *cond_signal = \&cond_signal_enabled;
14 *cond_broadcast = \&cond_broadcast_enabled;
15 *unlock = \&unlock_enabled;
a6b94e59
AB
16 } else {
17 *share = \&share_disabled;
18 *cond_wait = \&cond_wait_disabled;
19 *cond_signal = \&cond_signal_disabled;
20 *cond_broadcast = \&cond_broadcast_dosabled;
21 *unlock = \&unlock_disabled;
b050c948
AB
22 }
23}
24
25require Exporter;
26require DynaLoader;
27our @ISA = qw(Exporter DynaLoader);
28
a6b94e59 29our @EXPORT = qw(share cond_wait cond_broadcast cond_signal unlock);
515f0976 30our $VERSION = '0.90';
b050c948
AB
31
32our %shared;
33
b050c948
AB
34sub cond_wait_disabled { return @_ };
35sub cond_signal_disabled { return @_};
36sub cond_broadcast_disabled { return @_};
37sub unlock_disabled { 1 };
38sub lock_disabled { 1 }
39sub share_disabled { return @_}
40
41sub share_enabled (\[$@%]) { # \]
42 my $value = $_[0];
43 my $ref = reftype($value);
44 if($ref eq 'SCALAR') {
aaf3876d
AB
45 my $obj = \threads::shared::sv->new($$value);
46 bless $obj, 'threads::shared::sv';
47 $shared{$$obj} = $value;
48 weaken($shared{$$obj});
49 } elsif($ref eq "ARRAY") {
50 tie @$value, 'threads::shared::av', $value;
8669ce85
AB
51 } elsif($ref eq "HASH") {
52 tie %$value, "threads::shared::hv", $value;
b050c948
AB
53 } else {
54 die "You cannot share ref of type $_[0]\n";
55 }
56}
57
58sub CLONE {
59 return unless($_[0] eq "threads::shared");
60 foreach my $ptr (keys %shared) {
61 if($ptr) {
cd8c9bf8 62 thrcnt_inc($shared{$ptr},$threads::origthread);
b050c948
AB
63 }
64 }
65}
66
aaf3876d
AB
67sub DESTROY {
68 my $self = shift;
866fba46 69 _thrcnt_dec($$self);
aaf3876d
AB
70 delete($shared{$$self});
71}
72
b050c948
AB
73package threads::shared::sv;
74use base 'threads::shared';
75
aaf3876d
AB
76sub DESTROY {}
77
b050c948
AB
78package threads::shared::av;
79use base 'threads::shared';
aaf3876d
AB
80use Scalar::Util qw(weaken);
81sub TIEARRAY {
82 my $class = shift;
83 my $value = shift;
84 my $self = bless \threads::shared::av->new($value),'threads::shared::av';
85 $shared{$self->ptr} = $value;
86 weaken($shared{$self->ptr});
87 return $self;
88}
b050c948
AB
89
90package threads::shared::hv;
91use base 'threads::shared';
8669ce85
AB
92use Scalar::Util qw(weaken);
93sub TIEHASH {
94 my $class = shift;
95 my $value = shift;
96 my $self = bless \threads::shared::hv->new($value),'threads::shared::hv';
97 $shared{$self->ptr} = $value;
98 weaken($shared{$self->ptr});
99 return $self;
100}
b050c948 101
8669ce85 102package threads::shared;
b050c948
AB
103bootstrap threads::shared $VERSION;
104
105__END__
106
107=head1 NAME
108
109threads::shared - Perl extension for sharing data structures between threads
110
111=head1 SYNOPSIS
112
113 use threads::shared;
114
115 my($foo, @foo, %foo);
aaf3876d
AB
116 share($foo);
117 share(@foo);
118 share(%hash);
b050c948
AB
119 my $bar = share([]);
120 $hash{bar} = share({});
121
515f0976
AB
122 lock(%hash);
123 unlock(%hash);
b050c948 124 cond_wait($scalar);
515f0976
AB
125 cond_broadcast(@array);
126 cond_signal(%hash);
b050c948
AB
127
128=head1 DESCRIPTION
129
ad91d581
JH
130This modules allows you to share() variables. These variables will
131then be shared across different threads (and pseudoforks on
132win32). They are used together with the threads module.
b050c948 133
515f0976 134=head1 EXPORT
b050c948 135
515f0976
AB
136C<share>, C<lock>, C<unlock>, C<cond_wait>, C<cond_signal>, C<cond_broadcast>
137
138=head1 FUNCTIONS
139
140=over 4
141
142=item share VARIABLE
143
d1be9408 144C<share> takes a value and marks it as shared, you can share a scalar, array, hash
515f0976
AB
145scalar ref, array ref and hash ref, C<share> will return the shared value.
146
147C<share> will traverse up references exactly I<one> level.
148C<share(\$a)> is equivalent to C<share($a)>, while C<share(\\$a)> is not.
149
150=item lock VARIABLE
151
152C<lock> places a lock on a variable until the lock goes out of scope. If
153the variable is locked by another thread, the C<lock> call will block until
154it's available. C<lock> is recursive, so multiple calls to C<lock> are
155safe--the variable will remain locked until the outermost lock on the
156variable goes out of scope or C<unlock> is called enough times to match
157the number of calls to <lock>.
158
159If a container object, such as a hash or array, is locked, all the elements
160of that container are not locked. For example, if a thread does a C<lock
161@a>, any other thread doing a C<lock($a[12])> won't block.
162
163C<lock> will traverse up references exactly I<one> level.
164C<lock(\$a)> is equivalent to C<lock($a)>, while C<lock(\\$a)> is not.
165
166
167=item unlock VARIABLE
168
169C<unlock> takes a locked shared value and decrements the lock count.
170If the lock count is zero the variable is unlocked. It is not necessary
171to call C<unlock> but it can be usefull to reduce lock contention.
172
173C<unlock> will traverse up references exactly I<one> level.
174C<unlock(\$a)> is equivalent to C<unlock($a)>, while C<unlock(\\$a)> is not.
175
176=item cond_wait VARIABLE
177
178The C<cond_wait> function takes a B<locked> variable as a parameter,
179unlocks the variable, and blocks until another thread does a C<cond_signal>
180or C<cond_broadcast> for that same locked variable. The variable that
181C<cond_wait> blocked on is relocked after the C<cond_wait> is satisfied.
182If there are multiple threads C<cond_wait>ing on the same variable, all but
183one will reblock waiting to reaquire the lock on the variable. (So if
184you're only using C<cond_wait> for synchronization, give up the lock as
185soon as possible)
186
187It is important to note that the variable can be notified even if no
188thread C<cond_signal> or C<cond_broadcast> on the variable. It is therefore
189important to check the value of the variable and go back to waiting if the
190requirment is not fullfilled.
191
192=item cond_signal VARIABLE
193
194The C<cond_signal> function takes a B<locked> variable as a parameter and
195unblocks one thread that's C<cond_wait>ing on that variable. If more than
196one thread is blocked in a C<cond_wait> on that variable, only one (and
197which one is indeterminate) will be unblocked.
198
199If there are no threads blocked in a C<cond_wait> on the variable, the
200signal is discarded.
201
202=item cond_broadcast VARIABLE
203
204The C<cond_broadcast> function works similarly to C<cond_signal>.
205C<cond_broadcast>, though, will unblock B<all> the threads that are blocked
206in a C<cond_wait> on the locked variable, rather than only one.
b050c948
AB
207
208=head1 BUGS
209
515f0976
AB
210C<bless> is not supported on shared references, in the current version
211C<bless> will only bless the thread local reference and the blessing
212will not propagate to the other threads, this is expected to be implmented
213in the future.
214
b050c948 215Does not support splice on arrays!
b050c948
AB
216
217=head1 AUTHOR
218
aaf3876d 219Arthur Bergman E<lt>arthur at contiller.seE<gt>
b050c948 220
aaf3876d 221threads::shared is released under the same license as Perl
b050c948 222
515f0976
AB
223Documentation borrowed from Thread.pm
224
b050c948
AB
225=head1 SEE ALSO
226
227L<perl> L<threads>
228
229=cut
515f0976
AB
230
231
232
233
234