Your IP : 216.73.216.86
examples/pool.pl 0000644 00000010216 15170351007 0007667 0 ustar 00 #!/usr/bin/perl
use strict;
use warnings;
use threads 1.39;
use threads::shared;
use Thread::Queue;
### Global Variables ###
# Maximum working threads
my $MAX_THREADS = 10;
# Maximum thread working time
my $TIMEOUT = 10;
# Flag to inform all threads that application is terminating
my $TERM :shared = 0;
# Prevents double detach attempts
my $DETACHING :shared;
### Signal Handling ###
# Gracefully terminate application on ^C
# or command line 'kill'
$SIG{'INT'} = $SIG{'TERM'} =
sub {
print(">>> Terminating <<<\n");
$TERM = 1;
};
# This signal handler is called inside threads
# that get cancelled by the timer thread
$SIG{'KILL'} =
sub {
# Tell user we've been terminated
printf(" %3d <- Killed\n", threads->tid());
# Detach and terminate
lock($DETACHING);
threads->detach() if ! threads->is_detached();
threads->exit();
};
### Main Processing Section ###
MAIN:
{
# Start timer thread
my $queue = Thread::Queue->new();
threads->create('timer', $queue)->detach();
# Manage the thread pool until signalled to terminate
while (! $TERM) {
# Keep max threads running
for (my $needed = $MAX_THREADS - threads->list();
$needed && ! $TERM;
$needed--)
{
# New thread
threads->create('worker', $queue, $TIMEOUT);
}
# Wait for any threads to finish
sleep(1);
}
### CLEANING UP ###
# Wait for max timeout for threads to finish
while ((threads->list() > 0) && $TIMEOUT--) {
sleep(1);
}
# Detach and kill any remaining threads
foreach my $thr (threads->list()) {
lock($DETACHING);
$thr->detach() if ! $thr->is_detached();
$thr->kill('KILL');
}
}
print("Done\n");
exit(0);
### Thread Entry Point Subroutines ###
# A worker thread
sub worker
{
my ($queue, $timeout) = @_;
### INITIALIZE ###
# My thread ID
my $tid = threads->tid();
printf("Working -> %3d\n", $tid);
# Register with timer thread
$queue->enqueue($tid, $timeout);
### WORK ###
# Do some work while monitoring $TERM
my $sleep = 5 + int(rand(10));
while (($sleep > 0) && ! $TERM) {
$sleep -= sleep($sleep);
}
### DONE ###
# Remove signal handler
$SIG{'KILL'} = sub {};
# Unregister with timer thread
$queue->enqueue($tid, undef);
# Tell user we're done
printf(" %3d <- Finished\n", $tid);
# Detach and terminate
lock($DETACHING);
threads->detach() if ! threads->is_detached();
threads->exit();
}
# The timer thread that monitors other threads for timeout
sub timer
{
my $queue = shift; # The registration queue
my %timers; # Contains threads and timeouts
# Loop until told to quit
while (! $TERM) {
# Check queue
while (my $tid = $queue->dequeue_nb()) {
if (! ($timers{$tid}{'timeout'} = $queue->dequeue()) ||
! ($timers{$tid}{'thread'} = threads->object($tid)))
{
# No timeout - unregister thread
delete($timers{$tid});
}
}
# Cancel timed out threads
foreach my $tid (keys(%timers)) {
if (--$timers{$tid}{'timeout'} < 0) {
$timers{$tid}{'thread'}->kill('KILL');
delete($timers{$tid});
}
}
# Tick tock
sleep(1);
}
}
__END__
=head1 NAME
pool.pl - Simple 'threads' example
=head1 DESCRIPTION
A simplistic example illustrating the following:
=over
=item * Management of a pool of threads
=item * Communication between threads using queues
=item * Timing out and cancelling threads
=item * Interrupting a threaded program
=item * Cleaning up threads before terminating
=back
=head1 SEE ALSO
L<threads>, L<threads::shared>, and L<Thread::Queue>
=head1 AUTHOR
Jerry D. Hedden, S<E<lt>jdhedden AT cpan DOT orgE<gt>>
=head1 COPYRIGHT AND LICENSE
Copyright 2006 - 2009 Jerry D. Hedden. All rights reserved.
This program is free software; you can redistribute it and/or modify it under
the same terms as Perl itself.
=cut
examples/pool_reuse.pl 0000644 00000006477 15170351007 0011110 0 ustar 00 #!/usr/bin/perl
use strict;
use warnings;
use threads 1.39;
use threads::shared;
use Thread::Queue;
### Global Variables ###
# Maximum working threads
my $MAX_THREADS = 10;
# Flag to inform all threads that application is terminating
my $TERM :shared = 0;
# Threads add their ID to this queue when they are ready for work
# Also, when app terminates a -1 is added to this queue
my $IDLE_QUEUE = Thread::Queue->new();
### Signal Handling ###
# Gracefully terminate application on ^C or command line 'kill'
$SIG{'INT'} = $SIG{'TERM'} =
sub {
print(">>> Terminating <<<\n");
$TERM = 1;
# Add -1 to head of idle queue to signal termination
$IDLE_QUEUE->insert(0, -1);
};
### Main Processing Section ###
MAIN:
{
### INITIALIZE ###
# Thread work queues referenced by thread ID
my %work_queues;
# Create the thread pool
for (1..$MAX_THREADS) {
# Create a work queue for a thread
my $work_q = Thread::Queue->new();
# Create the thread, and give it the work queue
my $thr = threads->create('worker', $work_q);
# Remember the thread's work queue
$work_queues{$thr->tid()} = $work_q;
}
### DO WORK ###
# Manage the thread pool until signalled to terminate
while (! $TERM) {
# Wait for an available thread
my $tid = $IDLE_QUEUE->dequeue();
# Check for termination condition
last if ($tid < 0);
# Give the thread some work to do
my $work = 5 + int(rand(10));
$work_queues{$tid}->enqueue($work);
}
### CLEANING UP ###
# Signal all threads that there is no more work
$work_queues{$_}->enqueue(-1) foreach keys(%work_queues);
# Wait for all the threads to finish
$_->join() foreach threads->list();
}
print("Done\n");
exit(0);
### Thread Entry Point Subroutines ###
# A worker thread
sub worker
{
my ($work_q) = @_;
# This thread's ID
my $tid = threads->tid();
# Work loop
do {
# Indicate that were are ready to do work
printf("Idle -> %2d\n", $tid);
$IDLE_QUEUE->enqueue($tid);
# Wait for work from the queue
my $work = $work_q->dequeue();
# If no more work, exit
last if ($work < 0);
# Do some work while monitoring $TERM
printf(" %2d <- Working\n", $tid);
while (($work > 0) && ! $TERM) {
$work -= sleep($work);
}
# Loop back to idle state if not told to terminate
} while (! $TERM);
# All done
printf("Finished -> %2d\n", $tid);
}
__END__
=head1 NAME
pool_reuse.pl - Simple 'threads' example with a reusable thread pool
=head1 DESCRIPTION
A simplistic example illustrating the following:
=over
=item * Creation of a pool of reusable threads
=item * Threads use a queue to indicate readiness for handling work
=item * Sending work to threads using queues
=item * Interrupting a threaded program
=item * Cleaning up threads before terminating
=back
=head1 SEE ALSO
L<threads>, L<threads::shared>, and L<Thread::Queue>
=head1 AUTHOR
Jerry D. Hedden, S<E<lt>jdhedden AT cpan DOT orgE<gt>>
=head1 COPYRIGHT AND LICENSE
Copyright 2006 - 2009 Jerry D. Hedden. All rights reserved.
This program is free software; you can redistribute it and/or modify it under
the same terms as Perl itself.
=cut
Changes 0000644 00000023154 15170351007 0006043 0 ustar 00 Revision history for Perl extension threads.
2.21 Mon Jan 22 20:09:07 EST 2018
- Fix to CLANG macros
- Can return subs from threads. See docs.
- Sync from blead
2.16 Sun May 7 22:32:59 2017
- Fix Clang macro backward compatibility per patch by Andy Grundman
- Sync from blead
2.15 Sun Feb 26 22:45:33 2017
- Sync from blead
2.14 Sun Feb 26 21:14:26 2017
- Sync from blead
2.13 Sun Feb 26 17:59:01 2017
- Added t/kill3.t to test that dir handles are thread-safe
2.12 Sat Dec 31 17:50:58 2016
- Fix Clang macro
2.09 Fri May 20 18:58:20 2016
- Document that detached threads suppress the global destruction phase
2.08 Mon May 16 17:40:57 2016
- Make t/test.pl compatible with Perls < 5.10 (again)
2.07 Sat Apr 30 21:31:39 2016
- Sync from blead
2.02 Thu Jun 11 03:02:21 2015
- Make t/test.pl compatible with Perls < 5.10
2.01 Sun Mar 8 02:32:03 2015
- Make t/test.pl compatible with Perls < 5.14
1.99 Fri Mar 6 14:21:52 2015
- Fix for missing PERL_UNUSED_RESULT (for real)
1.98 Thu Mar 5 05:27:34 2015
- Fix for missing PERL_UNUSED_RESULT
1.97 Tue Mar 3 23:30:07 2015
- Sync from blead
1.96 Wed Aug 27 22:05:34 2014
- Sync from blead
1.92 Tue Feb 4 23:35:31 2014
- Version bump for blead
1.91 Tue Feb 4 21:37:39 2014
- Sync from blead
1.89 Mon Sep 30 14:49:47 2013
- POD updates for alarm() sample code and the specifics of _handle()
1.87 Tue May 28 15:11:30 2013
- Ignore signals to finished threads (threads bug #85140)
1.86 Wed Dec 14 21:12:51 2011
- Fix for mingw-w64 build due to setjmp difference
1.85 Sat Sep 3 15:02:29 2011
- Version bump for blead
1.84 Sat Sep 3 02:54:19 2011
- Sync from blead
- Document signal catching by thread 0
1.83 Sun Apr 17 23:37:01 2011
- Sync from blead
1.82 Fri Dec 24 16:21:56 2010
- Document issue with open dir handles
- Sync from blead
- POD update
1.81 Mon Sep 27 17:36:31 2010
- Make compatible with Perl 5.13.2 and higher
1.79 Fri Sep 24 18:40:59 2010
- Fix failing tests in t/kill2.t
1.78 Wed Sep 22 17:21:22 2010
- Handle missing signal handler in thread (threads bug #60460)
1.77 Fri Mar 26 13:36:33 2010
- Fix race condition in t/threads.t (threads bug #55633)
1.76 Tue Mar 9 14:02:43 EST 2010
- Handle magic on arg to ->object() (bug #73330)
- Make ->object(threads->tid()) work like ->self() (bug #73330)
- Noted memory consumption issue in POD
- Added reusable thread pool example
1.75 Mon Nov 23 15:32:28 2009
- Conditionally compile tmps stack cleanup code (bug #70411)
- Support mingw64
- Install in 'site' for Perl >= 5.011
1.74 Mon Aug 10 18:53:59 2009
- Updated DESCRIPTION in POD
- Added 'no_threads' test
- Upgraded ppport.h to Devel::PPPort 3.19
1.73 Mon Jun 8 13:17:04 2009
- Signal handling during thread creation/destruction (John Wright)
- Upgraded ppport.h to Devel::PPPort 3.17
1.72 Wed Feb 25 20:23:25 2009
- Correct flags to perl_get_sv() in threads.xs
- Use watchdog() in 'free' tests
- Simplified loading modules in tests
- Upgraded ppport.h to Devel::PPPort 3.16
1.71 Tue Jun 10 17:07:25 2008
- Upgraded ppport.h to Devel::PPPort 3.14
- Discourage the use of END blocks in threads
- LICENSE section in POD
- 'die' properly if no compiler
- End all tests with exit(0)
1.69 Fri Feb 22 21:22:22 2008
- Allow installation on non-threaded Perls
1.68 Wed Feb 20 17:05:21 2008
- Blead change 33024
- Upgraded ppport.h to Devel::PPPort 3.13_01
1.67 Tue Sep 18 20:44:40 2007
- Test fix for Perl < 5.8.7
1.66 Fri Sep 14 18:54:20 2007
- [perl #45053] Memory corruption with heavy module loading in threads
- Upgraded ppport.h to Devel::PPPort 3.11_06
1.65 Wed Sep 5 13:19:09 2007
- Skip spelling test (maintainer only)
1.64 Sun Aug 19 13:59:16 EDT 2007
- Documented cwd and %ENV issues wrt threads
- Sundry test suite fixes
- POD spelling test
1.63 Tue Jun 26 21:15:27 EDT 2007
- Avoid double-free of the thread function
- Added reference in POD to perlmod section on thread safety
- Mention leaked and unreferenced scalar warnings in POD
- Removed BEGIN in threads.pm
- Only need to require Config
1.62 Thu May 17 16:10:49 2007
- Fixed :all import option
- Fixed problems in test suite
1.61 Wed Mar 21 16:09:15 EDT 2007
- Fix 'list/array' context - both keywords are supported
- Upgraded ppport.h to Devel::PPPort 3.11
- Removed embed.t - unreliable
1.59 Mon Feb 5 16:05:44 EST 2007
- POD tweaks per Wolfgang Laun
1.58 Wed Jan 24 13:15:34 EST 2007
- Fix race conditions on thread destruction (Dave Mitchell)
- Ignore thread return value(s) in void context
- Check for missing args for 'use threads' options
- Check that stack size argument is numeric
1.57 Wed Dec 20 13:10:26 EST 2006
- Fixes courtesy of Michael J. Pomraning
Eliminates self joins
Eliminates multiple, simultaneous joins on a thread
Protects thread->state variable with mutexes
Checks that OS join call is successful
1.56 Fri Dec 15 12:18:47 EST 2006
- More fixes to test suite
1.55 Fri Dec 15 11:24:46 EST 2006
- Fixes to test suite
1.54 Thu Dec 14 14:12:30 EST 2006
- Added ->error() method
1.53 Mon Nov 27 12:08:27 EST 2006
- Fix for a thread cloning bug
- Fixes to test suite
1.52 Tue Nov 21 11:04:03 EST 2006
- Fix compiler warnings
1.51 Wed Nov 15 14:25:30 EST 2006
- Thread destruction fix
1.49 Fri Nov 3 08:33:28 EST 2006
- Fix a warning message
1.48 Thu Nov 2 12:33:22 EST 2006
- Fix for segfault during thread destruction
1.47 Mon Oct 30 16:02:53 EST 2006
- Fix t/thread.t crash under Win32
- Test multiple embedded Perl support
1.46 Fri Oct 27 19:51:48 EST 2006
- Support multiple embedded Perls
- Document workaround for non-threadsafe modules
1.45 Wed Oct 25 14:22:23 EDT 2006
- Makefile.PL changes for CORE
- Updated POD tests
1.44 Wed Oct 11 08:55:50 EDT 2006
- Complain about bad import options
- Added example threads script
1.43 Fri Oct 6 15:12:07 EDT 2006
- Stringify threads objects
- Removed 'typemap' file
1.42 Mon Sep 18 11:17:13 EDT 2006
- Fixes to tests
- Move $threads::threads outside of BEGIN block
1.41 Fri Sep 8 19:28:41 EST 2006
- Race condition fixes
1.39 Tue Aug 30 12:00:00 EDT 2006
- Signals are safe in 5.8.0
- Upgraded ppport.h to Devel::PPPort 3.10
1.38 Tue Aug 1 11:48:56 EDT 2006
- Fixes to tests
1.37 Fri Jul 21 10:51:36 EDT 2006
- Revert 'exit' behavior with override
1.36 Mon Jul 10 15:58:13 EDT 2006
- Ignore signals sent to terminated threads
1.35 Mon Jul 10 09:44:47 EDT 2006
- Upgraded ppport.h to Devel::PPPort 3.09
- Fix for Borland compiler
1.34 Thu Jul 6 10:29:37 EDT 2006
- Added ->is_running, ->is_detached, ->is_joinable, ->wantarray
- Enhanced ->list to return running or joinable threads
1.33 Mon Jul 3 10:11:20 EDT 2006
- 'exit' inside a thread silently terminates thread only
- Added 'threads->exit()' (just calls CORE::exit(0))
- Handle 'die/exit' in thread warn handlers if thread terminates
with a warning
- Give exact accounting of unjoined threads on program termination
- Fix spurious 'failures' from t/blocks.t
- Set correct path to threads module in tests that use test.pl
1.32 Mon Jun 5 09:27:53 EDT 2006
- Fix for HP-UX 10.20 pthread_attr_getstacksize usage
- Check for threads::shared in tests
1.31 Fri May 19 16:06:42 EDT 2006
- Explicit thread context
1.29 Thu May 18 16:09:28 EDT 2006
- Fix warning/core dump from ->create('foo') in BEGIN block
1.28 Wed May 17 14:33:13 EDT 2006
- Fix for build failure under older Perl versions
- Skip signalling tests if using unsafe signals
1.27 Thu May 11 11:52:21 EDT 2006
- Added $thr->kill() method for thread signalling
- Check for 'C' compiler when building module
1.26 Mon May 8 13:18:29 EDT 2006
- Fix for Win32 build WRT page size
1.25 Thu May 4 12:34:02 EDT 2006
- Final sync with blead
- Lock counters in tests
1.24 Mon Apr 24 10:29:11 EDT 2006
- assert() that thread 0 is never destructed
- Determinancy in free.t
1.23 Thu Apr 13 16:57:00 EDT 2006
- BUG (RE)FIX: Properly free thread's Perl interpreter
- It's an error to detach a thread twice
- More XS code cleanups
1.22 Fri Apr 7 21:35:06 EDT 2006
- Documented maximum stack size error
1.21 Tue Apr 4 13:57:23 EDT 2006
- Corrected ->_handle() to return a pointer
- Overload !=
1.19 Sat Mar 25 18:46:02 EST 2006
- Use 'DEFINE' instead of 'CCFLAGS' in Makefile.PL
1.18 Fri Mar 24 14:21:36 EST 2006
- ->equal returns 0 on false for backwards compatibility
- Changed UVs to IVs in XS code (except for TID)
- Use ->create in tests
1.17 Thu Mar 23 10:31:20 EST 2006
- Restoration of 'core' build parameters
1.15 Wed Mar 22 13:46:51 EST 2006
- BUG FIX: Replaced SvPV_nolen_const macro
- Disabled closure return test again and added note in POD
1.14 Tue Mar 21 08:40:16 EST 2006
- BUG FIX: Corrected UV formatting string
1.13 Mon Mar 20 15:09:42 EST 2006
- BUG FIX: Round stack sizes to multiple of page size
- Use PTHREAD_STACK_MIN if available
1.12 Sun Mar 19 17:34:49 EST 2006
- Implemented $thr1->equal($thr2) in XS
- Use $ENV{PERL_CORE} in tests
1.11 Fri Mar 17 13:24:35 EST 2006
- BUG FIX: Properly free thread's Perl interpreter
- Removed BUGS POD item regarding returning objects from threads
- Enabled closure return test in t/problems.t
- Handle deprecation of :unique in tests
- XS code cleanup
- Better POD coverage
1.09 Mon Mar 13 14:14:37 EST 2006
- Initial (re-)release to CPAN
- 64-bit TIDs
- API for thread stack size (courtesy of Dean Arnold)
- Made threads->list() context sensitive
- Implemented threads->object($tid) in XS
- Added $thr->_handle() method
Ancient history:
0.03 Mon Jul 2 12:00:50 CEST 2001
Fixed bug with threads->self() in main thread, thanks Hackworth!
0.02 Sat Jun 30 09:41:00 GMT 2001
Fixed bug in threads->self() reported by Hackworth
0.01 Tue Apr 24 19:04:12 2001
Cleaned up documentation
README 0000644 00000000742 15170351007 0005426 0 ustar 00 threads version 2.21
====================
This module exposes interpreter threads to the Perl level.
INSTALLATION
To install this module type the following:
perl Makefile.PL
make
make test
make install
DEPENDENCIES
This module needs perl 5.8.0 or later compiled with 'useithreads'.
COPYRIGHT AND LICENCE
Copyright (C) 2001 Artur Bergman <sky AT crucially DOT net>
Same licence as Perl.
CPAN version produced by Jerry D. Hedden <jdhedden AT cpan DOT org>
# EOF