I want to use threads in loops. The way I want to use this is that start threads in a loop and wait for them to finish. Once all threads are finished then sleep for some predefined number of time and then start those threads again.
Actually I want to run these threads once every hour and that is why I am using sleep. Also I know that hourly run can be done via cron but I can't do that so I am using sleep.
I am getting this error when I am trying to run my code:
Thread already joined at ex.pl line 33.
Perl exited with active threads:
5 running and unjoined
0 finished and unjoined
0 running and detached
This is my code:
use strict;
use warnings;
use threads;
use Thread::Queue;
my $queue = Thread::Queue->new();
my #threads_arr;
sub main {
$queue->enqueue($_) for 1 .. 5;
$queue->enqueue(undef) for 1 .. 5;
}
sub thread_body {
while ( my $num = $queue->dequeue() ) {
print "$num is popped by " . threads->tid . " \n";
sleep(5);
}
}
while (1) {
my $main_thread = threads->new( \&main );
push #threads_arr, threads->create( \&thread_body ) for 1 .. 5;
$main_thread->join();
foreach my $x (#threads_arr) {
$x->join();
}
sleep(1);
print "sleep \n";
}
Also I am able to see other questions similar to this but I am not able to get any of them.
Your #threads_arr array never gets cleared after you join the first 5 threads. The old (already joined) threads still exist in the array the second time around the loop, so Perl throws the "Thread already joined" error when attempting to join them. Clearing or locally initializing #threads_arr every time around the loop will fix the problem.
#threads_arr=(); # Reinitialize the array
push #threads_arr, threads->create( \&thread_body ) for 1 .. 5;
Related
My script should have n subroutines (my_proc) to run simultaneously, each of them runs bash script and one sub (check_procs) checks if subs has finished.
use strict;
use threads;
use threads::shared;
my %proc_status :shared;
my %thr;
foreach my $i (1,2,3,4) {
$proc_status{$i}=0;
}
sub my_proc {
my $arg=shift(#_);
while (1) {
sleep(2);
print "Proc $arg Started\n";
#exec("/bin/bash","sleep_for_10_sec.bash") or die("Can't exec"); # case 1
#`sleep_for_10_sec.bash &`; # case 2
print "Proc $arg Finished\n";
{
lock(%proc_status);
$proc_status{$arg}=1;
}
}
}
sub check_procs {
my $all_finished;
while (! $all_finished) {
sleep 5;
print "CHECK: \n";
$all_finished=1;
foreach my $num (1,2,3,4) {
if ($proc_status{$num} == 1) {
print "CHECK: procedure $num has finished\n";
} else {
$all_finished=0;
}
}
}
print "All jobs finished\n";
}
foreach my $num (1,2,3,4) {
$thr{"$num"} = new threads \&my_proc,$num;
}
my $thr_check= new threads \&check_procs;
$thr_check->join();
And here are the sleep_for_10_sec.bash
ls
# bunch of other stuff
sleep 10
echo "finished sleep"
I don't want my_proc subs to wait "sleep_for_10_sec.bash" command to be executed, after browsing I have found that either #case1 or #case2 should work, but they both fail.
the output of #case1:
Proc 1 Started
[ls result]
finsihed sleep
the output of #case2:
Proc 1 Started
Proc 2 Started
Proc 3 Started
Proc 4 Started
CHECK:
CHECK:
Proc 4 Finished
Proc 2 Finished
Proc 3 Finished
Proc 1 Finished
Proc 3 Started
Proc 1 Started
Proc 2 Started
Proc 4 Started
CHECK:
CHECK: procedure 1 has finished
CHECK: procedure 2 has finished
CHECK: procedure 3 has finished
CHECK: procedure 4 has finished
But I expect something like this :
Proc 1 Started
Proc 2 Started
Proc 3 Started
Proc 4 Started
Proc 1 Finished
Proc 1 Started
Proc 3 Finished
Proc 3 Started
Proc 4 Finished
Proc 4 Started
Proc 2 Finished
Proc 2 Started
CHECK:
CHECK:
CHECK:
CHECK: procedure 1 has finished
CHECK: procedure 2 has finished
CHECK: procedure 3 has finished
CHECK: procedure 4 has finished
Actually I get wanted result in case of redirecting output to " > log", but anyway after:
Proc 1 Started
Proc 2 Started
Proc 3 Started
Proc 4 Started
it waits "sleep_for_10_sec.bash" to finish.
This is my first project where I use "thread" and "exec", could someone help me on this ?
exec shouldn't be combined with threads. exec launches a new program within the current process, so when you call exec from one thread, the program the threads were executing disappears. Since the threads would have no program to execute, exec kills the threads as well.
It's not clear to me why case 2 doesn't work (edit: see ikegami's comment below). I would think it would launch the process, run it in the background, and allow the Perl thread to immediately continue. It doesn't seem to do that, but this code will:
system("/bin/bash sleep_for_10_sec.bash &"); # case 3
exec("/bin/bash","sleep_for_10_sec.bash") or die("Can't exec"); # case 1
exec replaces the program running in the current process with another program. At the same time, the existing threads are terminated (since the program they want to execute is no longer there), replaced with a single thread executing the new program.
This means that exec never returns (except on error). Threads or no threads, exec is not what you want, because you don't want your program to stop running.
But I expect something like this:
Are you sure you want to launch sleep_for_10_sec.bash 4 times every two seconds (meaning you can have up to 20 of them running at a time) as your desired output indicates?
Are you sure you don't care if sleep_for_10_sec.bash completes or not as your desired output indicates?
If so, why are you using threads at all? You could simply use the following:
sub start {
my $num = shift;
say "Proc $num Started";
system('bash -c sleep_for_10_sec.bash &');
say "Proc $num Finished";
}
for my $pass (1..2) {
start($_) for 1..4;
sleep 2;
start($_) for 1..4;
sleep 2;
start($_) for 1..4;
sleep 1;
if ($pass == 1) {
say "CHECK:";
} else {
say "CHECK: procedure $_ has finished" for 1..4;
}
}
I think you want
use threads;
use Thread::Queue qw( ); # 3.01+
use constant NUM_WORKERS => 4;
sub worker {
my $num = shift;
say "Job $num Started\n";
system("sleep_for_10_sec.bash"); # Make sure starts with #! and is executable.
say "Job $num Finished\n";
}
{
my $q = Thread::Queue->new();
for (1..NUM_WORKERS) {
while (defined( my $job = $q->dequeue() )) {
worker($job);
}
}
$q->enqueue(1..4, 1..4);
$q->end();
$_->join() for threads->list;
}
I just passed over from php to perl due to my company's request so even if this may be a silly question is kind of nerve wreaking right now.
I have one little perl script deployed on a server through a debian package. I have this all figured out so that's all cool.
Now this script is called from another server through an SSH connection and the script logs back to that server all its actions. I use Log::Log4perl for that.
One of the tasks takes a very long time and also runs some other scripts in the process. The ssh connection has a set timeout of 5 minutes unless I log something back. So I figured out I would create a child process to run the task and let the parent process log back every 90 (or whatever) seconds. My issue is that I don't want to use sleep because if the task is finished sooner it will mess up the log.
I have also tried using Time, Time::HiRes and alarm, but they all mess up my log one way or another.
This is my code:
$log->info("uid $uid: calling the configure script for operation $mode,on $dst_path");
my $pid = fork();
die "Could not fork\n" if not defined $pid;
if ( $pid == 0 ) {
configure( $script_dir, $mode, $node, $uid, $gid); # this also uses a parallel process in its execution, but we don't have a non blocking wait
}
while ( !waitpid( $pid, WNOHANG ) ) {
sleep(90);
if ( !$pid ) {
$log->info("Still waiting for the process to finish"); # this should come up every 90 seconds of so
}
}
$log->info("uid $uid: configure script executed"); # this should come up only once, now I get it every 90 seconds
# do other stuff here after the execution of the configure sub is done
Unfortunately I inherited this architecture as it is and cannot change it because there are a lot of services based on it.
If you don't want to sleep, you can call select with a timeout. To implement this reliably, you can employ the self-pipe trick which involves creating a pipe, writing to the pipe in a SIGCHLD handler, and making the select call wait on the pipe's read handle.
Here's a simple example:
#!/usr/bin/perl
use strict;
use warnings;
use Errno qw(EINTR);
use Fcntl qw(F_GETFL F_SETFL O_NONBLOCK);
use Symbol qw(gensym);
sub make_non_blocking {
my $handle = shift;
my $flags = fcntl($handle, F_GETFL, 0)
or die("F_GETFL: $!");
fcntl($handle, F_SETFL, $flags | O_NONBLOCK)
or die("F_SETFL: $!");
}
my ($read_handle, $write_handle) = (gensym, gensym);
pipe($read_handle, $write_handle)
or die("pipe: $!");
make_non_blocking($read_handle);
make_non_blocking($write_handle);
local $SIG{CHLD} = sub {
syswrite($write_handle, "\0", 1);
};
my $pid = fork();
die("fork: $!") if !defined($pid);
if ($pid == 0) {
sleep(10);
exit;
}
my $rin = '';
vec($rin, fileno($read_handle), 1) = 1;
while (1) {
my $nfound = select(my $rout = $rin, undef, undef, 2);
if ($nfound < 0) {
# Error. Must restart the select call on EINTR.
die("select: $!") if $! != EINTR;
}
elsif ($nfound == 0) {
# Timeout.
print("still running...\n");
}
else {
# Child exited and pipe was written to.
last;
}
}
waitpid($pid, 0);
close($read_handle);
close($write_handle);
I tried to run the code and noticed a few things that may be your issue, but without knowing what configure does, I can't be sure. Here's what I found:
The child process doesn't exit after calling configure
waitpid does not change the value of $pid, so $pid is always 0 in the child and always the pid of the child in the parent.
What this means is that the parent is never writing out "Still waiting for the process to finish", the child is writing it out every 90 seconds after it completes it's call to configure.
Additionally, the child should print that message ever 90 seconds forever because it's waiting for pid 0 to send it the CHLD signal which won't happen because it doesn't have a child with pid 0.
I updated your code with a few stubs that does what I think you want (on a slightly tighter timeline because I don't like to wait :) ). My code makes the following assumptions that you may wish to change:
Log the waiting message every second
The child always exits with a status value of 0
Here's my code:
#!/usr/bin/env perl
use strict;
use warnings;
use Log::Log4perl qw(:easy);
use POSIX qw(:sys_wait_h);
Log::Log4perl->easy_init();
my ($uid,$mode,$dst_path,$script_dir,$node,$gid) = (0..5);
my $log = get_logger();
$log->info("uid $uid: calling the configure script for operation $mode,on $dst_path");
my $pid = fork();
die "Could not fork\n" if not defined $pid;
if ( $pid == 0 ) {
configure( $script_dir, $mode, $node, $uid, $gid); # this also uses a parallel process in its execution, but we don't have a non blocking wait
exit(0);
}
my $zombie;
while ( ($zombie = waitpid( $pid, WNOHANG ) ) != $pid) {
$log->info("Still waiting for the process to finish"); # this should come up every 90 seconds of so
sleep(1);
}
$log->info("uid $uid: configure script executed"); # this should come up only once, now I get it every 90 seconds
# do other stuff here after the execution of the configure sub is done
sub configure {
sleep 10;
}
I am using Thread::Queue to push an array onto a queue and process each element of it using threads. Below is a simplified version of my program to demonstrate what is happening.
#!/usr/bin/perl
use strict;
use warnings;
use threads;
use threads::shared;
use Thread::Queue;
# Define queue
my $QUEUE :shared = new Thread::Queue();
# Define values
my #values = qw(string1 string2 string3);
# Enqueue values
$QUEUE->enqueue(#values);
# Get thread limit
my $QUEUE_SIZE = $QUEUE->pending();
my $thread_limit = $QUEUE_SIZE;
# Create threads
for my $i (1 .. $thread_limit) {
my $thread = threads->create(\&work);
}
# Join threads
my $i = 0;
for my $thread (threads->list()) {
$thread->join();
}
print "COMPLETE\n";
# Thread work function
sub work {
while (my $value = $QUEUE->dequeue()) {
print "VALUE: $value\n";
sleep(5);
print "Finished sleeping\n";
}
print "Got out of loop\n";
}
When I run this code I get the following output and then it just hangs forever:
VALUE: string1
VALUE: string2
VALUE: string3
Finished sleeping
Finished sleeping
Finished sleeping
Once the queue reaches its end, the while loop should break and the script should continue but it doesn't appear to ever get out of the loop.
Why is this getting stuck?
Since you never call $QUEUE->end(), your threads are blocking on dequeue() waiting for more entries to appear.
So, ensure you do call $QUEUE->end() after the last call to enqueue, or before joining the threads.
I am trying to get text of two large files. To speed it up i tried threads.
Before i used threads the script worked, now it does not.
The problem is: I save everything I read in the file into a hash.
When i print out the size (or keys/values) after the read-in in the sub (which the thread executed) it shows a correct number > 0, when i print out the size of the hash anywhere else (after the threads have run) it shows me 0.
print ": ".keys(%c);
is used 2 times, and has different output each time.
(In the final programm 2 Threads are running and a method to compare the stuff is called after the threads finished)
Example code:
my %c;
my #threads = initThreads();
#threads[0] = threads->create(\&ce);
foreach(#threads){
$_->join();
}
print ": ".keys(%c);
sub initThreads{
my #initThreads;
for(my $i = 0; $i<2;$i++){
push(#initThreads, $i);
}
return #initThreads;
}
sub ce(){
my $id = threads->tid();
open my $file, "<", #arg1[1] or die $!;
my #cXY;
my #cDa;
while(my $line = <$file>){
# some regex and push to arrays, works
#c{#cXY} = #cDa;
}
print "Thread $id is done\n";
close $file;
print ": ".keys(%c);
threads->exit();
}
Do i have to run the things after the first 2 threads finished in another thread which waits until the first two are finished?
Or what am i doing wrong with threads?
Thanks.
%c isn't shared across your threads.
use threads;
use threads::shared
my %c :shared;
See threads::shared.
In Perl, threads don't share memory. Each thread operates on a different copy of %c, so the changes aren't reflected to the parent thread. While sharing a variable across threads is possible, this is not generally advisable.
Make use of the possibility to return data from a thread. E.g
my %c = map %{ $_->join }, #threads; # flatten all returned hashes
sub ce {
my %hash;
...;
return \%hash;
}
Some other suggestions:
use strict; use warnings; if you aren't already.
use better variable names.
you only seem to be spawning one thread (in $threads[0]).
my #array; for (my $i = 0; $i < 2; $i++){ push(#array, $i) } is equivalent to my #array = 0 .. 1.
#arg1 is not declared in the current scope.
manually exiting a thread is not neccessary in your case.
In this program I create a fork, and then call domultithreading from it. It then creates a few threads.
sub domultithreading {
#Not my function
my ($num) = #_;
my #thrs;
my $i = 0;
my $connectionsperthread = 50;
while ( $i < $num ) {
$thrs[$i] = threads->create( \&doconnections, $connectionsperthread, 1 );
$i += $connectionsperthread;
}
my #threadslist = threads->list();
while ( $#threadslist > 0 ) {
$failed = 0;
}
}
sub kill {
#how can I kill the threads made in domultithreading?
kill 9, $pid;
print "\nkilling $pid\n";
}
I then want to be able to kill the fork and its threads, however I can't figure it out. Any suggestions?
Thanks a lot
Perl provides two concurrency models: Processes and Threads. While you shouldn't neccessarily mix these two without a good reason, threads do model processes quite closely, so we can nearly treat them as such. Specifically, we can send signals to threads.
Processes can be signalled with the kill function: kill SIGNAL => $pid, while threads can be signalled with the kill method: $thr->kill(SIGNAL). This method returns the thread object. Signals can be intercepted when setting signal handlers in the %SIG hash.
This means that every process TERM signal handler TERMs all the child threads like
$_->kill(9)->join() for threads->list;
and every thread TERM signal handler simply exits the thread, or does cleaning up:
threads->exit; # exit the current thread
There are actually few different ways to kill a thread in Perl, depending on what you want to achieve.
Let's take the following code as example:
use strict;
use warnings;
use threads;
use Thread::Queue;
# Create the shared queue (used by the threads):
my $queue = Thread::Queue->new();
sub main {
# Initialise the shared queue:
$queue->enqueue("A", "B", "C", "D", "E", "F");
print "Total number of items: " . $queue->pending() . "\n";
$queue->end(); # signal that there is no more work to be sent...
# Create 3 threads:
threads->create('do') for ( 0..2 );
print "Number of current threads: " . threads->list() . "\n";
foreach my $thread ( threads->list() ) { # for each thread...
$thread->join(); # wait the thread to finish all its work...
print "Number of items in the queue: " . $queue->pending() . "\n" if defined $queue->pending();
print "Number of current threads: " . threads->list() . "\n";
}
}
sub do {
# Retrieve the current thread ID:
my $threadID = threads->self()->tid();
# Setup the thread's kill signal handler:
local $SIG{KILL} = sub { threads->exit() };
while ( defined (my $item = $queue->dequeue()) ) { # for each element in the queue...
print "(Thread-" . $threadID . "): Do something with item '$item'...\n";
sleep 1 + $threadID;
print "(Thread-" . $threadID . "): Finished to use item '$item'...\n";
}
}
main();
The code above spawns 3 threads, each of which will take and process an element of the shared queue till the queue is empty.
In this case, since we declared that no more element will be added to the queue (i.e. $queue->end()), the threads will be joined (to the main) once they had processed all the elements of the queue. Indeed, using $thread->join() we are saying to the main to wait for $thread to join.
If we omit to declare $queue->end(), the threads will not join the main but stay pending for new elements of the queue.
Now, if we want to kill the threads, we have two options: killing the threads but letting them to finish what they are doing first or simply (brutally) killing the threads immediately. In Perl, both are achieved via Thread Signalling.
In the first case (i.e. if we want to tell the threads to finish their work and, after, to stop processing the shared queue), we should use $thread->kill('KILL')->join():
foreach my $thread ( threads->list() ) { # for each thread...
$thread->kill('KILL')->join(); # wait the thread finish its work and kill it...
print "Number of items in the queue: " . $queue->pending() . "\n" if defined $queue->pending();
print "Number of current threads: " . threads->list() . "\n";
}
On the other hand, in the latter case (i.e. if we want to kill the threads immediately), we should use $thread->kill('KILL')->kill():
foreach my $thread ( threads->list() ) { # for each thread...
$thread->kill('KILL')->kill(); # kill the thread immediately...
print "Number of items in the queue: " . $queue->pending() . "\n" if defined $queue->pending();
print "Number of current threads: " . threads->list() . "\n";
}
Of course, if you want to kill the thread from within itself, you just need to call threads->exit() or simply use return:
sub do {
...
threads->exit(); # kill the thread...
...
}