home *** CD-ROM | disk | FTP | other *** search
/ PC World 2005 December (Special) / PCWorld_2005-12_Special_cd.bin / Bezpecnost / lsti / lsti.exe / framework-2.5.exe / shared.pm < prev    next >
Text File  |  2005-01-27  |  9KB  |  249 lines
  1. package threads::shared;
  2.  
  3. use 5.008;
  4. use strict;
  5. use warnings;
  6. BEGIN {
  7.     require Exporter;
  8.     our @ISA = qw(Exporter);
  9.     our @EXPORT = qw(share cond_wait cond_timedwait cond_broadcast cond_signal);
  10.     our $VERSION = '0.92';
  11.  
  12.     if ($threads::threads) {
  13.     *cond_wait = \&cond_wait_enabled;
  14.     *cond_timedwait = \&cond_timedwait_enabled;
  15.     *cond_signal = \&cond_signal_enabled;
  16.     *cond_broadcast = \&cond_broadcast_enabled;
  17.     require XSLoader;
  18.     XSLoader::load('threads::shared',$VERSION);
  19.     push @EXPORT,'bless';
  20.     }
  21.     else {
  22.  
  23. # String eval is generally evil, but we don't want these subs to exist at all
  24. # if threads are loaded successfully.  Vivifying them conditionally this way
  25. # saves on average about 4K of memory per thread.
  26.  
  27.         eval <<'EOD';
  28. sub cond_wait      (\[$@%];\[$@%])  { undef }
  29. sub cond_timedwait (\[$@%]$;\[$@%]) { undef }
  30. sub cond_signal    (\[$@%])         { undef }
  31. sub cond_broadcast (\[$@%])         { undef }
  32. sub share          (\[$@%])         { return $_[0] }
  33. EOD
  34.     }
  35. }
  36.  
  37. $threads::shared::threads_shared = 1;
  38.  
  39. sub threads::shared::tie::SPLICE
  40. {
  41.  die "Splice not implemented for shared arrays";
  42. }
  43.  
  44. __END__
  45.  
  46. =head1 NAME
  47.  
  48. threads::shared - Perl extension for sharing data structures between threads
  49.  
  50. =head1 SYNOPSIS
  51.  
  52.   use threads;
  53.   use threads::shared;
  54.  
  55.   my $var : shared;
  56.  
  57.   my($scalar, @array, %hash);
  58.   share($scalar);
  59.   share(@array);
  60.   share(%hash);
  61.   my $bar = &share([]);
  62.   $hash{bar} = &share({});
  63.  
  64.   { lock(%hash); ...  }
  65.  
  66.   cond_wait($scalar);
  67.   cond_timedwait($scalar, time() + 30);
  68.   cond_broadcast(@array);
  69.   cond_signal(%hash);
  70.  
  71.   my $lockvar : shared;
  72.   # condition var != lock var
  73.   cond_wait($var, $lockvar);
  74.   cond_timedwait($var, time()+30, $lockvar);
  75.  
  76. =head1 DESCRIPTION
  77.  
  78. By default, variables are private to each thread, and each newly created
  79. thread gets a private copy of each existing variable.  This module allows
  80. you to share variables across different threads (and pseudoforks on Win32).
  81. It is used together with the threads module.
  82.  
  83. =head1 EXPORT
  84.  
  85. C<share>, C<cond_wait>, C<cond_timedwait>, C<cond_signal>, C<cond_broadcast>
  86.  
  87. Note that if this module is imported when C<threads> has not yet been
  88. loaded, then these functions all become no-ops. This makes it possible
  89. to write modules that will work in both threaded and non-threaded
  90. environments.
  91.  
  92. =head1 FUNCTIONS
  93.  
  94. =over 4
  95.  
  96. =item share VARIABLE
  97.  
  98. C<share> takes a value and marks it as shared. You can share a scalar,
  99. array, hash, scalar ref, array ref or hash ref.  C<share> will return
  100. the shared rvalue but always as a reference.
  101.  
  102. C<share> will traverse up references exactly I<one> level.
  103. C<share(\$a)> is equivalent to C<share($a)>, while C<share(\\$a)> is not.
  104.  
  105. A variable can also be marked as shared at compile time by using the
  106. C<shared> attribute: C<my $var : shared>.
  107.  
  108. If you want to share a newly created reference unfortunately you
  109. need to use C<&share([])> and C<&share({})> syntax due to problems
  110. with Perl's prototyping.
  111.  
  112. =item lock VARIABLE
  113.  
  114. C<lock> places a lock on a variable until the lock goes out of scope.
  115. If the variable is locked by another thread, the C<lock> call will
  116. block until it's available. C<lock> is recursive, so multiple calls
  117. to C<lock> are safe -- the variable will remain locked until the
  118. outermost lock on the variable goes out of scope.
  119.  
  120. If a container object, such as a hash or array, is locked, all the
  121. elements of that container are not locked. For example, if a thread
  122. does a C<lock @a>, any other thread doing a C<lock($a[12])> won't block.
  123.  
  124. C<lock> will traverse up references exactly I<one> level.
  125. C<lock(\$a)> is equivalent to C<lock($a)>, while C<lock(\\$a)> is not.
  126.  
  127. Note that you cannot explicitly unlock a variable; you can only wait
  128. for the lock to go out of scope. If you need more fine-grained
  129. control, see L<Thread::Semaphore>.
  130.  
  131. =item cond_wait VARIABLE
  132.  
  133. =item cond_wait CONDVAR, LOCKVAR
  134.  
  135. The C<cond_wait> function takes a B<locked> variable as a parameter,
  136. unlocks the variable, and blocks until another thread does a
  137. C<cond_signal> or C<cond_broadcast> for that same locked variable.
  138. The variable that C<cond_wait> blocked on is relocked after the
  139. C<cond_wait> is satisfied.  If there are multiple threads
  140. C<cond_wait>ing on the same variable, all but one will reblock waiting
  141. to reacquire the lock on the variable. (So if you're only using
  142. C<cond_wait> for synchronisation, give up the lock as soon as
  143. possible). The two actions of unlocking the variable and entering the
  144. blocked wait state are atomic, the two actions of exiting from the
  145. blocked wait state and relocking the variable are not.
  146.  
  147. In its second form, C<cond_wait> takes a shared, B<unlocked> variable
  148. followed by a shared, B<locked> variable.  The second variable is
  149. unlocked and thread execution suspended until another thread signals
  150. the first variable.
  151.  
  152. It is important to note that the variable can be notified even if
  153. no thread C<cond_signal> or C<cond_broadcast> on the variable.
  154. It is therefore important to check the value of the variable and
  155. go back to waiting if the requirement is not fulfilled.  For example,
  156. to pause until a shared counter drops to zero:
  157.  
  158.     { lock($counter); cond_wait($count) until $counter == 0; }
  159.  
  160. =item cond_timedwait VARIABLE, ABS_TIMEOUT
  161.  
  162. =item cond_timedwait CONDVAR, ABS_TIMEOUT, LOCKVAR
  163.  
  164. In its two-argument form, C<cond_timedwait> takes a B<locked> variable
  165. and an absolute timeout as parameters, unlocks the variable, and blocks
  166. until the timeout is reached or another thread signals the variable.  A
  167. false value is returned if the timeout is reached, and a true value
  168. otherwise.  In either case, the variable is re-locked upon return.
  169.  
  170. Like C<cond_wait>, this function may take a shared, B<locked> variable
  171. as an additional parameter; in this case the first parameter is an
  172. B<unlocked> condition variable protected by a distinct lock variable.
  173.  
  174. Again like C<cond_wait>, waking up and reacquiring the lock are not
  175. atomic, and you should always check your desired condition after this
  176. function returns.  Since the timeout is an absolute value, however, it
  177. does not have to be recalculated with each pass:
  178.  
  179.     lock($var);
  180.     my $abs = time() + 15;
  181.     until ($ok = desired_condition($var)) {
  182.       last if !cond_timedwait($var, $abs);
  183.     }
  184.     # we got it if $ok, otherwise we timed out!
  185.  
  186. =item cond_signal VARIABLE
  187.  
  188. The C<cond_signal> function takes a B<locked> variable as a parameter
  189. and unblocks one thread that's C<cond_wait>ing on that variable. If
  190. more than one thread is blocked in a C<cond_wait> on that variable,
  191. only one (and which one is indeterminate) will be unblocked.
  192.  
  193. If there are no threads blocked in a C<cond_wait> on the variable,
  194. the signal is discarded. By always locking before signaling, you can
  195. (with care), avoid signaling before another thread has entered cond_wait().
  196.  
  197. C<cond_signal> will normally generate a warning if you attempt to use it
  198. on an unlocked variable. On the rare occasions where doing this may be
  199. sensible, you can skip the warning with
  200.  
  201.     { no warnings 'threads'; cond_signal($foo) }
  202.  
  203. =item cond_broadcast VARIABLE
  204.  
  205. The C<cond_broadcast> function works similarly to C<cond_signal>.
  206. C<cond_broadcast>, though, will unblock B<all> the threads that are
  207. blocked in a C<cond_wait> on the locked variable, rather than only one.
  208.  
  209. =back
  210.  
  211. =head1 NOTES
  212.  
  213. threads::shared is designed to disable itself silently if threads are
  214. not available. If you want access to threads, you must C<use threads>
  215. before you C<use threads::shared>.  threads will emit a warning if you
  216. use it after threads::shared.
  217.  
  218. =head1 BUGS
  219.  
  220. C<bless> is not supported on shared references. In the current version,
  221. C<bless> will only bless the thread local reference and the blessing
  222. will not propagate to the other threads. This is expected to be
  223. implemented in a future version of Perl.
  224.  
  225. Does not support splice on arrays!
  226.  
  227. Taking references to the elements of shared arrays and hashes does not
  228. autovivify the elements, and neither does slicing a shared array/hash
  229. over non-existent indices/keys autovivify the elements.
  230.  
  231. share() allows you to C<< share $hashref->{key} >> without giving any error
  232. message.  But the C<< $hashref->{key} >> is B<not> shared, causing the error
  233. "locking can only be used on shared values" to occur when you attempt to
  234. C<< lock $hasref->{key} >>.
  235.  
  236. =head1 AUTHOR
  237.  
  238. Arthur Bergman E<lt>arthur at contiller.seE<gt>
  239.  
  240. threads::shared is released under the same license as Perl
  241.  
  242. Documentation borrowed from the old Thread.pm
  243.  
  244. =head1 SEE ALSO
  245.  
  246. L<threads>, L<perlthrtut>, L<http://www.perl.com/pub/a/2002/06/11/threads.html>
  247.  
  248. =cut
  249.