in reply to Perl thread/semaphore

As brother poolpi has indicated, your code is an ugly mish mosh of threads and process forking...

...assuming mean threads then the code can be reduced somewhat:

use strict ; use warnings ; use threads ; my @array = qw(a b c d e f g h); my @children; my @results; for (1..5) { for (1..2) { push @children, threads->create(\&sub_thread, @array) ; } ; while (@children) { my $child = shift(@children) ; push @results, $child->join() ; } ; } ; sub sub_thread { my (@temp) = (@_) ; my $tid = threads->tid() ; print "child $tid: @temp\n" ; sleep (2) ; return 'whatever' ; } ;
where:

If you want to have two threads on the go at the same time at all times, then you need a mechanism for each thread to signal to the parent that it has finished. One way of doing that is a queue. For example:

use strict ; use warnings ; use threads ; use Thread::Queue ; my @array = qw(a b c d e f g h); my @results; my $finished_queue = new Thread::Queue ; my $c = 2 ; # Number active at once my $n = 10 ; # Total number to dispatch my $m = $n ; # Number to collect while ($m) { while ($n && $c) { my $child = threads->create(\&sub_thread, @array) ; $n-- ; $c-- ; } ; my $tid = $finished_queue->dequeue() ; my $child = threads->object($tid) ; push @results, $child->join() ; $m-- ; $c++ ; } ; sub sub_thread { my (@temp) = (@_) ; my $tid = threads->tid() ; print "child $tid: @temp\n" ; sleep(rand(2)+2) ; $finished_queue->enqueue($tid) ; print "child $tid: finished\n" ; return "whatever from child $tid" ; } ;
noting: (a) that the order of the results is not necessarily the same as the order of dispatch (which requires some extra information related to the $tid); and (b) that even though it doesn't need the $child while it is creating each one, it does need to set scalar context !

Finally, the other way to run two threads is to start two and pass "parameters" and results back and forth using two queues... along the lines of:

use strict ; use warnings ; use threads ; use Thread::Queue ; my @array = qw(a b c d e f g h); my @results; my $param_queue = new Thread::Queue ; my $result_queue = new Thread::Queue ; my $c = 2 ; # concurrent threads my $n = 10 ; # amount of work my @children ; for (1..$c) { # Start the threads push @children, threads->create(\&sub_thread) ; } ; for (1..$n) { # Dispatch the work $param_queue->enqueue([@array]) ; } ; for (1..$n) { # Collect the results push @results, $result_queue->dequeue() ; } ; $param_queue->enqueue((undef) x $c) ; # Signal the threads to stop foreach (@children) { # Collect the terminated threads $_->join() ; } ; sub sub_thread { my $task = 0 ; my $tid = threads->tid() ; print "child $tid: started" ; while (my $p = $param_queue->dequeue()) { $task++ ; my @temp = @$p ; print "child $tid/$task: @temp\n" ; sleep(rand(2)+2) ; $result_queue->enqueue("whatever from child $tid/$task") ; print "child $tid/$task: done\n" ; } ; print "child $tid: terminated\n" ; } ;
which I hope is reasonably self explanatory.

Replies are listed 'Best First'.
Re^2: Perl thread/semaphore
by password (Beadle) on May 03, 2011 at 22:47 UTC
    Dear oshalla, thank you for your codes, it really helped me to grasp several ideas about threading in Perl. My only addition would be that's in your 1st and 2nd examples you clone the arguments (@array) in the first two cycles, meaning you're creating two threads with the same arguments: for (1..2) - in the 1st example and while ($c) - where $c=2 - in the 2nd example To fix that I used a new variable to count dispatched threads.
    #!/usr/bin/perl use strict ; use warnings ; use threads ; use Thread::Queue ; my @array = qw(a b c d e f g h); my @results; my $finished_queue = new Thread::Queue ; my $c = 5 ; # Number active at once my $n = 10 ; # Total number to dispatch my $m = $n ; # Number to collect my $d = 0; #count created threads while ($n) { while ($m) { $d++; my $child = threads->create(\&sub_thread, @array) ; my $tid;my $childa; if ($d == $c) { $tid = $finished_queue->dequeue() ; $childa = threads->object($tid) ; push @results, $childa->join() ; $d--; $n--; } $m-- ; } if (!$m) { my $tid = $finished_queue->dequeue() ; my $childa = threads->object($tid) ; push @results, $childa->join() ; $n--; } } sub sub_thread { my (@temp) = (@_) ; my $tid = threads->tid() ; print "child $tid: @temp\n" ; sleep(rand(2)+2) ; $finished_queue->enqueue($tid) ; print "child $tid: finished\n" ; return "whatever from child $tid" ; } ; exit;
    It's not elegant, but it works and all I needed was a quick fix. P.S. It's an old thread, but it was the most useful for me just now, so I'd rather share the solution in this old thread.