1package Thread::Suspend; { 2 3use strict; 4use warnings; 5 6our $VERSION = '1.23'; 7 8use threads 1.39; 9use threads::shared 1.01; 10 11my %SUSPEND :shared; # Thread suspension counts by TID 12 13my $SIGNAL = 'STOP'; # Default suspension signal 14 15 16sub import 17{ 18 my $class = shift; # Not used 19 20 # Set the signal for suspend operations 21 while (my $sig = shift) { 22 $SIGNAL = $sig; 23 } 24 $SIGNAL =~ s/^SIG//; 25 26 # Set up the suspend signal handler 27 $SIG{$SIGNAL} = sub { 28 my $tid = threads->tid(); 29 lock(%SUSPEND); 30 while ($SUSPEND{$tid}) { 31 cond_wait(%SUSPEND); 32 } 33 }; 34} 35 36 37sub threads::suspend 38{ 39 my ($thing, @threads) = @_; 40 41 if ($thing eq 'threads') { 42 if (@threads) { 43 # Suspend specified list of threads 44 @threads = grep { $_ } 45 map { (ref($_) eq 'threads') 46 ? $_ 47 : threads->object($_) } 48 @threads; 49 } else { 50 # Suspend all non-detached threads 51 push(@threads, threads->list(threads::running)); 52 } 53 } else { 54 # Suspend a single thread 55 push(@threads, $thing); 56 } 57 58 # Suspend threads 59 lock(%SUSPEND); 60 foreach my $thr (@threads) { 61 my $tid = $thr->tid(); 62 # Increment suspension count 63 if (! $SUSPEND{$tid}++) { 64 # Send suspend signal if not currently suspended 65 $thr->kill($SIGNAL); 66 if (! $thr->is_running()) { 67 # Thread terminated before it could be suspended 68 delete($SUSPEND{$tid}); 69 } 70 } 71 } 72 73 # Return list of affected threads 74 return ($thing eq 'threads') 75 ? grep { $_->is_running() } @threads 76 : $thing; 77} 78 79 80sub threads::resume 81{ 82 my ($thing, @threads) = @_; 83 84 lock(%SUSPEND); 85 if ($thing eq 'threads') { 86 if (@threads) { 87 # Resume specified threads 88 @threads = grep { $_ } 89 map { (ref($_) eq 'threads') 90 ? $_ 91 : threads->object($_) } 92 @threads; 93 } else { 94 # Resume all threads 95 @threads = grep { $_ } 96 map { threads->object($_) } 97 keys(%SUSPEND); 98 } 99 } else { 100 # Resume a single thread 101 push(@threads, $thing); 102 } 103 104 # Resume threads 105 my $resume = 0; 106 foreach my $thr (@threads) { 107 my $tid = $thr->tid(); 108 if ($SUSPEND{$tid}) { 109 # Decrement suspension count 110 if (! --$SUSPEND{$tid}) { 111 # Suspension count reached zero 112 $resume = 1; 113 delete($SUSPEND{$tid}); 114 } 115 } 116 } 117 # Broadcast any resumptions 118 if ($resume) { 119 cond_broadcast(%SUSPEND); 120 } 121 122 # Return list of affected threads 123 return ($thing eq 'threads') ? @threads : $thing; 124} 125 126 127sub threads::is_suspended 128{ 129 my $item = shift; 130 131 lock(%SUSPEND); 132 if ($item eq 'threads') { 133 # Return list of all non-detached suspended threads 134 return (grep { $_ } 135 map { threads->object($_) } 136 keys(%SUSPEND)); 137 138 } else { 139 # Return suspension count for a single thread 140 my $tid = $item->tid(); 141 return ($SUSPEND{$tid}) ? $SUSPEND{$tid} : 0; 142 } 143} 144 145} 146 1471; 148 149__END__ 150 151=head1 NAME 152 153Thread::Suspend - Suspend and resume operations for threads 154 155=head1 VERSION 156 157This document describes Thread::Suspend version 1.23 158 159=head1 SYNOPSIS 160 161 use Thread::Suspend 'SIGUSR1'; # Set the suspension signal 162 use Thread::Suspend; # Defaults to 'STOP' 163 164 $thr->suspend(); # Suspend a thread 165 threads->suspend(); # Suspend all non-detached threads 166 threads->suspend($thr, $tid, ...); # Suspend multiple threads using 167 # objects or TIDs 168 169 $thr->is_suspended(); # Returns suspension count 170 threads->is_suspended(); # Returns list of all suspended threads 171 172 $thr->resume(); # Resume a thread 173 threads->resume(); # Resume all threads 174 threads->resume($thr, $tid, ...); # Resume multiple threads 175 176=head1 DESCRIPTION 177 178This module adds suspend and resume operations for threads. 179 180Suspensions are cumulative, and need to be matched by an equal number of 181resume calls. 182 183=head2 Declaration 184 185This module must be imported prior to any threads being created. 186 187Suspension is accomplished via a signal handler which is used by all threads 188on which suspend operations are performed. The signal for this operation can 189be specified when this module is declared, and defaults to C<SIGSTOP>. 190Consequently, the application and its threads must not specify some other 191handler for use with the suspend signal. 192 193=over 194 195=item use Thread::Suspend; 196 197Declares this module, and defaults to using C<SIGSTOP> for suspend operations. 198 199=item use Thread::Suspend 'SIGUSR1'; 200 201=item use Thread::Suspend 'Signal' => 11; 202 203Declares this module, and uses the specified signal for suspend operations. 204Signals may be specified by the same names or (positive) numbers as supported 205by L<kill()|perlfunc/"kill SIGNAL, LIST">. 206 207=back 208 209=head2 Methods 210 211=over 212 213=item $thr->suspend() 214 215Adds 1 to the suspension count of the thread, and suspends its execution if 216running. Returns the I<threads> object. 217 218It is possible for a thread to suspend itself. This is useful for starting a 219thread early in an application, and having it C<wait> until needed: 220 221 sub thr_func 222 { 223 # Suspend until needed 224 threads->self()->suspend(); 225 ... 226 } 227 228=item threads->suspend() 229 230Adds 1 to the suspension count of all non-detached threads, and 231suspends their execution if running. Returns a list of those threads. 232 233=item threads->suspend($thr, $tid, ...) 234 235Adds 1 to the suspension count of the threads specified by their objects or 236TIDs (for non-detached threads), and suspends their execution if running. 237Returns a list of the corresponding I<threads> objects affected by the call. 238 239=item $thr->is_suspended() 240 241Returns the suspension count for the thread. 242 243=item threads->is_suspended() 244 245Returns a list of currently suspended, non-detached threads. 246 247=item $thr->resume() 248 249Decrements the suspension count for a thread. The thread will resume 250execution if the count reaches zero. Returns the I<threads> object. 251 252=item threads->resume() 253 254Decrements the suspension count for all currently suspended, non-detached 255threads. Those threads that reach a count of zero will resume execution. 256Returns a list of the threads operated on. 257 258Given possible multiple levels of suspension, you can ensure that all 259(non-detached) threads are running using: 260 261 while (threads->resume()) { } 262 263=item threads->resume($thr, $tid, ...) 264 265Decrements the suspension count of the threads specified by their objects or 266TIDs (for non-detached threads). Those threads that reach a count of zero 267will resume execution. Returns a list of the threads operated on. 268 269=back 270 271=head1 CAVEATS 272 273Subject to the limitations of L<threads/"THREAD SIGNALLING">. 274 275A thread that has been suspended will not respond to any other signals or 276commands until its suspension count is brought back to zero via resume calls. 277 278Any locks held by a thread when it is suspended will remain in effect. To 279alleviate this potential problem, lock any such variables as part of a limited 280scope that also contains the suspension call: 281 282 { 283 lock($var); 284 $thr->suspend(); 285 } 286 287Calling C<-E<gt>resume()> on an non-suspended thread is ignored. 288 289Detached threads can only be operated upon if their I<threads> object is used. 290For example, the following works: 291 292 my $thr = threads->create(...); 293 $thr->detach(); 294 ... 295 $thr->suspend(); # or threads->suspend($thr); 296 ... 297 $thr->resume(); # or threads->resume($thr); 298 299Threads that have finished execution are, for the most part, ignored by this 300module. 301 302=head1 REQUIREMENTS 303 304Perl 5.8.0 or later 305 306L<threads> 1.39 or later 307 308L<threads::shared> 1.01 or later 309 310L<Test::More> 0.50 or later (for installation) 311 312=head1 SEE ALSO 313 314Thread::Suspend on MetaCPAN: 315L<https://metacpan.org/release/Thread-Suspend> 316 317Code repository: 318L<https://github.com/jdhedden/Thread-Suspend> 319 320L<threads>, L<threads::shared> 321 322Sample code in the I<examples> directory of this distribution on CPAN. 323 324=head1 AUTHOR 325 326Jerry D. Hedden, S<E<lt>jdhedden AT cpan DOT orgE<gt>> 327 328=head1 COPYRIGHT AND LICENSE 329 330Copyright 2006 - 2009 Jerry D. Hedden. All rights reserved. 331 332This program is free software; you can redistribute it and/or modify it under 333the same terms as Perl itself. 334 335=cut 336