I have a Perl script that needs to kick off another process in the background and exit without waiting for the other script to finish. There are lots of threads on StackOverflow that cover how to wait in Perl or how to not wait for other programming languages, but I can't seem to find the right answer for Perl.
I've read up quite a bit and thought I was doing the right things but none of my attempts seem to be working correctly. Here are all the variations I've tried so far to no avail:
system(qq|perl /util/script.pl $id|);
system(qq|perl /util/script.pl $id &|);
exec(qq|perl /util/script.pl $id|);
exec(qq|perl /util/script.pl $id &|);
With each of these the parent process continues to wait for the child to finish before exiting. Please let me know what I'm doing wrong and the right way to fork the background process.
Thanks in advance for your help!
Full code to help with debugging. Note that the API->Function() calls are object oriented modules our code base uses for specific functions that database interactions, etc:
sub Add {
my $self = shift;
my $domain = shift;
if(!$self->IsValid($domain)) { return; }
my $SQL = qq| insert into domains set added=NOW(),domain=| . API->Database->Quote($domain);
my $sth = API->DatabaseQuery($SQL);
$SQL = qq| select last_insert_id() |;
$sth = API->DatabaseQuery($SQL);
my $id = $sth->fetchrow_array();
my $command = qq|perl /home/siteuser/util/new.pl $id &|;
system($command);
return {'id'=>$id,'domain'=>$domain};
}
The first one is designed to work that way - system executes the command and finishes for it to end.
The last two are also designed that way - exec specifically is designed to never return. It basically replaces the parent process with the child process.
However, the second one should do the trick: the command launched from the system call is shell, which is given your string to execute. Since the string ends with "&", that means the shell will launch your command as a background process, and finish its own execution after that launch.
Can you please post more code illustrating how #2 didn't work?
Also, see what happens if you try backticks or qx:
my $output = qx|perl /util/script.pl $id &|;
print $output;
Also, as a way of reducing unknowns, can you please run the following and tell me what prints:
my $output = qx|(echo "AAAAAAA"; /bin/date; sleep 5; /bin/date; echo "BBBBBBB") &|;
print $output;
Are you calling fork() before calling system or exec?
my $pid = fork();
if (defined($pid) && $pid==0) {
# background process
my $exit_code = system( $command );
exit $exit_code >> 8;
}
my $pid = fork();
if (defined($pid) && $pid==0) {
# background process
exec( $command );
# doesn't^H^H^H^H^H^H shouldn't return
}
You need to disassociate the child from the parent.
See perldoc -q daemon. Or Proc::Daemon
Using fork is a good way to background processes:
my $pid = fork;
die "fork failed" unless defined $pid;
if ($pid == 0) {
# child process goes here
do '/util/script.pl';
exit;
}
# parent process continues here
Related
I am starting multiple bash scripts from a Perl script and I want to monitor them and log their behavior.
I know that I can tell whether a process is still running with kill 0, $pid and I can get the exit code from $?, but with launching multiple scripts in the background I can't relate values of $? to the processes that gave it as an exit code.
How can I launch those scripts in parallel, but get the exit code from each them? I need something like proc_get_status from PHP.
Sorry for not providing the code from the beginning.
I stripped down the code, so the important things are to see.
use warnings;
use strict;
use IPC::Open3;
use IO::Handle;
my $timeLimit = 60*60; # some time limit not to be crossed
my $startTime = time();
my #commands = (); # fill up with commands to be executed
my #processes = ();
foreach my $cmd (#commands) {
my $stdout = IO::Handle->new;
my $stderr = IO::Handle->new;
my $pid = open3(undef, $stdout, $stderr, $cmd);
push #processes, {"pid" => $pid, "out" => $stdout, "err" => $stderr, "cmd" => $fullcmd};
}
do {
if (time() - $startTime > $timeLimit) {
kill 2, $_->{pid} foreach (#processes);
#processes = ();
last;
} else {
for (my $i = 0; $i < #processes; $i++) {
unless (kill 0, $processes[$i]) {
# if it's not running, I would like to check the exit code and log it from here on.
# also remove it from the array, thats why I used for and not foreach, so I can use splice later.
}
}
}
} while (#processes > 0);
You have already hit upon the insight of storing background job data in mini-objects. Take the next step and try a full-featured parallelization package like Forks::Super. You can create background process objects that you can then query for their status and exit code. Forks::Super supports process timeouts and an open3-like interface.
use Forks::Super;
$Forks::Super::MAX_PROC = 10; # optional, block while 10 jobs already running
...
foreach my $cmd (#commands) {
my $job = fork {
cmd => $cmd, # run $cmd in background process
child_fh => 'out,err', # child STDOUT,STDERR available to parent
timeout => $timeLimit # kill the job after $timeLimit seconds
};
push #processes, $job;
}
while (#processes) {
sleep 5;
foreach my $job (#processes) {
if ($job->is_complete) {
$job->wait;
my $exit_code = $job->status;
my $output = $job->read_stdout;
my $error = $job->read_stderr;
# ... log status, output, error, $job->{cmd}, etc. ...
$job->dispose; # close filehandles and other clean up
}
}
#processes = grep { !$_->is_reaped } #processes;
}
You can use wait and waitpid to get the status of individual children. The perlipc documentation gives a few examples in the section on "Signals".
Since you're using IPC::Open3, the Synopsis also has an example of using waitpid():
my($wtr, $rdr, $err);
use Symbol 'gensym'; $err = gensym;
$pid = open3($wtr, $rdr, $err,
'some cmd and args', 'optarg', ...);
waitpid( $pid, 0 );
my $child_exit_status = $? >> 8;
First, take a look at Perl's fork() function. This would be the typical way I do things like this. There's a good explanation with examples here.
An easy to use forking module is provided by Parallel::ForkManger.
There is also Perl's interpreter-base threads which is a bit lower-level, harder to use, and spawns threads rather than forking processes.
Another possible way is with GNU Parallel. parallel is a very powerful tool to run commands in parallel. You can easily run and manage multiple commands and scripts with it. It has a ---joblog option which might be helpful for you.
All of these approaches provide ways to get the exit code of the sub-processes. In the end, the best choice depends on your current implementation which you did not provide.
Let's say we have a 'Child' and 'Parent' process defined and subroutines
my $pid = fork;
die "fork failed: $!" unless defined($pid);
local $SIG{USR1} = sub {
kill KILL => $pid;
$SIG{USR1} = 'IGNORE';
kill USR1 => $$;
};
and we divide them, is it possible to do the following?
if($pid == 0){
sub1();
#switch to Parent process to execute sub4()
sub2();
#switch to Parent process to execute sub5()
sub3();
}
else
{
sub4();
#send message to child process so it executes sub2
sub5();
#send message to child process so it executes sub3
}
If yes, can you point how, or where can I look for the solution? Maybe a short example would suffice. :)
Thank you.
There is a whole page in the docs about inter process communication: perlipc
To answer your question - yes, there is a way to do what you want. The problem is, exactly what it is ... depends on your use case. I can't tell what you're trying to accomplish - what you you mean by 'switch to parent' for example?
But generally the simplest (in my opinion) is using pipes:
#!/usr/bin/env perl
use strict;
use warnings;
pipe ( my $reader, my $writer );
my $pid = fork(); #you should probably test for undef for fork failure.
if ( $pid == 0 ) {
## in child:
close ( $writer );
while ( my $line = <$reader> ) {
print "Child got $line\n";
}
}
else {
##in parent:
close ( $reader );
print {$writer} "Parent says hello!\n";
sleep 5;
}
Note: you may want to check your fork return codes - 0 means we're in the child - a number means we're in the parent, and undef means the fork failed.
Also: Your pipe will buffer - this might trip you over in some cases. It'll run to the end just fine, but you may not get IO when you think you should.
You can open pipes the other way around - for child->parent comms. Be slightly cautious when you multi-fork though, because an active pipe is inherited by every child of the fork - but it's not a broadcast.
From a Perl script I want to execute various system commands and process the output in my script.
The script will be run automatically, so I want to make sure that no commands are hanging etc.
I'm open to any kind of feedback.
My requirements for the command execution:
Timeout -> If command runs longer than XX Seconds, it should kill its process(es)
If command returns information, it should not have to wait for end of timeout
I want to capture the exit status, STDERR, STDOUT in the script.
Here is an example I worked out from an other stackoverflow question: Kill a hung child process
What's not working for me at the moment:
cannot capture exit status of executed command
cannot capture STDERR of executed command
Code:
my $cmd = "sleep 15"; # other tests i use -> "echo bla" and "alkjdsf"
my $TIMEOUT = 10;
my $pid = open my $proc, '-|', "$cmd";
if (fork() == 0) {
my $poor_mans_alarm = "sleep 1,kill 0,$pid ||exit for 1..$TIMEOUT;kill 9,$pid";
# run poor man's alarm in a background process
exec($^X, '-e', "$poor_mans_alarm");
}
my $process_output = "";
while (<$proc>) {
$process_output .= $_;
}
If you either have a trick for this code or recommend a completely different solution, let me know.
Thanks and cheers
Addition:
Got a working Example with IPC::Open3,
But for future reader please Check out IPC::Run which has a Timeout Functionality included,
as mentioned by James Green.
Working example with IPC::Open3:
my $pid = open3(\*WRITE, \*READ,\*ERROR,"$command");
if (fork() == 0) {
my $poor_mans_alarm = "sleep 1,kill 0,$pid ||exit for 1..10;kill 9,$pid";
# run poor man's alarm in a background process
exec($^X, '-e', "$poor_mans_alarm");
}
# get all the STDOUT and STDERR from the Child.
while (<READ>) {
$output .= $_;
}
while (<ERROR>) {
$output .= $_;
}
waitpid($pid, 0);
if ($?) {
$rc = $? >> 8;
if ($rc != 1){
print "Some error $?\n";
}
}
It looks like IPC::Run provides pretty much everything you're after, including timeouts and capture of both STDOUT and STDERR. Docs are at https://metacpan.org/pod/IPC::Run including some usage examples.
I am trying to fork out a cmd like below
my $h = IO::Handle->new;
$self->{-handle} = $h;
die "IO::Handle->new failed." unless defined $h;
$self->{-pid} = open $h, $self->{-command} . ' 2>&1 |';
$self->fileevent($h, 'readable' => [\&_read_cmd_op, $self]);
sub _read_cmd_op{
my $h = $self->{-handle};
if ( sysread $h, $_, 4096 ) {
my $t = $self->Subwidget('text');
$t->insert('end', $_);
$t->yview('end');
} else {
$self->{-finish} = 1;
}
}
Now the problem is that the '$self{-command}' is invoking
another perl script which if dies I want to know.
Note that the $self{-pid} still exists even if cmd dies.
The above code is in a Perl/TK app, where the $self->{-command} o/p in captured in a
text widget.
Somehow i don't get the die message even in the test widget.
I see it on stdout.
2 questions
How can i get the cmd op/error in the text widget?
How can i know that the command fired via IO::Handle died?
$self->{-pid} is just the pid of the forked process, not some magic object which goes away if the command exits.
I cannot reproduce the problem not getting the die() message. If the snippet above is called with 'perl -e "die 123"', then "123" appears in the text widget (at least on a Unix system).
For getting the exit code you can use something like the following.
} else {
$mw->fileevent($h, 'readable', '');
my $pid = waitpid($self->{-pid},0);
warn "pid $pid finished";
warn "retcode is " . ($? >> 8);
$self->{-finish} = 1;
}
The fileevent call with the empty callback stops further selects on this filehandle. With the waitpid call you wait for the termination of the child process. Once this happens, the exit code is available in the $? variable, like after a normal system() call. So for a non-zero exit code you know that the command died or exited with a false value.
I have a problem I am hoping someone can help with...
I have a foreach loop that executes a backticks command on each iteration, such as greping a folder in a directory for a string (as shown below, greatly simplified for the purposes of explaining my question).
my #folderList = ("/home/bigfolder", "/home/hugefolder", "/home/massivefolder");
my #wordList = ("hello", "goodbye", "dog", "cat");
foreach my $folder (#folderList) {
foreach my $word (#wordList) {
print "Searching for this $word in this $folder\n";
my #output = `grep -R $word $folder`; #this could take hours so the user needs the option to skip/cancel this iteration and go the next one
print "#output\n";
}
}
The problem I am having:
If the folder the backticks grep command is being run against is particularly large or the array of words to check against is particularly large then the backticks command could take hours to complete (which is fine).
But what i want to be able to do is to break out of the inner loop (i.e when a word is being greped for in a folder) and go to the next iteration if it is taking a long time when the user presses a key on the keyboard or enters the word "next" or "exit" for example.
I know that if i wasnt using backticks I could easily break out of a normal loop using something like the following (but the logic of this obviously does not work when a backticks/system call is involved):
use strict;
use warnings;
use Term::ReadKey;
my $n = 0;
while () {
print '.';
last if ReadKey(-1);
$n++;
}
print $n;
There may be a simple solution that I am overlooking but I have never had the need to do this before, so your help is much appreciated, thanks
The solution is to run the long-running program in a background process (and remember the process id of the new process), and keep your user interaction in the foreground process. When the foreground is signaled to break, kill the background process.
All the parts I mentioned are well-explained in previous posts on Stack Overflow.
You are trying to simultaneously run an external command and process keyboard events, so you need to use some asynchronous framework. Asynchronous frameworks are based on either forks, threads, or event loops, and event loops are not appropriate in this case.
Here's an outline of how you could use a fork:
use POSIX ':sys_wait_h'; # defines WNOHANG
foreach my $folder (#folderList) {
foreach my $word (#wordList) {
print "Searching for this $word in this $folder\n";
my $pid = fork();
if ($pid == 0) { # child process
# we are just printing output from the child process; if you want
# to move data from the child process back to the parent, well,
# that's a whole other can of worms
print `grep -R $word $folder`;
exit;
} else { # parent process
while (waitpid($pid, &WNOHANG) != $pid) {
if (Term::ReadKey(-1)) {
kill 'TERM', $pid; # or maybe kill 'KILL', ...
last;
}
}
}
}
}
I understand what people have said regarding background processes, threads and forking and so on, but the option that suited my arrangement the best (and is probably the easier to implement), although I confess may not be the most efficient, best practice or preferred way of doing it, involved using eval and catching user control-c keypresses.
Very Simple Example:
NEXT:foreach $folder (#folders) { #label on the foreach
eval {
$SIG{INT} = sub { break() }; #catches control-c keypress and calls the break subroutine
$var1 = `grep -r "hello" $folder`;
};
sub break {
print "Breaking out of the backticks command and going to next folder \n";
next NEXT;
}
} #ending bracket of foreach loop