ext/threads/shared/shared.pm

   1 package threads::shared;
   2
   3 use 5.008;
   4
   5 use strict;
   6 use warnings;
   7
   8 our $VERSION = '1.06';
   9 my $XS_VERSION = $VERSION;
  10 $VERSION = eval $VERSION;
  11
  12 # Declare that we have been loaded
  13 $threads::shared::threads_shared = 1;
  14
  15 # Load the XS code, if applicable
  16 if ($threads::threads) {
  17     require XSLoader;
  18     XSLoader::load('threads::shared', $XS_VERSION);
  19
  20     *is_shared = \&_id;
  21
  22 } else {
  23     # String eval is generally evil, but we don't want these subs to
  24     # exist at all if 'threads' is not loaded successfully.
  25     # Vivifying them conditionally this way saves on average about 4K
  26     # of memory per thread.
  27     eval <<'_MARKER_';
  28         sub share          (\[$@%])         { return $_[0] }
  29         sub is_shared      (\[$@%])         { undef }
  30         sub cond_wait      (\[$@%];\[$@%])  { undef }
  31         sub cond_timedwait (\[$@%]$;\[$@%]) { undef }
  32         sub cond_signal    (\[$@%])         { undef }
  33         sub cond_broadcast (\[$@%])         { undef }
  34 _MARKER_
  35 }
  36
  37
  38 ### Export ###
  39
  40 sub import
  41 {
  42     # Exported subroutines
  43     my @EXPORT = qw(share is_shared cond_wait cond_timedwait
  44                     cond_signal cond_broadcast);
  45     if ($threads::threads) {
  46         push(@EXPORT, 'bless');
  47     }
  48
  49     # Export subroutine names
  50     my $caller = caller();
  51     foreach my $sym (@EXPORT) {
  52         no strict 'refs';
  53         *{$caller.'::'.$sym} = \&{$sym};
  54     }
  55 }
  56
  57
  58 ### Methods, etc. ###
  59
  60 sub threads::shared::tie::SPLICE
  61 {
  62     require Carp;
  63     Carp::croak('Splice not implemented for shared arrays');
  64 }
  65
  66 1;
  67
  68 __END__
  69
  70 =head1 NAME
  71
  72 threads::shared - Perl extension for sharing data structures between threads
  73
  74 =head1 VERSION
  75
  76 This document describes threads::shared version 1.06
  77
  78 =head1 SYNOPSIS
  79
  80   use threads;
  81   use threads::shared;
  82
  83   my $var :shared;
  84   $var = $scalar_value;
  85   $var = $shared_ref_value;
  86   $var = share($simple_unshared_ref_value);
  87
  88   my($scalar, @array, %hash);
  89   share($scalar);
  90   share(@array);
  91   share(%hash);
  92   my $bar = &share([]);
  93   $hash{bar} = &share({});
  94
  95   { lock(%hash); ...  }
  96
  97   cond_wait($scalar);
  98   cond_timedwait($scalar, time() + 30);
  99   cond_broadcast(@array);
 100   cond_signal(%hash);
 101
 102   my $lockvar :shared;
 103   # condition var != lock var
 104   cond_wait($var, $lockvar);
 105   cond_timedwait($var, time()+30, $lockvar);
 106
 107 =head1 DESCRIPTION
 108
 109 By default, variables are private to each thread, and each newly created
 110 thread gets a private copy of each existing variable.  This module allows you
 111 to share variables across different threads (and pseudoforks on Win32).  It is
 112 used together with the L<threads> module.
 113
 114 =head1 EXPORT
 115
 116 C<share>, C<cond_wait>, C<cond_timedwait>, C<cond_signal>, C<cond_broadcast>,
 117 C<is_shared>
 118
 119 Note that if this module is imported when L<threads> has not yet been loaded,
 120 then these functions all become no-ops.  This makes it possible to write
 121 modules that will work in both threaded and non-threaded environments.
 122
 123 =head1 FUNCTIONS
 124
 125 =over 4
 126
 127 =item share VARIABLE
 128
 129 C<share> takes a value and marks it as shared. You can share a scalar, array,
 130 hash, scalar ref, array ref, or hash ref.  C<share> will return the shared
 131 rvalue, but always as a reference.
 132
 133 A variable can also be marked as shared at compile time by using the
 134 C<:shared> attribute: C<my $var :shared;>.
 135
 136 Due to problems with Perl's prototyping, if you want to share a newly created
 137 reference, you need to use the C<&share([])> and C<&share({})> syntax.
 138
 139 The only values that can be assigned to a shared scalar are other scalar
 140 values, or shared refs:
 141
 142   my $var :shared;
 143   $var = 1;              # ok
 144   $var = [];             # error
 145   $var = &share([]);     # ok
 146
 147 C<share> will traverse up references exactly I<one> level.  C<share(\$a)> is
 148 equivalent to C<share($a)>, while C<share(\\$a)> is not.  This means that you
 149 must create nested shared data structures by first creating individual shared
 150 leaf nodes, and then adding them to a shared hash or array.
 151
 152   my %hash :shared;
 153   $hash{'meaning'} = &share([]);
 154   $hash{'meaning'}[0] = &share({});
 155   $hash{'meaning'}[0]{'life'} = 42;
 156
 157 =item is_shared VARIABLE
 158
 159 C<is_shared> checks if the specified variable is shared or not.  If shared,
 160 returns the variable's internal ID (similar to
 161 L<refaddr()|Scalar::Util/"refaddr EXPR">).  Otherwise, returns C<undef>.
 162
 163   if (is_shared($var)) {
 164       print("\$var is shared\n");
 165   } else {
 166       print("\$var is not shared\n");
 167   }
 168
 169 =item lock VARIABLE
 170
 171 C<lock> places a lock on a variable until the lock goes out of scope.  If the
 172 variable is locked by another thread, the C<lock> call will block until it's
 173 available.  C<lock> is recursive, so multiple calls to C<lock> are safe -- the
 174 variable will remain locked until the outermost lock on the variable goes out
 175 of scope.
 176
 177 If a container object, such as a hash or array, is locked, all the elements of
 178 that container are not locked.  For example, if a thread does a C<lock @a>,
 179 any other thread doing a C<lock($a[12])> won't block.
 180
 181 C<lock> will traverse up references exactly I<one> level.  C<lock(\$a)> is
 182 equivalent to C<lock($a)>, while C<lock(\\$a)> is not.
 183
 184 Note that you cannot explicitly unlock a variable; you can only wait for the
 185 lock to go out of scope.  This is most easily accomplished by locking the
 186 variable inside a block.
 187
 188   my $var :shared;
 189   {
 190       lock($var);
 191       # $var is locked from here to the end of the block
 192       ...
 193   }
 194   # $var is now unlocked
 195
 196 If you need more fine-grained control over shared variable access, see
 197 L<Thread::Semaphore>.
 198
 199 =item cond_wait VARIABLE
 200
 201 =item cond_wait CONDVAR, LOCKVAR
 202
 203 The C<cond_wait> function takes a B<locked> variable as a parameter, unlocks
 204 the variable, and blocks until another thread does a C<cond_signal> or
 205 C<cond_broadcast> for that same locked variable.  The variable that
 206 C<cond_wait> blocked on is relocked after the C<cond_wait> is satisfied.  If
 207 there are multiple threads C<cond_wait>ing on the same variable, all but one
 208 will reblock waiting to reacquire the lock on the variable. (So if you're only
 209 using C<cond_wait> for synchronisation, give up the lock as soon as possible).
 210 The two actions of unlocking the variable and entering the blocked wait state
 211 are atomic, the two actions of exiting from the blocked wait state and
 212 relocking the variable are not.
 213
 214 In its second form, C<cond_wait> takes a shared, B<unlocked> variable followed
 215 by a shared, B<locked> variable.  The second variable is unlocked and thread
 216 execution suspended until another thread signals the first variable.
 217
 218 It is important to note that the variable can be notified even if no thread
 219 C<cond_signal> or C<cond_broadcast> on the variable.  It is therefore
 220 important to check the value of the variable and go back to waiting if the
 221 requirement is not fulfilled.  For example, to pause until a shared counter
 222 drops to zero:
 223
 224   { lock($counter); cond_wait($count) until $counter == 0; }
 225
 226 =item cond_timedwait VARIABLE, ABS_TIMEOUT
 227
 228 =item cond_timedwait CONDVAR, ABS_TIMEOUT, LOCKVAR
 229
 230 In its two-argument form, C<cond_timedwait> takes a B<locked> variable and an
 231 absolute timeout as parameters, unlocks the variable, and blocks until the
 232 timeout is reached or another thread signals the variable.  A false value is
 233 returned if the timeout is reached, and a true value otherwise.  In either
 234 case, the variable is re-locked upon return.
 235
 236 Like C<cond_wait>, this function may take a shared, B<locked> variable as an
 237 additional parameter; in this case the first parameter is an B<unlocked>
 238 condition variable protected by a distinct lock variable.
 239
 240 Again like C<cond_wait>, waking up and reacquiring the lock are not atomic,
 241 and you should always check your desired condition after this function
 242 returns.  Since the timeout is an absolute value, however, it does not have to
 243 be recalculated with each pass:
 244
 245   lock($var);
 246   my $abs = time() + 15;
 247   until ($ok = desired_condition($var)) {
 248       last if !cond_timedwait($var, $abs);
 249   }
 250   # we got it if $ok, otherwise we timed out!
 251
 252 =item cond_signal VARIABLE
 253
 254 The C<cond_signal> function takes a B<locked> variable as a parameter and
 255 unblocks one thread that's C<cond_wait>ing on that variable. If more than one
 256 thread is blocked in a C<cond_wait> on that variable, only one (and which one
 257 is indeterminate) will be unblocked.
 258
 259 If there are no threads blocked in a C<cond_wait> on the variable, the signal
 260 is discarded. By always locking before signaling, you can (with care), avoid
 261 signaling before another thread has entered cond_wait().
 262
 263 C<cond_signal> will normally generate a warning if you attempt to use it on an
 264 unlocked variable. On the rare occasions where doing this may be sensible, you
 265 can suppress the warning with:
 266
 267   { no warnings 'threads'; cond_signal($foo); }
 268
 269 =item cond_broadcast VARIABLE
 270
 271 The C<cond_broadcast> function works similarly to C<cond_signal>.
 272 C<cond_broadcast>, though, will unblock B<all> the threads that are blocked in
 273 a C<cond_wait> on the locked variable, rather than only one.
 274
 275 =back
 276
 277 =head1 OBJECTS
 278
 279 L<threads::shared> exports a version of L<bless()|perlfunc/"bless REF"> that
 280 works on shared objects such that i<blessings> propagate across threads.
 281
 282   # Create a shared 'foo' object
 283   my $foo;
 284   share($foo);
 285   $foo = &share({});
 286   bless($foo, 'foo');
 287
 288   # Create a shared 'bar' object
 289   my $bar;
 290   share($bar);
 291   $bar = &share({});
 292   bless($bar, 'bar');
 293
 294   # Put 'bar' inside 'foo'
 295   $foo->{'bar'} = $bar;
 296
 297   # Rebless the objects via a thread
 298   threads->create(sub {
 299       # Rebless the outer object
 300       bless($foo, 'yin');
 301
 302       # Cannot directly rebless the inner object
 303       #bless($foo->{'bar'}, 'yang');
 304
 305       # Retrieve and rebless the inner object
 306       my $obj = $foo->{'bar'};
 307       bless($obj, 'yang');
 308       $foo->{'bar'} = $obj;
 309
 310   })->join();
 311
 312   print(ref($foo),          "\n");    # Prints 'yin'
 313   print(ref($foo->{'bar'}), "\n");    # Prints 'yang'
 314   print(ref($bar),          "\n");    # Also prints 'yang'
 315
 316 =head1 NOTES
 317
 318 threads::shared is designed to disable itself silently if threads are not
 319 available. If you want access to threads, you must C<use threads> before you
 320 C<use threads::shared>.  L<threads> will emit a warning if you use it after
 321 L<threads::shared>.
 322
 323 =head1 BUGS AND LIMITATIONS
 324
 325 When C<share> is used on arrays, hashes, array refs or hash refs, any data
 326 they contain will be lost.
 327
 328   my @arr = qw(foo bar baz);
 329   share(@arr);
 330   # @arr is now empty (i.e., == ());
 331
 332   # Create a 'foo' object
 333   my $foo = { 'data' => 99 };
 334   bless($foo, 'foo');
 335
 336   # Share the object
 337   share($foo);        # Contents are now wiped out
 338   print("ERROR: \$foo is empty\n")
 339       if (! exists($foo->{'data'}));
 340
 341 Therefore, populate such variables B<after> declaring them as shared.  (Scalar
 342 and scalar refs are not affected by this problem.)
 343
 344 It is often not wise to share an object unless the class itself has been
 345 written to support sharing. For example, an object's destructor may get called
 346 multiple times, one for each thread's scope exit.  Another example, is that
 347 the contents of hash-based objects will be lost due to the above mentioned
 348 limitation.  See F<examples/class.pl> (in the CPAN distribution of this
 349 module) for how to create a class that supports object sharing.
 350
 351 Does not support C<splice> on arrays!
 352
 353 Taking references to the elements of shared arrays and hashes does not
 354 autovivify the elements, and neither does slicing a shared array/hash over
 355 non-existent indices/keys autovivify the elements.
 356
 357 C<share()> allows you to C<< share($hashref->{key}) >> without giving any
 358 error message.  But the C<< $hashref->{key} >> is B<not> shared, causing the
 359 error "locking can only be used on shared values" to occur when you attempt to
 360 C<< lock($hasref->{key}) >>.
 361
 362 View existing bug reports at, and submit any new bugs, problems, patches, etc.
 363 to: L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=threads-shared>
 364
 365 =head1 SEE ALSO
 366
 367 L<threads::shared> Discussion Forum on CPAN:
 368 L<http://www.cpanforum.com/dist/threads-shared>
 369
 370 Annotated POD for L<threads::shared>:
 371 L<http://annocpan.org/~JDHEDDEN/threads-shared-1.06/shared.pm>
 372
 373 L<threads>, L<perlthrtut>
 374
 375 L<http://www.perl.com/pub/a/2002/06/11/threads.html> and
 376 L<http://www.perl.com/pub/a/2002/09/04/threads.html>
 377
 378 Perl threads mailing list:
 379 L<http://lists.cpan.org/showlist.cgi?name=iThreads>
 380
 381 =head1 AUTHOR
 382
 383 Artur Bergman E<lt>sky AT crucially DOT netE<gt>
 384
 385 threads::shared is released under the same license as Perl.
 386
 387 Documentation borrowed from the old Thread.pm.
 388
 389 CPAN version produced by Jerry D. Hedden E<lt>jdhedden AT cpan DOT orgE<gt>.
 390
 391 =cut