This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Miss mg_len == 0 meaning don't Safefree
[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 {
21312124 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;
dab065ea 20 *cond_broadcast = \&cond_broadcast_disabled;
a6b94e59 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
21312124 41sub share_enabled (\[$@%]) { # \]
b050c948
AB
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
aaf3876d 58
b050c948
AB
59package threads::shared::sv;
60use base 'threads::shared';
61
aaf3876d
AB
62sub DESTROY {}
63
b050c948
AB
64package threads::shared::av;
65use base 'threads::shared';
aaf3876d
AB
66use Scalar::Util qw(weaken);
67sub TIEARRAY {
68 my $class = shift;
69 my $value = shift;
70 my $self = bless \threads::shared::av->new($value),'threads::shared::av';
71 $shared{$self->ptr} = $value;
72 weaken($shared{$self->ptr});
73 return $self;
74}
b050c948
AB
75
76package threads::shared::hv;
77use base 'threads::shared';
8669ce85
AB
78use Scalar::Util qw(weaken);
79sub TIEHASH {
80 my $class = shift;
81 my $value = shift;
82 my $self = bless \threads::shared::hv->new($value),'threads::shared::hv';
83 $shared{$self->ptr} = $value;
84 weaken($shared{$self->ptr});
85 return $self;
86}
b050c948 87
8669ce85 88package threads::shared;
dab065ea
AB
89
90$threads::shared::threads_shared = 1;
91
b050c948
AB
92bootstrap threads::shared $VERSION;
93
94__END__
95
96=head1 NAME
97
98threads::shared - Perl extension for sharing data structures between threads
99
100=head1 SYNOPSIS
101
102 use threads::shared;
103
104 my($foo, @foo, %foo);
aaf3876d
AB
105 share($foo);
106 share(@foo);
107 share(%hash);
b050c948
AB
108 my $bar = share([]);
109 $hash{bar} = share({});
110
515f0976
AB
111 lock(%hash);
112 unlock(%hash);
b050c948 113 cond_wait($scalar);
515f0976
AB
114 cond_broadcast(@array);
115 cond_signal(%hash);
b050c948
AB
116
117=head1 DESCRIPTION
118
ad91d581
JH
119This modules allows you to share() variables. These variables will
120then be shared across different threads (and pseudoforks on
121win32). They are used together with the threads module.
b050c948 122
515f0976 123=head1 EXPORT
b050c948 124
515f0976
AB
125C<share>, C<lock>, C<unlock>, C<cond_wait>, C<cond_signal>, C<cond_broadcast>
126
127=head1 FUNCTIONS
128
129=over 4
130
131=item share VARIABLE
132
d1be9408 133C<share> takes a value and marks it as shared, you can share a scalar, array, hash
515f0976
AB
134scalar ref, array ref and hash ref, C<share> will return the shared value.
135
136C<share> will traverse up references exactly I<one> level.
137C<share(\$a)> is equivalent to C<share($a)>, while C<share(\\$a)> is not.
138
139=item lock VARIABLE
140
141C<lock> places a lock on a variable until the lock goes out of scope. If
142the variable is locked by another thread, the C<lock> call will block until
143it's available. C<lock> is recursive, so multiple calls to C<lock> are
144safe--the variable will remain locked until the outermost lock on the
21312124 145variable goes out of scope or C<unlock> is called enough times to match
515f0976
AB
146the number of calls to <lock>.
147
148If a container object, such as a hash or array, is locked, all the elements
149of that container are not locked. For example, if a thread does a C<lock
150@a>, any other thread doing a C<lock($a[12])> won't block.
151
152C<lock> will traverse up references exactly I<one> level.
153C<lock(\$a)> is equivalent to C<lock($a)>, while C<lock(\\$a)> is not.
154
155
156=item unlock VARIABLE
157
158C<unlock> takes a locked shared value and decrements the lock count.
159If the lock count is zero the variable is unlocked. It is not necessary
160to call C<unlock> but it can be usefull to reduce lock contention.
161
162C<unlock> will traverse up references exactly I<one> level.
163C<unlock(\$a)> is equivalent to C<unlock($a)>, while C<unlock(\\$a)> is not.
164
165=item cond_wait VARIABLE
166
167The C<cond_wait> function takes a B<locked> variable as a parameter,
168unlocks the variable, and blocks until another thread does a C<cond_signal>
169or C<cond_broadcast> for that same locked variable. The variable that
170C<cond_wait> blocked on is relocked after the C<cond_wait> is satisfied.
171If there are multiple threads C<cond_wait>ing on the same variable, all but
172one will reblock waiting to reaquire the lock on the variable. (So if
173you're only using C<cond_wait> for synchronization, give up the lock as
174soon as possible)
175
176It is important to note that the variable can be notified even if no
177thread C<cond_signal> or C<cond_broadcast> on the variable. It is therefore
178important to check the value of the variable and go back to waiting if the
179requirment is not fullfilled.
180
181=item cond_signal VARIABLE
182
183The C<cond_signal> function takes a B<locked> variable as a parameter and
184unblocks one thread that's C<cond_wait>ing on that variable. If more than
185one thread is blocked in a C<cond_wait> on that variable, only one (and
186which one is indeterminate) will be unblocked.
187
188If there are no threads blocked in a C<cond_wait> on the variable, the
189signal is discarded.
190
191=item cond_broadcast VARIABLE
192
193The C<cond_broadcast> function works similarly to C<cond_signal>.
194C<cond_broadcast>, though, will unblock B<all> the threads that are blocked
195in a C<cond_wait> on the locked variable, rather than only one.
b050c948 196
dab065ea
AB
197
198=head1 NOTES
199
8c5dce87 200threads::shared is designed to disable itself silently if threads are
dab065ea
AB
201not available. If you want access to threads, you must C<use threads>
202before you C<use threads::shared>. threads will emit a warning if you
8c5dce87 203use it after threads::shared.
dab065ea 204
b050c948
AB
205=head1 BUGS
206
515f0976
AB
207C<bless> is not supported on shared references, in the current version
208C<bless> will only bless the thread local reference and the blessing
209will not propagate to the other threads, this is expected to be implmented
210in the future.
211
b050c948 212Does not support splice on arrays!
b050c948
AB
213
214=head1 AUTHOR
215
aaf3876d 216Arthur Bergman E<lt>arthur at contiller.seE<gt>
b050c948 217
aaf3876d 218threads::shared is released under the same license as Perl
b050c948 219
515f0976
AB
220Documentation borrowed from Thread.pm
221
b050c948
AB
222=head1 SEE ALSO
223
224L<perl> L<threads>
225
226=cut
515f0976
AB
227
228
229
230
231