I use the regular Parallel::ForkManager module in Perl. I execute around 10 children processes. 'passes_thresholds' function takes few milliseconds or nanoseconds (checked it). In case I run all processes one by one (without Parallel::ForkManager) the whole process took 80-250 milliseconds. In case I run them as parallel, the whole process takes at least 1 second. I found that the Fork spends 1 second to start the 'finish' function. I put a timer when the child process finished his job and should go to 'finish'- function. One second is too much for my development.
sub parallel_execute {
my $this = shift;
foreach my $a (#a_array) {
my $pid = $this->{fork_manager}->start and next;
my $res = $a->passes_thresholds();
$a->{timer} = Benchmark::Timer->new();
$svc->{timer}->start;
$this->{fork_manager}->finish(0,{a => $a, plugin_result => $res});
}
}
$this->{fork_manager}->run_on_finish( sub {
my ($pid, $exit_code, $ident, $exit_signal, $core_dump, $data_structure_reference) = #_;
my $a = $data_structure_reference->{a};
if (exists $a->{timer}) {
$a->{timer}->stop;
debug "took: " . $a->{timer}->report;
}
});
Do you have any idea why it took at least 1 second to start the 'finish' command?
(I am using Unix server, and perl 5.10)
Thanks you all, i found the problem. ForManager module has 'waitpid_blocking_sleep' parameter, which defined as 1 second by default. There is a function called 'set_waitpid_blocking_sleep' which we can defined this parameter (sleep time). We can set zero or fraction of seconds. I set this paramter to zero and it fixed my issue.
The on_finish callback is only called when P::FM reaps a child, and P::FM only reaps a child under three conditions:
When $pm->start is called and the number of children that have been started but not reaped is equal to the maximum.
When $pm->reap_finished_children is called.
When $pm->wait_all_children is called.
There could be an arbitrarily long delay between a child exiting and one the above events. Adding the following to your program should eliminate that delay:
$SIG{CHLD} = sub { $pm->reap_finished_children };
By the way, if the work performed by your child only takes "a few milliseconds or nanoseconds", you are actually slowing things down by using P::FM. Data passed to finish gets serialized and written to disk, then read from the disk and deserialized for the on_finish callback!
Related
I have this loop:
foreach my $element ( #array ) {
my $result = doSomething($element);
}
Since it doesn't matter that the array is processed in order, and the script runs long, I'd like run doSomething() asynchronously.
I am looking at IO::Async for this, but I can't seem to find an example where the input to the loop is a simple array as above. The example seem to focus on open sockets, STDIN, etc.
Here is the example given, showing feeding data to the loop via STDIN:
$loop->add( IO::Async::Stream->new_for_stdin(
on_read => sub {
my ( $self, $buffref, $eof ) = #_;
while( $$buffref =~ s/^(.*)\n// ) {
print "You typed a line $1\n";
}
return 0;
},
) );
How can I feed it the array elements instead?
As commented by #StefanBecker, the simplest way to handle this with IO::Async is by using an IO::Async::Function.
From the docs :
This subclass of IO::Async::Notifier wraps a function body in a collection of worker processes, to allow it to execute independently of the main process.
In the IO::Async framework, the typical use case for IO::Async::Function is when a blocking process needs to be executed asynchronously.
Disclaimer : please note that, as commented also by #zdim, IO::Async might not be the best fit for your use case. A pure process parallelizer such as Parallel::ForkManager would probably be your best option here, as it basically implements the same functionality (forking and executing in parallel), yet in a much more straight-forward fashion. One of the main differentiating factor of IO::Async comes with its I/O multiplexing capabilities, that you are seemingly not using here.
But since you namely asked for IO::Async, here is an example of such implementation : I turned doSomething into a dummy method that just waits the amount of time given as argument. This allows you to observe the effect of asynchronous execution.
use strict;
use warnings;
use IO::Async::Function;
use IO::Async::Loop;
use Future;
# dummy sub
sub doSomething {
my ( $delay ) = #_;
print "start waiting $delay second(s)\n";
sleep $delay;
print "done sleeping $delay second(s)\n";
return $delay;
}
# prepare the function for execution
my $loop = IO::Async::Loop->new;
my $function = IO::Async::Function->new( code => sub { return doSomething($_[0]) } );
$loop->add($function);
# trigger asynchronous processing
my #array = qw/5 2 4 0/;
my #futures = map { $function->call( args => [ $_ ] ) } #array;
# safely wait for all ops to complete
Future->wait_all(#futures)->await;
print "all done !\n";
This yields :
start waiting 5 second(s)
start waiting 2 second(s)
start waiting 4 second(s)
start waiting 0 second(s)
done sleeping 0 second(s)
done sleeping 2 second(s)
done sleeping 4 second(s)
done sleeping 5 second(s)
all done !
NB1 : Future->wait_all(#futures)->await could also be written $_->get for #futures, however the first expression, that uses convergent Futures, has the advantages that it will never fail, even if an underlying call actually dies.
NB2 : many options are available in IO::Async::Function and Future to handle errors, manage the number of workers and their behavior, and so on. Check out the docs for more details...
My query:
In the following code i had tried to bring the print $commandoutput[0] to be shifted or passed into the upcoming subroutine.i tried the shift to pass it.But i failed with it.Can you please help me the right way to follow?
Code:
my $max_forks = 4;
#createThreads();
my %commandData;
my #arr = (
'bhappy', 'bload -m all -l -res CPUSTEAL',
'bqueues', 'bjobs -u all -l -hfreq 101'
);
#print #arr;
my $fork = new Parallel::ForkManager($max_forks);
$fork->run_on_start(
sub {
my $pid = shift;
}
);
$fork->run_on_finish(
sub {
my ( $pid, $exit, $ident, $signal, $core ) = #_;
if ($core) {
print "PID $pid core dumped.\n";
}
else { }
}
);
my #Commandoutput;
my $commandposition = 0;
for my $command (#arr) {
$fork->start and next;
my #var = split( " ", $command );
$commandoutput[$commandposition] = `$command`;
$commandposition++;
$line = $commandoutput[0];
# print $line;
$fork->finish;
}
$fork->wait_all_children;
#print Dumper(\%commandData);
print $commandoutput[0];
Here i had tried to store the print $commandoutput[0] in the variable inside the subroutine.I gated here how to pass the variables from outside to inside the subroutine.
sub gen_help_data
{
my $lines=shift;
print $lines;
}
I think you're misunderstanding what a fork does. When you successfully fork, you're creating a subprocess, independent from the process you started with, to continue doing work. Because it's a separate process, it has its own memory, variables, etc., even though some of these started out as copies from the parent process.
So you're setting $commandoutput[0] in each subprocess, but then, when that subprocess dies, so does the content of its copy of #commandoutput.
You can either run each command serially, or you can use threads (which comes with a host of other issues - your code would need some significant redesign to work even with threads), or you can use events (POE, AnyEvent, etc., and this will be another significant redesign). Or you could run each command with its output put into temporary files, then, once all the children are done, read each file and continue. This also comes with issues, but generally fewer issues than the others.
The code between start and finish runs in a separate process and the child and parent cannot write to each other's variables (even if with the same name). Forking creates an independent process with its own memory and data.† To pass data between these processes we need to use an "Inter-Process-Communication" (IPC) mechanism.
This module does provide a ready and simple way to pass data back from a child to the parent.
See Retrieving data structures from child processes in docs.
You first need to supply to finish a reference to the data structure that the child wants to return. In your case, you want to return a scalar $commandoutput[0] so do
$fork->finish(0, \$commandoutput[0]);
This reference is then found in the callback as the last, sixth, parameter. The one your code left out. So in the callback you need
my %ret_data; # to store data from different child processes
$pm->run_on_finish(
sub {
my ($pid, $exit, $ident, $signal, $core, $dataref) = #_;
$ret_data{$pid} = $dataref;
}
);
Here $dataref is \$commandoutput[0], which is stored in %ret_data as the value for the key which is the process id. So after the foreach completes you can find all data in %ret_data
foreach my $pid (keys %ret_data) {
say "Data from $pid => ${$ret_data{$pid}}";
}
Here we dereference $ret_data{$pid} as a scalar reference, since your code returns that.
Note that the data is passed by writing out files and that can be slow if a lot is going on.
Here is a full example, where each child returns an array reference, by passing it tofinish, which is then retrieved in the callback. For a different example see this post.
use warnings;
use strict;
use feature 'say';
use Parallel::ForkManager;
my $pm = Parallel::ForkManager->new(4);
my %ret_data;
$pm->run_on_finish( sub {
my ($pid, $exit, $ident, $signal, $core, $dataref) = #_;
$ret_data{$pid} = $dataref;
});
foreach my $i (1..8)
{
$pm->start and next;
my $ref = run_job($i);
$pm->finish(0, $ref);
}
$pm->wait_all_children;
foreach my $pid (keys %ret_data) {
say "$pid returned: #{$ret_data{$pid}}";
}
sub run_job {
my ($i) = #_;
return [ 1..$i ]; # make up return data: arrayref with list 1..$i
}
Prints
15037 returned: 1 2 3 4 5 6 7
15031 returned: 1 2
15033 returned: 1 2 3 4
15036 returned: 1 2 3 4 5 6
15035 returned: 1 2 3 4 5
15038 returned: 1 2 3 4 5 6 7 8
15032 returned: 1 2 3
15030 returned: 1
† On modern systems as little data is copied as possible as a new process is forked, for performance reasons. So variables that a child "inherits" by forking aren't actually copies and thus the child does in fact read parent's variables that existed when it was forked.
However, any data that a child writes in memory is inaccessible to the parent (and what parent writes after forking is unknown to the child). If that data is written to a variable "inherited" from a parent at forking then a data copy happens so that the child's new data is independent.
There are certainly subtleties and complexities in how data is managed, with apparently a number of pointers maintained even as data changes in the child. I'd guess that this is mostly to simplify data management, and to reduce copying; there appears to be far finer granularity in data management than at a "variable" level.
But these are implementation details and in general child and parent can't poke at each other's data.
use Parallel::ForkManager;
my $number_running = 0;
my $pm = new Parallel::ForkManager(30);
$pm->run_on_start( sub { ++$number_running; } );
$pm->run_on_finish( sub { --$number_running; } );
for (my $i=0; $i<=100; $i++)
{
if ($number_running == 5) { while ($number_running > 0) {} } # waits forever
$pm->start and next;
print $i;
$pm->finish;
}
The above code uses Parallel::ForkManager to execute code in a for loop using parallel processes. It is counting how many child processes are running and setting the $number_running variable accordingly. Once 5 child processes are running, I would like it to wait until 0 child processes are running before continuing.
The first line in the for loop is designed to achieve this but it waits forever on that line. It's like the change to the variable made by the child processes is not available to that line of code. What am I doing wrong? Note: I am aware of wait_all_children but I don't want to use it.
Short The callback run_on_finish normally doesn't get triggered for every child's exit, so $number_running doesn't get reduced and thus it can't control the loop. Ways to fix this:
use reap_finished_children in order to communicate as individual children exit, so that run_on_finish indeed gets to run as each child exits
use wait_for_available_procs to wait for the whole batch to finish before starting a new set of processes
As for the title ("How to wait for child process to set variable in parent process?"), a child process cannot set anything in the parent, nor could parent in the child. They must communicate to accord actions, using some form of Inter-Process-Communication (IPC). This module provides some of that, and a few methods useful for this question are outlined above.
The callback run_on_start runs with every new process and the counter is incremented. But the callback run_on_finish is never triggered so the counter is never decremented. Thus once it reaches 5 the code sits in the while loop. Note that a parent and children are separate processes which thus don't know about each other's variables and cannot change them.
The callback run_on_finish is commonly triggered by having wait_all_children after all processes were forked. Its job is also done
when maximum number of processes run and one exits. This is done in start by a call to wait_one_child (which calls on_finish, see below).
Or, this can be done at will by calling reap_finished_children method
This is a non-blocking call to reap children and execute callbacks independent of calls tostart or wait_all_children. Use this in scenarios where start is called infrequently but you would like the callbacks executed quickly.
This resolves the main concern of how to communicate as individual children exit (as clarified in comments), and not by wait_all_children.
Here is an example of how to use it so that the callback runs right as a child exits. A good deal of the code is merely for diagnostics (prints).
use warnings;
use strict;
use feature 'say';
use Parallel::ForkManager;
$| = 1;
my $total_to_process = 3; # only a few for this test
my $number_running = 0;
my #ds;
my $pm = Parallel::ForkManager->new(30);
$pm->run_on_start( sub {
++$number_running;
say "Started $_[0], total: $number_running";
});
$pm->run_on_finish( sub {
--$number_running;
my ($pid, $code, $iden, $sig, $dump, $rdata) = #_;
push #ds, "gone-$pid";
say "Cleared $pid, ", ($rdata->[0] // ''), ($code ? " exit $code" : '');
});
foreach my $i (1 .. $total_to_process)
{
$pm->start and next;
run_job($i);
$pm->finish(10*$i, [ "kid #$i" ]);
}
say "Running: ", map { "$_ " } $pm->running_procs; # pid's of children
# Reap right as each process exits, retrieve and print info
my $curr = $pm->running_procs;
while ($pm->running_procs)
{
$pm->reap_finished_children; # may be fewer now
if ($pm->running_procs < $curr) {
$curr = $pm->running_procs;
say "Remains: $number_running. Data: #ds";
}
sleep 1; # or use Time::HiRes::sleep 0.1;
}
sub run_job {
my ($num) = #_;
my $sleep_time = ($num == 1) ? 1 : ($num == 2 ? 10 : 20);
sleep $sleep_time;
say "\tKid #$num slept for $sleep_time, exiting";
}
Use of this method is equivalent to calling waitpid -1, POSIX::WNOHANG in a loop after fork. This forks fewer than the max (30) processes to see output more easily and demonstrate that the callback runs right as a child exits. Change these numbers to see its full operation.
A child process exits with 10*$i, so to be able to track children processes in the output. The data returned in an anonymous array [...] is a string identifying the child process. As soon as the reap_finished_children call completes the $number_running is reduced, in the callback. This is the reason for having the $curr variable, again for diagnostics.
This prints
start: Started 4656, running: 1
start: Started 4657, running: 2
start: Started 4658, running: 3
Running: 4656 4658 4657
Kid #1 slept for 1, exiting
Cleared 4656, kid #1 exit 10
Remains: 2. Data: gone-4656
Kid #2 slept for 10, exiting
Cleared 4657, kid #2 exit 20
Remains: 1. Data: gone-4656 gone-4657
Kid #3 slept for 20, exiting
Cleared 4658, kid #3 exit 30
Remains: 0. Data: gone-4656 gone-4657 gone-4658
The direct question is of how to wait for the whole batch to finish before starting a new one. This can be done directly by wait_for_available_procs($n)
Wait until $n available process slots are available. If $n is not given, defaults to 1.
If $MAX is used for $n, that many slots will become available only once the whole batch completed. What to use for $n can also be decided at runtime.
Some details of module's operation
When a child exits the SIGCHLD signal is sent to the parent, which it must catch in order to know that the child is gone (and to avoid zombies, in the first place). This is done by using wait or waitpid, in code or in the SIGCHLD handler (but only at one place). See fork, Signals in perlipc, waitpid and wait.
We see from P::FM's source that this is done in wait_one_child (via _waitpid sub)
sub wait_one_child { my ($s,$par)=#_;
my $kid;
while (1) {
$kid = $s->_waitpid(-1,$par||=0);
last if $kid == 0 || $kid == -1; # AS 5.6/Win32 returns negative PIDs
redo if !exists $s->{processes}->{$kid};
my $id = delete $s->{processes}->{$kid};
$s->on_finish( $kid, $? >> 8 , $id, $? & 0x7f, $? & 0x80 ? 1 : 0);
last;
}
$kid;
};
which is used in wait_all_children
sub wait_all_children { my ($s)=#_;
while (keys %{ $s->{processes} }) {
$s->on_wait;
$s->wait_one_child(defined $s->{on_wait_period} ? &WNOHANG : undef);
};
}
The method reap_finished_children used above is a synonym for this method.
The method wait_one_child that gets the signal is used by start to reap child processes when maximum number of processes is filled and one exits. This is how the module knows when it can start another process and respect its maximum. (It is also used by a few other routines that wait for processes.
). And this is when run_on_finish gets triggered, by $s->on_finish( $kid, ... )
sub on_finish {
my ($s,$pid,#par)=#_;
my $code=$s->{on_finish}->{$pid} || $s->{on_finish}->{0} or return 0;
$code->($pid,#par);
};
The callback is in the coderef $code, retrieved from the object's on_finish key, which itself is set in the sub run_on_finish. This is how the callback is set up, once that sub runs.
The methods availed to the user for this are wait_all_children and reap_finished_children.
Since none of this is used in the posted code the $number_running is not getting updated so while is an infinite loop. Recall that the variable $number_running in the parent cannot be directly changed by child processes.
I am executing a script and have forked it to run parallel.
I notice that some of the processes take more time to execute and want to keep a track of each process when it started and ended.
Right now, I am printing the time to the terminal while executing but its not easy to determine which process is taking time to execute.
Is there a way to track it while using Perl Parallel:ForkManager?
It is unclear whether you are looking for real-time feedback on the processes that are running or whether you are just looking to understand if one child took longer at the end. Assuming you just want to know a final result, the following will suffice:
Use Benchmark, and the run_on_finish callback of Parallel::ForkManager. Something like this may work for you. We store the start time of the forked process when we fork it. When the child exits, Parallel::ForkManager will call the run_on_finish callback with the pid that exited. You can then store the end time of the child and then calculate the differences with Benchmark.
use Benchmark;
use Parallel::ForkManager;
my $max_forks = 5;
my $mgr = Parallel::ForkManager->new( $max_forks );
my %times;
$mgr->run_on_finish(sub {
my $pid = shift;
$times{$pid}->[1] = Benchmark->new; # end time mark
});
for ( 1 .. $max_forks+1 ) { # N+1 to show that wait time isn't included.
if (my $pid = $mgr->start) { # Parent
$times{$pid} = [Benchmark->new, undef]; #start time
next;
}
srand(time^$$); # don't do this in real-world, perldoc srand
my $sleep = int(rand(9));
say "$$ sleeping $sleep";
sleep ($sleep);
$mgr->finish;
}
$mgr->wait_all_children;
foreach my $pid (keys %times) {
say "Pid: $pid, ProcessTime: ", timestr(timediff($times{$pid}->[1], $times{$pid}->[0]));
}
Please refer to Benchmark perldocs for details on the output you can calculate and further functions.
- Mike
I need to create a program that would run 3 processes at the same time in random sequence from a list and lock those processes with semaphore one by one so to avoid duplicates.
For example, you have a list of 3 programs:
#array = ( 1,2,3);
perl script.pl runs 2 at first;
By random tries to run 2 again and receives an error (because 2 is now locked with semaphore).
Runs 1.
Runs 3.
script.pl waits all of 1,2,3 to end work and then exit itself.
Here's my code so far:
#!/usr/bin/perl -w
use IPC::SysV qw(IPC_PRIVATE S_IRUSR S_IWUSR IPC_CREAT);
use IPC::Semaphore;
use Carp ();
print "Program started\n";
sub sem {
#semaphore lock code here
}
sub chooseProgram{
#initialise;
my $program1 = "./program1.pl";
my $program2 = "./program2.pl";
my $program3 = "./program3.pl";
my $ls = "ls";
my #programs = ( $ls, $program1, $program2, $program3 );
my $random = $programs[int rand($#programs+1)];
print $random."\n";
return $random;
}
#parent should fork child;
#child should run random processes;
#avoid process clones with semaphore;
sub main{
my $pid = fork();
if ($pid){
#parent here
}
elsif (defined($pid)){
#child here
print "$$ Child started:\n";
#simple cycle to launch and lock programs
for (my $i = 0; $i<10; $i++){
# semLock(system(chooseProgram()); #run in new terminal window
# so launched programs are locked and cannot be launched again
}
}
else {
die("Cannot fork: $!\n");
}
waitpid($pid, 0);
my $status = $?;
#print $status."\n";
}
main();
exit 0;
Problems:
Need to lock file; (I don't know how to work with semaphore. Failed some attempts to lock files so excluded that code.)
Child waits until first program ends before second start. How can I start three of programs at the same time with one child? (Is it possible or should I create one child for one program?).
Programs are non-gui and should run in terminal. How to run a program in new terminal window(tab)?
No correct check if all programs of #programs were launched yet. -- less important.
Your randomness requirement is very strange, but if I understood your requirements correctly, you don't need any sort of locking to do what you want. (So 1) in your question is gone)
Start by shuffling the program array, then start each command of that shuffled array (this deals with your 4)). Then only waitpid after you've started everything (which deals with your 2)).
The code below does that, starting various sleep instances in new terminals (I use urxvt, adapt depending on what terminal you want to spawn - this deals with your 3)).
#! /usr/bin/perl -w
use strict;
use warnings;
my #progs = ("urxvt -e sleep 5", "urxvt -e sleep 2", "urxvt -e sleep 1");
my #sgrop;
my #pids;
# Shuffle the programs
while (my $cnt = scalar(#progs)) {
push #sgrop, splice #progs, int(rand($cnt)), 1;
}
# Start the progs
foreach my $prog (#sgrop) {
my $pid = fork();
if (!$pid) {
exec($prog);
# exec does not return
} else {
print "Started '$prog' with pid $pid\n";
push #pids, $pid;
}
}
# Wait for them
map {
waitpid($_, 0);
print "$_ done!\n";
} (#pids);
Not sure the shuffling is the best out there, but it works. The idea behind it is just to pick one element at random from the initial (sorted) list, remove it from the there and add it to the shuffled one. Repeat until the initial list is empty.
If you're trying to lock the programs system wide (i.e. no other process in your system should be able to start them), then I'm sorry but that's not possible unless the programs protect themselves from concurrent execution.
If your question was about semaphores, then I'm sorry I missed your point. The IPC documentation has sample code for that. I don't really think it's necessary to go to that complexity for what you're trying to do though.
Here's how you could go about it using the IPC::Semaphore module for convenience.
At the start of your main, create a semaphore set with as many semaphores as required:
use IPC::SysV qw(S_IRUSR S_IWUSR IPC_CREAT IPC_NOWAIT);
use IPC::Semaphore;
my $numprocs = scalar(#progs);
my $sem = IPC::Semaphore->new(1234, # this random number is the semaphore key. Use something else
$numprocs, # number of semaphores you want under that key
S_IRUSR | S_IWUSR | IPC_CREAT);
Check for errors, then initialize all the semaphores to 1.
$sem->setall( (1) x $numprocs) || die "can't set sems $!";
In the code that starts your processes, before you start (after the fork though), try to grab the semaphore:
if ($sem->op($proc_number, -1, IPC_NOWAIT)) {
# here, you got the semaphore - so nothing else is running this program
# run the code
# and once the code is done:
$sem->op($proc_number, 1, 0); # release the semaphore
exit(0);
} else {
# someone else is running this program already
exit(1); # or something
}
In the above, $proc_number must be unique for each program (could be it's index in your programs array for instance). Don't use exec to start the program. Use system instead for example.
Note that you will have to deal with the exit code of the child process in this case. If the exit code is zero, you can mark that program as having run. If not, you need to retry. (This is going to get messy, you'll need to track which program was run or not. I'd suggest a hash with the program number ($proc_number) where you'd store whether it already completed or not, and the current pid running (or trying to run) that code. You can use that hash to figure out what program still needs to be executed.)
Finally after all is done and you've waited for all the children, you should clean up after yourself:
$sem->remove;
This code lacks proper error checking, will work strangely (i.e. not well at all) if the cleanup was not done correctly (i.e. semaphores are already laying around when the code starts). But it should get you started.