This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Reorganize dist/threads-shared
[perl5.git] / dist / threads-shared / lib / threads / shared.pm
CommitLineData
b050c948 1package threads::shared;
73e09c8f 2
c46325ea 3use 5.008;
7473853a 4
b050c948
AB
5use strict;
6use warnings;
73e09c8f 7
373098c0
JH
8use Scalar::Util qw(reftype refaddr blessed);
9
c5bf8991 10our $VERSION = '1.33_02';
7473853a
SP
11my $XS_VERSION = $VERSION;
12$VERSION = eval $VERSION;
13
14# Declare that we have been loaded
15$threads::shared::threads_shared = 1;
16
17# Load the XS code, if applicable
18if ($threads::threads) {
19 require XSLoader;
20 XSLoader::load('threads::shared', $XS_VERSION);
21
22 *is_shared = \&_id;
23
24} else {
25 # String eval is generally evil, but we don't want these subs to
26 # exist at all if 'threads' is not loaded successfully.
27 # Vivifying them conditionally this way saves on average about 4K
28 # of memory per thread.
29 eval <<'_MARKER_';
30 sub share (\[$@%]) { return $_[0] }
31 sub is_shared (\[$@%]) { undef }
32 sub cond_wait (\[$@%];\[$@%]) { undef }
33 sub cond_timedwait (\[$@%]$;\[$@%]) { undef }
34 sub cond_signal (\[$@%]) { undef }
35 sub cond_broadcast (\[$@%]) { undef }
36_MARKER_
37}
38
39
40### Export ###
41
42sub import
43{
44 # Exported subroutines
45 my @EXPORT = qw(share is_shared cond_wait cond_timedwait
373098c0 46 cond_signal cond_broadcast shared_clone);
5c360ac5 47 if ($threads::threads) {
7473853a 48 push(@EXPORT, 'bless');
5c360ac5 49 }
7473853a
SP
50
51 # Export subroutine names
52 my $caller = caller();
53 foreach my $sym (@EXPORT) {
54 no strict 'refs';
55 *{$caller.'::'.$sym} = \&{$sym};
df5c998e
EM
56 }
57}
b050c948 58
7473853a 59
373098c0
JH
60# Predeclarations for internal functions
61my ($make_shared);
62
63
7473853a 64### Methods, etc. ###
dab065ea 65
6b85e4fe
NIS
66sub threads::shared::tie::SPLICE
67{
7473853a
SP
68 require Carp;
69 Carp::croak('Splice not implemented for shared arrays');
6b85e4fe
NIS
70}
71
373098c0
JH
72
73# Create a thread-shared clone of a complex data structure or object
74sub shared_clone
75{
76 if (@_ != 1) {
77 require Carp;
78 Carp::croak('Usage: shared_clone(REF)');
79 }
80
81 return $make_shared->(shift, {});
82}
83
84
85### Internal Functions ###
86
87# Used by shared_clone() to recursively clone
88# a complex data structure or object
89$make_shared = sub {
90 my ($item, $cloned) = @_;
91
92 # Just return the item if:
93 # 1. Not a ref;
94 # 2. Already shared; or
95 # 3. Not running 'threads'.
96 return $item if (! ref($item) || is_shared($item) || ! $threads::threads);
97
98 # Check for previously cloned references
99 # (this takes care of circular refs as well)
100 my $addr = refaddr($item);
101 if (exists($cloned->{$addr})) {
102 # Return the already existing clone
103 return $cloned->{$addr};
104 }
105
106 # Make copies of array, hash and scalar refs and refs of refs
107 my $copy;
108 my $ref_type = reftype($item);
109
110 # Copy an array ref
111 if ($ref_type eq 'ARRAY') {
112 # Make empty shared array ref
113 $copy = &share([]);
114 # Add to clone checking hash
115 $cloned->{$addr} = $copy;
116 # Recursively copy and add contents
117 push(@$copy, map { $make_shared->($_, $cloned) } @$item);
118 }
119
120 # Copy a hash ref
121 elsif ($ref_type eq 'HASH') {
122 # Make empty shared hash ref
123 $copy = &share({});
124 # Add to clone checking hash
125 $cloned->{$addr} = $copy;
126 # Recursively copy and add contents
127 foreach my $key (keys(%{$item})) {
128 $copy->{$key} = $make_shared->($item->{$key}, $cloned);
129 }
130 }
131
132 # Copy a scalar ref
133 elsif ($ref_type eq 'SCALAR') {
134 $copy = \do{ my $scalar = $$item; };
135 share($copy);
373098c0
JH
136 # Add to clone checking hash
137 $cloned->{$addr} = $copy;
138 }
139
140 # Copy of a ref of a ref
141 elsif ($ref_type eq 'REF') {
142 # Special handling for $x = \$x
143 if ($addr == refaddr($$item)) {
144 $copy = \$copy;
145 share($copy);
146 $cloned->{$addr} = $copy;
147 } else {
148 my $tmp;
149 $copy = \$tmp;
150 share($copy);
151 # Add to clone checking hash
152 $cloned->{$addr} = $copy;
153 # Recursively copy and add contents
154 $tmp = $make_shared->($$item, $cloned);
155 }
156
157 } else {
158 require Carp;
159 Carp::croak("Unsupported ref type: ", $ref_type);
160 }
161
162 # If input item is an object, then bless the copy into the same class
163 if (my $class = blessed($item)) {
164 bless($copy, $class);
165 }
166
167 # Clone READONLY flag
a469502f
RGS
168 if ($ref_type eq 'SCALAR') {
169 if (Internals::SvREADONLY($$item)) {
170 Internals::SvREADONLY($$copy, 1) if ($] >= 5.008003);
171 }
172 }
373098c0 173 if (Internals::SvREADONLY($item)) {
a469502f 174 Internals::SvREADONLY($copy, 1) if ($] >= 5.008003);
373098c0
JH
175 }
176
177 return $copy;
178};
179
7473853a
SP
1801;
181
b050c948
AB
182__END__
183
184=head1 NAME
185
186threads::shared - Perl extension for sharing data structures between threads
187
7473853a
SP
188=head1 VERSION
189
1a3f0f1d 190This document describes threads::shared version 1.33
7473853a 191
b050c948
AB
192=head1 SYNOPSIS
193
73e09c8f 194 use threads;
b050c948
AB
195 use threads::shared;
196
7473853a 197 my $var :shared;
373098c0
JH
198 my %hsh :shared;
199 my @ary :shared;
38875929 200
3b29be8d 201 my ($scalar, @array, %hash);
4cab98c0
SG
202 share($scalar);
203 share(@array);
aaf3876d 204 share(%hash);
373098c0
JH
205
206 $var = $scalar_value;
207 $var = $shared_ref_value;
208 $var = shared_clone($non_shared_ref_value);
209 $var = shared_clone({'foo' => [qw/foo bar baz/]});
210
211 $hsh{'foo'} = $scalar_value;
212 $hsh{'bar'} = $shared_ref_value;
213 $hsh{'baz'} = shared_clone($non_shared_ref_value);
214 $hsh{'quz'} = shared_clone([1..3]);
215
216 $ary[0] = $scalar_value;
217 $ary[1] = $shared_ref_value;
218 $ary[2] = shared_clone($non_shared_ref_value);
219 $ary[3] = shared_clone([ {}, [] ]);
b050c948 220
38875929
DM
221 { lock(%hash); ... }
222
b050c948 223 cond_wait($scalar);
a0e036c1 224 cond_timedwait($scalar, time() + 30);
515f0976
AB
225 cond_broadcast(@array);
226 cond_signal(%hash);
b050c948 227
7473853a 228 my $lockvar :shared;
a0e036c1
MP
229 # condition var != lock var
230 cond_wait($var, $lockvar);
231 cond_timedwait($var, time()+30, $lockvar);
232
b050c948
AB
233=head1 DESCRIPTION
234
38875929 235By default, variables are private to each thread, and each newly created
7473853a 236thread gets a private copy of each existing variable. This module allows you
373098c0
JH
237to share variables across different threads (and pseudo-forks on Win32). It
238is used together with the L<threads> module.
239
240This module supports the sharing of the following data types only: scalars
241and scalar refs, arrays and array refs, and hashes and hash refs.
b050c948 242
515f0976 243=head1 EXPORT
b050c948 244
373098c0
JH
245The following functions are exported by this module: C<share>,
246C<shared_clone>, C<is_shared>, C<cond_wait>, C<cond_timedwait>, C<cond_signal>
247and C<cond_broadcast>
515f0976 248
7473853a
SP
249Note that if this module is imported when L<threads> has not yet been loaded,
250then these functions all become no-ops. This makes it possible to write
251modules that will work in both threaded and non-threaded environments.
e67b86b3 252
515f0976
AB
253=head1 FUNCTIONS
254
255=over 4
256
257=item share VARIABLE
258
373098c0
JH
259C<share> takes a variable and marks it as shared:
260
261 my ($scalar, @array, %hash);
262 share($scalar);
263 share(@array);
264 share(%hash);
265
266C<share> will return the shared rvalue, but always as a reference.
515f0976 267
373098c0
JH
268Variables can also be marked as shared at compile time by using the
269C<:shared> attribute:
38875929 270
373098c0 271 my ($var, %hash, @array) :shared;
caf25f3b 272
373098c0
JH
273Shared variables can only store scalars, refs of shared variables, or
274refs of shared data (discussed in next section):
7473853a 275
373098c0
JH
276 my ($var, %hash, @array) :shared;
277 my $bork;
278
279 # Storing scalars
280 $var = 1;
281 $hash{'foo'} = 'bar';
282 $array[0] = 1.5;
283
284 # Storing shared refs
285 $var = \%hash;
286 $hash{'ary'} = \@array;
287 $array[1] = \$var;
288
289 # The following are errors:
290 # $var = \$bork; # ref of non-shared variable
291 # $hash{'bork'} = []; # non-shared array ref
292 # push(@array, { 'x' => 1 }); # non-shared hash ref
7473853a 293
373098c0 294=item shared_clone REF
ca5ff8b2 295
373098c0 296C<shared_clone> takes a reference, and returns a shared version of its
2e58fc35 297argument, performing a deep copy on any non-shared elements. Any shared
373098c0
JH
298elements in the argument are used as is (i.e., they are not cloned).
299
300 my $cpy = shared_clone({'foo' => [qw/foo bar baz/]});
301
302Object status (i.e., the class an object is blessed into) is also cloned.
303
304 my $obj = {'foo' => [qw/foo bar baz/]};
305 bless($obj, 'Foo');
306 my $cpy = shared_clone($obj);
307 print(ref($cpy), "\n"); # Outputs 'Foo'
308
309For cloning empty array or hash refs, the following may also be used:
310
2e58fc35
JH
311 $var = &share([]); # Same as $var = shared_clone([]);
312 $var = &share({}); # Same as $var = shared_clone({});
ca5ff8b2 313
7473853a
SP
314=item is_shared VARIABLE
315
316C<is_shared> checks if the specified variable is shared or not. If shared,
317returns the variable's internal ID (similar to
318L<refaddr()|Scalar::Util/"refaddr EXPR">). Otherwise, returns C<undef>.
319
320 if (is_shared($var)) {
321 print("\$var is shared\n");
322 } else {
323 print("\$var is not shared\n");
324 }
ca5ff8b2 325
c6cab44f
JH
326When used on an element of an array or hash, C<is_shared> checks if the
327specified element belongs to a shared array or hash. (It does not check
328the contents of that element.)
329
330 my %hash :shared;
331 if (is_shared(%hash)) {
332 print("\%hash is shared\n");
333 }
334
335 $hash{'elem'} = 1;
336 if (is_shared($hash{'elem'})) {
337 print("\$hash{'elem'} is in a shared hash\n");
338 }
339
515f0976
AB
340=item lock VARIABLE
341
c6cab44f
JH
342C<lock> places a B<advisory> lock on a variable until the lock goes out of
343scope. If the variable is locked by another thread, the C<lock> call will
344block until it's available. Multiple calls to C<lock> by the same thread from
345within dynamically nested scopes are safe -- the variable will remain locked
346until the outermost lock on the variable goes out of scope.
7473853a 347
c6cab44f 348C<lock> follows references exactly I<one> level:
515f0976 349
c6cab44f
JH
350 my %hash :shared;
351 my $ref = \%hash;
352 lock($ref); # This is equivalent to lock(%hash)
515f0976 353
7473853a
SP
354Note that you cannot explicitly unlock a variable; you can only wait for the
355lock to go out of scope. This is most easily accomplished by locking the
356variable inside a block.
515f0976 357
7473853a
SP
358 my $var :shared;
359 {
360 lock($var);
361 # $var is locked from here to the end of the block
362 ...
363 }
364 # $var is now unlocked
365
c6cab44f
JH
366As locks are advisory, they do not prevent data access or modification by
367another thread that does not itself attempt to obtain a lock on the variable.
368
369You cannot lock the individual elements of a container variable:
370
371 my %hash :shared;
372 $hash{'foo'} = 'bar';
373 #lock($hash{'foo'}); # Error
374 lock(%hash); # Works
375
7473853a
SP
376If you need more fine-grained control over shared variable access, see
377L<Thread::Semaphore>.
515f0976
AB
378
379=item cond_wait VARIABLE
380
a0e036c1
MP
381=item cond_wait CONDVAR, LOCKVAR
382
7473853a
SP
383The C<cond_wait> function takes a B<locked> variable as a parameter, unlocks
384the variable, and blocks until another thread does a C<cond_signal> or
385C<cond_broadcast> for that same locked variable. The variable that
386C<cond_wait> blocked on is relocked after the C<cond_wait> is satisfied. If
387there are multiple threads C<cond_wait>ing on the same variable, all but one
7c8caac0 388will re-block waiting to reacquire the lock on the variable. (So if you're only
7473853a
SP
389using C<cond_wait> for synchronisation, give up the lock as soon as possible).
390The two actions of unlocking the variable and entering the blocked wait state
391are atomic, the two actions of exiting from the blocked wait state and
7c8caac0 392re-locking the variable are not.
7473853a
SP
393
394In its second form, C<cond_wait> takes a shared, B<unlocked> variable followed
395by a shared, B<locked> variable. The second variable is unlocked and thread
396execution suspended until another thread signals the first variable.
397
398It is important to note that the variable can be notified even if no thread
399C<cond_signal> or C<cond_broadcast> on the variable. It is therefore
400important to check the value of the variable and go back to waiting if the
401requirement is not fulfilled. For example, to pause until a shared counter
402drops to zero:
403
63790022 404 { lock($counter); cond_wait($counter) until $counter == 0; }
a0e036c1
MP
405
406=item cond_timedwait VARIABLE, ABS_TIMEOUT
407
408=item cond_timedwait CONDVAR, ABS_TIMEOUT, LOCKVAR
409
7473853a
SP
410In its two-argument form, C<cond_timedwait> takes a B<locked> variable and an
411absolute timeout as parameters, unlocks the variable, and blocks until the
412timeout is reached or another thread signals the variable. A false value is
413returned if the timeout is reached, and a true value otherwise. In either
414case, the variable is re-locked upon return.
a0e036c1 415
7473853a
SP
416Like C<cond_wait>, this function may take a shared, B<locked> variable as an
417additional parameter; in this case the first parameter is an B<unlocked>
418condition variable protected by a distinct lock variable.
a0e036c1 419
7473853a
SP
420Again like C<cond_wait>, waking up and reacquiring the lock are not atomic,
421and you should always check your desired condition after this function
422returns. Since the timeout is an absolute value, however, it does not have to
423be recalculated with each pass:
a0e036c1 424
7473853a
SP
425 lock($var);
426 my $abs = time() + 15;
427 until ($ok = desired_condition($var)) {
a0e036c1 428 last if !cond_timedwait($var, $abs);
7473853a
SP
429 }
430 # we got it if $ok, otherwise we timed out!
515f0976
AB
431
432=item cond_signal VARIABLE
433
7473853a
SP
434The C<cond_signal> function takes a B<locked> variable as a parameter and
435unblocks one thread that's C<cond_wait>ing on that variable. If more than one
436thread is blocked in a C<cond_wait> on that variable, only one (and which one
437is indeterminate) will be unblocked.
515f0976 438
7473853a
SP
439If there are no threads blocked in a C<cond_wait> on the variable, the signal
440is discarded. By always locking before signaling, you can (with care), avoid
441signaling before another thread has entered cond_wait().
38875929 442
7473853a
SP
443C<cond_signal> will normally generate a warning if you attempt to use it on an
444unlocked variable. On the rare occasions where doing this may be sensible, you
ba2940ce 445can suppress the warning with:
38875929 446
7473853a 447 { no warnings 'threads'; cond_signal($foo); }
515f0976
AB
448
449=item cond_broadcast VARIABLE
450
451The C<cond_broadcast> function works similarly to C<cond_signal>.
7473853a
SP
452C<cond_broadcast>, though, will unblock B<all> the threads that are blocked in
453a C<cond_wait> on the locked variable, rather than only one.
b050c948 454
4cab98c0 455=back
dab065ea 456
7473853a
SP
457=head1 OBJECTS
458
459L<threads::shared> exports a version of L<bless()|perlfunc/"bless REF"> that
2b936299 460works on shared objects such that I<blessings> propagate across threads.
7473853a 461
373098c0
JH
462 # Create a shared 'Foo' object
463 my $foo :shared = shared_clone({});
464 bless($foo, 'Foo');
7473853a 465
373098c0
JH
466 # Create a shared 'Bar' object
467 my $bar :shared = shared_clone({});
468 bless($bar, 'Bar');
7473853a
SP
469
470 # Put 'bar' inside 'foo'
471 $foo->{'bar'} = $bar;
472
473 # Rebless the objects via a thread
474 threads->create(sub {
475 # Rebless the outer object
373098c0 476 bless($foo, 'Yin');
7473853a
SP
477
478 # Cannot directly rebless the inner object
373098c0 479 #bless($foo->{'bar'}, 'Yang');
7473853a
SP
480
481 # Retrieve and rebless the inner object
482 my $obj = $foo->{'bar'};
373098c0 483 bless($obj, 'Yang');
7473853a
SP
484 $foo->{'bar'} = $obj;
485
486 })->join();
487
373098c0
JH
488 print(ref($foo), "\n"); # Prints 'Yin'
489 print(ref($foo->{'bar'}), "\n"); # Prints 'Yang'
490 print(ref($bar), "\n"); # Also prints 'Yang'
7473853a 491
dab065ea
AB
492=head1 NOTES
493
33d16ee7
JH
494L<threads::shared> is designed to disable itself silently if threads are not
495available. This allows you to write modules and packages that can be used
496in both threaded and non-threaded applications.
497
498If you want access to threads, you must C<use threads> before you
7473853a
SP
499C<use threads::shared>. L<threads> will emit a warning if you use it after
500L<threads::shared>.
dab065ea 501
7473853a 502=head1 BUGS AND LIMITATIONS
b050c948 503
7473853a
SP
504When C<share> is used on arrays, hashes, array refs or hash refs, any data
505they contain will be lost.
515f0976 506
7473853a
SP
507 my @arr = qw(foo bar baz);
508 share(@arr);
509 # @arr is now empty (i.e., == ());
b050c948 510
7473853a
SP
511 # Create a 'foo' object
512 my $foo = { 'data' => 99 };
513 bless($foo, 'foo');
58122748 514
7473853a
SP
515 # Share the object
516 share($foo); # Contents are now wiped out
517 print("ERROR: \$foo is empty\n")
518 if (! exists($foo->{'data'}));
3d32476b 519
7473853a
SP
520Therefore, populate such variables B<after> declaring them as shared. (Scalar
521and scalar refs are not affected by this problem.)
522
523It is often not wise to share an object unless the class itself has been
2b936299
RGS
524written to support sharing. For example, an object's destructor may get
525called multiple times, once for each thread's scope exit. Another danger is
526that the contents of hash-based objects will be lost due to the above
527mentioned limitation. See F<examples/class.pl> (in the CPAN distribution of
528this module) for how to create a class that supports object sharing.
b050c948 529
1a3f0f1d
SM
530Does not support C<splice> on arrays. Does not support explicitly changing
531array lengths via $#array -- use C<push> and C<pop> instead.
b050c948 532
7473853a
SP
533Taking references to the elements of shared arrays and hashes does not
534autovivify the elements, and neither does slicing a shared array/hash over
535non-existent indices/keys autovivify the elements.
536
c6cab44f
JH
537C<share()> allows you to C<< share($hashref->{key}) >> and
538C<< share($arrayref->[idx]) >> without giving any error message. But the
539C<< $hashref->{key} >> or C<< $arrayref->[idx] >> is B<not> shared, causing
540the error "lock can only be used on shared values" to occur when you attempt
541to C<< lock($hasref->{key}) >> or C<< lock($arrayref->[idx]) >> in another
542thread.
b050c948 543
f6d55995
JH
544Using L<refaddr()|Scalar::Util/"refaddr EXPR">) is unreliable for testing
545whether or not two shared references are equivalent (e.g., when testing for
546circular references). Use L<is_shared()/"is_shared VARIABLE">, instead:
547
548 use threads;
549 use threads::shared;
550 use Scalar::Util qw(refaddr);
551
552 # If ref is shared, use threads::shared's internal ID.
553 # Otherwise, use refaddr().
554 my $addr1 = is_shared($ref1) || refaddr($ref1);
555 my $addr2 = is_shared($ref2) || refaddr($ref2);
556
557 if ($addr1 == $addr2) {
558 # The refs are equivalent
559 }
560
2e58fc35
JH
561L<each()|perlfunc/"each HASH"> does not work properly on shared references
562embedded in shared structures. For example:
563
564 my %foo :shared;
565 $foo{'bar'} = shared_clone({'a'=>'x', 'b'=>'y', 'c'=>'z'});
566
567 while (my ($key, $val) = each(%{$foo{'bar'}})) {
568 ...
569 }
570
571Either of the following will work instead:
572
573 my $ref = $foo{'bar'};
574 while (my ($key, $val) = each(%{$ref})) {
575 ...
576 }
577
578 foreach my $key (keys(%{$foo{'bar'}})) {
579 my $val = $foo{'bar'}{$key};
580 ...
581 }
582
7473853a 583View existing bug reports at, and submit any new bugs, problems, patches, etc.
794f4697 584to: L<http://rt.cpan.org/Public/Dist/Display.html?Name=threads-shared>
515f0976 585
b050c948
AB
586=head1 SEE ALSO
587
7473853a
SP
588L<threads::shared> Discussion Forum on CPAN:
589L<http://www.cpanforum.com/dist/threads-shared>
590
591Annotated POD for L<threads::shared>:
1a3f0f1d 592L<http://annocpan.org/~JDHEDDEN/threads-shared-1.33/shared.pm>
05b59262
RGS
593
594Source repository:
595L<http://code.google.com/p/threads-shared/>
7473853a
SP
596
597L<threads>, L<perlthrtut>
598
599L<http://www.perl.com/pub/a/2002/06/11/threads.html> and
600L<http://www.perl.com/pub/a/2002/09/04/threads.html>
601
602Perl threads mailing list:
603L<http://lists.cpan.org/showlist.cgi?name=iThreads>
604
605=head1 AUTHOR
606
607Artur Bergman E<lt>sky AT crucially DOT netE<gt>
608
7473853a
SP
609Documentation borrowed from the old Thread.pm.
610
611CPAN version produced by Jerry D. Hedden E<lt>jdhedden AT cpan DOT orgE<gt>.
b050c948 612
6c791b15
JH
613=head1 LICENSE
614
615threads::shared is released under the same license as Perl.
616
b050c948 617=cut