In Perl, the command, will wait till the "command" is completed. Is there a way to let command wait only for 20 sec ? One scenario is like the following:
The command is an infinite loop and won't finish. The command will freeze and the program can't proceed. What I want to let the program not blocked by command.
I know Ruby has a way to do this. Does Perl have a solution?
Thanks,
=Y
Use alarm:
eval {
local $SIG{ALRM} = sub { die "alarm\n" }; # NB: \n required
alarm 20;
system("<Your command>")
alarm 0;
};
if ($#) {
die unless $# eq "alarm\n"; # propagate unexpected errors
# timed out
}
else {
# didn't
}
#!/usr/bin/perl -w
use strict;
use 5.010;
my $foo = 123;
my $pidChild = fork(); # All objects before this fork statement will be copied.
given ($pidChild)
{
when (!defined($_)) {
die "Cannot fork: $!";
}
when ($_ == 0) {
# The child process goes here.
$foo = 456; # This is a duplicate.
system 'subprocess options'; # Or: exec 'suprocess options';
}
default {
# The original process goes here.
waitpid($_, 0); # Whether to wait or not is up to you.
say $foo; # Output: 123
}
}
If Inter-Process Communication (IPC) is needed, before the invocation of fork, the built-in function pipe can be used to create 2 handlers, one for input and another for output, they'll be shared by the original process and the subprocess.
There's surely more than one way to do IPC. The built-in function open, the subroutine open2 offered by the module IPC::Open2, and the open3 offered by IPC::Open3 all can run a subprocess asynchronously.
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.
I'm writing a wrapper to an external command ("sox", if this can help) with Perl "Tk".
I need to run it asynchronously, of course, to avoid blocking tk's MainLoop().
But, I need to read it's output to notify user about command's progress.
I am testing a solution like this one, using IPC::Open3:
{
$| = 1;
$pid = open3(gensym, ">&STDERR", \*FH, $cmd) or error("Errore running command \"$cmd\"");
}
while (defined($ch = FH->getc)) {
notifyUser($ch) if ($ch =~ /$re/);
}
waitpid $pid, 0;
$retval = $? >> 8;
POSIX::close($_) for 3 .. 1024; # close all open handles (arbitrary upper bound)
But of course the while loop blocks MainLoop until $cmd does terminate.
Is there some way to read output handle asynchronously?
Or should I go with standard fork stuff?
The solution should work under win32, too.
For non-blocking read of a filehandle, take a look at Tk::fileevent.
Here's an example script how one can use a pipe, a forked process, and fileevent together:
use strict;
use IO::Pipe;
use Tk;
my $pipe = IO::Pipe->new;
if (!fork) { # Child XXX check for failed forks missing
$pipe->writer;
$pipe->autoflush(1);
for (1..10) {
print $pipe "something $_\n";
select undef, undef, undef, 0.2;
}
exit;
}
$pipe->reader;
my $mw = tkinit;
my $text;
$mw->Label(-textvariable => \$text)->pack;
$mw->Button(-text => "Button", -command => sub { warn "Still working!" })->pack;
$mw->fileevent($pipe, 'readable', sub {
if ($pipe->eof) {
warn "EOF reached, closing pipe...";
$mw->fileevent($pipe, 'readable', '');
return;
}
warn "pipe is readable...\n";
chomp(my $line = <$pipe>);
$text = $line;
});
MainLoop;
Forking may or may not work under Windows. Also one needs to be cautious when forking within Tk; you must make sure that only one of the two processes is doing X11/GUI stuff, otherwise bad things will happen (X11 errors, crashes...). A good approach is to fork before creating the Tk MainWindow.
I am relatively new to perl programming and I am trying to figure out how open3 works. Here is the code.
#!/usr/bin/perl
use strict;
use warnings;
use IPC::Open3;
my $dir = "/home/vman/Documents/Dev/perl_scripts/Provenance/temp";
my $fileHandle;
my $bashPid;
print "Starting main program\n";
my $pid = fork();
if($pid)#Parent process2
{
print("Start transfer.\n");
$bashPid = $pid;
#Attaching an strace to the executed command which happens in the child process
open3(\*WRITE, \*READ,\*ERROR,"strace", "-f", "-F", "-e", "trace=open,execve","-p", $bashPid, "-s", "2097152","-q");
while(<READ>)
{
print("Here1\n");
print("$_");
}
while(<ERROR>)
{
print("$_");
}
print("Finish transfer.\n");
}
elsif($pid == 0)
{
if (scalar(#ARGV == 0))
{
exit
}
my $args = join(' ', #ARGV);
exec($args);
}
else
{
die("Could not fork.");
}
close(READ);
close(WRITE);
close(ERROR);
waitpid($bashPid, 0);
print "End of main program\n";
I want to run an strace on a bash process, then capture all the output while it is being outputted. Then I will take that output and parse it to see what files are being changed by which process and I will save those changes in a mysql database. For now all I am trying to do is attach an strace onto an existing bash process and get the output of that strace printed within the bash terminal that is running just to make sure that it is asynchronously reading the output.
One of the problems is that I am getting the output through the ERROR filehandle. I am a little confused on to why this is happening. Am I using the correct order for open3 and if there is an error why is the correct output even making it to stderr?
The second problem I have is that I am getting the output only when exec ends which is no good since it needs to be done while exec is running. I thought open3 runs asynchronously.
As per suggested this is what I did and it works perfectly.
#!/usr/bin/perl
use strict;
use warnings;
use IPC::Run3;
my $bashPid;
print "Starting main program\n";
my $pid = fork();
if($pid)#Parent process
{
print("Start transfer.\n");
$bashPid = $pid;
#Attaching an strace to the executed command which happens in the child process
my $command = "strace -fFe trace=open,execve -p $bashPid -s 2097152 -q";
run3($command, \*STDIN, \*STDOUT, \*STDERR);
if ($?)
{
die "something went horribly wrong";
}
while(<STDERR>)
{
print($_);
}
print("Finish transfer.\n");
}
elsif($pid == 0)#cild process
{
if (scalar(#ARGV == 0))
{
exit
}
my $args = join(' ', #ARGV);
exec($args);
}
else
{
die("Could not fork.");
}
close(STDIN);
close(STDOUT);
close(STDERR);
waitpid($bashPid, 0);
print "End of main program\n";
One of the problems is that I am getting the output through the ERROR filehandle
Correct. strace writes to STDERR.
The second problem I have is that I am getting the output only when exec ends which is no good since it needs to be done while exec is running. I thought open3 runs asynchronously.
That's because you only start reading from the child's STDERR after the child closes its STDOUT when it ends.
In fact, you're lucky you haven't deadlocked yet. By reading one at a time as you are currently, doing, you'll deadlock when strace has output enough to fill the pipe.
You need to read from both the child's STDOUT and STDERR as it comes in. You could do this using with the help of select, polling non-blocking handle or threads. None of those options are as simple as ditching open3 and using a higher-level module that handles this for you. The simpler IPC::Run3 and the fully featured IPC::Run are good choices.
I have a Perl script which forks a number of sub-processes. I'd like to have some kind of functionality like xargs --max-procs=4 --max-args=1 or make -j 4, where Perl will keep a given number of processes running until it runs out of work.
It's easy to say fork four process and wait for them all to complete, and then fork another four, but I'd like to keep four or n processes running at the same time, forking a new process as soon as one completes.
Is there a simple way in Perl to implement such a process pool?
Forks::Super can handle this requirement.
use Forks::Super MAX_PROC => 5, ON_BUSY => [ block | queue ];
Calls to fork() can block until the number of active subprocesses falls below 5, or you can pass additional parameters to the fork call and the tasks to perform can queue up:
fork { sub => sub { ... task to run in subprocess ... } }
When one subprocess finishes, another job on the queue will start up.
(I am the author of this module).
Check out Parallel::ForkManager -- it does much of what you describe. You can set a maximum number of processes, and the callback function could start a new child as soon as one finishes (as long as there is work to do).
While I would almost always use a CPAN module, or write something with the fantastic AnyEvent modules I think its important to understand how these things work under the hood. Here's an example that has no dependencies other than perl. The same approach could also be written in C without too much trouble.
#!/usr/bin/env perl
use strict;
## run a function in a forked process
sub background (&) {
my $code = shift;
my $pid = fork;
if ($pid) {
return $pid;
} elsif ($pid == 0) {
$code->();
exit;
} else{
die "cant fork: $!"
}
}
my #work = ('sleep 30') x 8;
my %pids = ();
for (1..4) {
my $w = shift #work;
my $pid = background {
exec $w;
};
$pids{$pid} = $w;
}
while (my $pid = waitpid(-1,0)) {
if ($?) {
if ($? & 127) {
warn "child died with signal " . ($? & 127);
} else {
warn "chiled exited with value " . ($? >> 8);
}
## redo work that died or got killed
my $npid = background {
exec $pids{$pid};
};
$pids{$npid} = delete $pids{$pid};
} else {
delete $pids{$pid};
## send more work if there is any
if (my $w = shift #work) {
my $pid = background {
exec shift #work;
};
$pids{$pid} = $w;
}
}
}