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