There is another older Perl threading flavour called the 5.005 model,
unsurprisingly for 5.005 versions of Perl. The old model is known to
-have problems, deprecated, and will probably be removed around release
+have problems, is deprecated, and support for it will be removed in release
5.10. You are strongly encouraged to migrate any existing 5.005
threads code to the new model as soon as possible.
The simplest, most straightforward way to create a thread is with new():
- use threads;
+ use threads;
$thr = threads->new(\&sub1);
- sub sub1 {
- print "In the thread\n";
+ sub sub1 {
+ print "In the thread\n";
}
The new() method takes a reference to a subroutine and creates a new
part of the thread startup. Just include the list of parameters as
part of the C<threads::new> call, like this:
- use threads;
+ use threads;
- $Param3 = "foo";
- $thr = threads->new(\&sub1, "Param 1", "Param 2", $Param3);
- $thr = threads->new(\&sub1, @ParamList);
+ $Param3 = "foo";
+ $thr = threads->new(\&sub1, "Param 1", "Param 2", $Param3);
+ $thr = threads->new(\&sub1, @ParamList);
$thr = threads->new(\&sub1, qw(Param1 Param2 Param3));
- sub sub1 {
- my @InboundParameters = @_;
- print "In the thread\n";
- print "got parameters >", join("<>", @InboundParameters), "<\n";
+ sub sub1 {
+ my @InboundParameters = @_;
+ print "In the thread\n";
+ print "got parameters >", join("<>", @InboundParameters), "<\n";
}
for a thread to exit and extract any values it might return, you can
use the join() method:
- use threads;
+ use threads;
$thr = threads->new(\&sub1);
- @ReturnData = $thr->join;
- print "Thread returned @ReturnData";
+ @ReturnData = $thr->join;
+ print "Thread returned @ReturnData";
sub sub1 { return "Fifty-six", "foo", 2; }
it'll run until it's finished, then Perl will clean up after it
automatically.
- use threads;
+ use threads;
$thr = threads->new(\&sub1); # Spawn the thread
$thr->detach; # Now we officially don't care any more
sub sub1 {
- $a = 0;
- while (1) {
- $a++;
- print "\$a is $a\n";
- sleep 1;
- }
+ $a = 0;
+ while (1) {
+ $a++;
+ print "\$a is $a\n";
+ sleep 1;
+ }
}
Once a thread is detached, it may not be joined, and any return data
While threads bring a new set of useful tools, they also bring a
number of pitfalls. One pitfall is the race condition:
- use threads;
+ use threads;
use threads::shared;
- my $a : shared = 1;
- $thr1 = threads->new(\&sub1);
- $thr2 = threads->new(\&sub2);
+ my $a : shared = 1;
+ $thr1 = threads->new(\&sub1);
+ $thr2 = threads->new(\&sub2);
$thr1->join;
$thr2->join;
and the time you update it. Even this simple code fragment has the
possibility of error:
- use threads;
+ use threads;
my $a : shared = 2;
my $b : shared;
my $c : shared;
- my $thr1 = threads->create(sub { $b = $a; $a = $b + 1; });
+ my $thr1 = threads->create(sub { $b = $a; $a = $b + 1; });
my $thr2 = threads->create(sub { $c = $a; $a = $c + 1; });
$thr1->join;
$thr2->join;
=head2 Controlling access: lock()
-The lock() function takes a shared variable and puts a lock on it.
+The lock() function takes a shared variable and puts a lock on it.
No other thread may lock the variable until the variable is unlocked
by the thread holding the lock. Unlocking happens automatically
-when the locking thread exits the outermost block that contains
+when the locking thread exits the block that contains the call to the
C<lock()> function. Using lock() is straightforward: this example has
several threads doing some calculations in parallel, and occasionally
updating a running total:
$thr3->join;
print "total=$total\n";
-
lock() blocks the thread until the variable being locked is
available. When lock() returns, your thread can be sure that no other
-thread can lock that variable until the outermost block containing the
+thread can lock that variable until the block containing the
lock exits.
It's important to note that locks don't prevent access to the variable
in question, only lock attempts. This is in keeping with Perl's
longstanding tradition of courteous programming, and the advisory file
-locking that flock() gives you.
+locking that flock() gives you.
You may lock arrays and hashes as well as scalars. Locking an array,
though, will not block subsequent locks on array elements, just lock
} # nothing happens here
Note that there is no unlock() function - the only way to unlock a
-variable is to allow it to go out of scope.
+variable is to allow it to go out of scope.
A lock can either be used to guard the data contained within the variable
being locked, or it can be used to guard something else, like a section
without their dangers, especially when multiple locks are involved.
Consider the following code:
- use threads;
-
- my $a : shared = 4;
- my $b : shared = "foo";
- my $thr1 = threads->new(sub {
- lock($a);
- sleep 20;
- lock($b);
- });
- my $thr2 = threads->new(sub {
- lock($b);
- sleep 20;
- lock($a);
+ use threads;
+
+ my $a : shared = 4;
+ my $b : shared = "foo";
+ my $thr1 = threads->new(sub {
+ lock($a);
+ sleep 20;
+ lock($b);
+ });
+ my $thr2 = threads->new(sub {
+ lock($b);
+ sleep 20;
+ lock($a);
});
This program will probably hang until you kill it. The only way it
synchronization issues. They're pretty straightforward, and look like
this:
- use threads;
+ use threads;
use Thread::Queue;
- my $DataQueue = Thread::Queue->new;
- $thr = threads->new(sub {
- while ($DataElement = $DataQueue->dequeue) {
+ my $DataQueue = Thread::Queue->new;
+ $thr = threads->new(sub {
+ while ($DataElement = $DataQueue->dequeue) {
print "Popped $DataElement off the queue\n";
- }
- });
+ }
+ });
- $DataQueue->enqueue(12);
- $DataQueue->enqueue("A", "B", "C");
- $DataQueue->enqueue(\$thr);
- sleep 10;
+ $DataQueue->enqueue(12);
+ $DataQueue->enqueue("A", "B", "C");
+ $DataQueue->enqueue(\$thr);
+ sleep 10;
$DataQueue->enqueue(undef);
$thr->join;
gives a quick demonstration:
use threads;
- use Thread::Semaphore;
+ use Thread::Semaphore;
- my $semaphore = new Thread::Semaphore;
+ my $semaphore = new Thread::Semaphore;
my $GlobalVariable : shared = 0;
- $thr1 = new threads \&sample_sub, 1;
- $thr2 = new threads \&sample_sub, 2;
+ $thr1 = new threads \&sample_sub, 1;
+ $thr2 = new threads \&sample_sub, 2;
$thr3 = new threads \&sample_sub, 3;
- sub sample_sub {
- my $SubNumber = shift @_;
- my $TryCount = 10;
- my $LocalCopy;
- sleep 1;
- while ($TryCount--) {
- $semaphore->down;
- $LocalCopy = $GlobalVariable;
- print "$TryCount tries left for sub $SubNumber (\$GlobalVariable is $GlobalVariable)\n";
- sleep 2;
- $LocalCopy++;
- $GlobalVariable = $LocalCopy;
- $semaphore->up;
- }
+ sub sample_sub {
+ my $SubNumber = shift @_;
+ my $TryCount = 10;
+ my $LocalCopy;
+ sleep 1;
+ while ($TryCount--) {
+ $semaphore->down;
+ $LocalCopy = $GlobalVariable;
+ print "$TryCount tries left for sub $SubNumber (\$GlobalVariable is $GlobalVariable)\n";
+ sleep 2;
+ $LocalCopy++;
+ $GlobalVariable = $LocalCopy;
+ $semaphore->up;
+ }
}
$thr1->join;
Perl's threading package provides the yield() function that does
this. yield() is pretty straightforward, and works like this:
- use threads;
+ use threads;
sub loop {
- my $thread = shift;
- my $foo = 50;
- while($foo--) { print "in thread $thread\n" }
- threads->yield;
- $foo = 50;
- while($foo--) { print "in thread $thread\n" }
+ my $thread = shift;
+ my $foo = 50;
+ while($foo--) { print "in thread $thread\n" }
+ threads->yield;
+ $foo = 50;
+ while($foo--) { print "in thread $thread\n" }
}
my $thread1 = threads->new(\&loop, 'first');
=head2 Are These Threads The Same?
-The equal() method takes two thread objects and returns true
+The equal() method takes two thread objects and returns true
if the objects represent the same thread, and false if they don't.
Thread objects also have an overloaded == comparison so that you can do
that's currently running and not detached. Handy for a number of things,
including cleaning up at the end of your program:
- # Loop through all the threads
- foreach $thr (threads->list) {
- # Don't join the main thread or ourselves
- if ($thr->tid && !threads::equal($thr, threads->self)) {
- $thr->join;
- }
+ # Loop through all the threads
+ foreach $thr (threads->list) {
+ # Don't join the main thread or ourselves
+ if ($thr->tid && !threads::equal($thr, threads->self)) {
+ $thr->join;
+ }
}
If some threads have not finished running when the main Perl thread
11
12 for my $i ( 3 .. 1000 ) {
13 $stream->enqueue($i);
- 14 }
+ 14 }
15
16 $stream->enqueue(undef);
17 $kid->join;
28 print "Found prime $num\n";
29 $kid = new threads(\&check_num, $downstream, $num);
30 }
- 31 }
+ 31 }
32 $downstream->enqueue(undef) if $kid;
33 $kid->join if $kid;
34 }
projects / p5sagit/p5-mst-13.2.git / commitdiff