Re: get same return that system gives and get pid

An alternative (best is to use modules, it saves you from deadlock pitfalls) is using pipes:

The problem with pipes is that you can kill your child, or the child hangs or takes too long, without the parent knowing, as it is "reading". So you need an alarm ($SIG{'ALRM'}) in your parent. A way I do it (so the parent stays responsive)

 #!/usr/bin/perl 
 use strict;
 use warnings;
 
my $parent_pid = $$;
my $child_pid = 0;
my @child_output;

my $read_from_child = 0;
my $max_timeout = 60;
my $timeout;
    
print "Parent is $parent_pid\n";

my $pid = open(KID_TO_READ, "-|");
defined($pid) || die "can't fork: $!";
#local $SIG{CHLD};
if ($pid) {             # parent
    local $SIG{'CHLD'} = sub { print "dead child\n"; $timeout=0 };
    local $SIG{'USR1'} = sub { ++$read_from_child };
    print "reading kid...\n";
    $timeout = $max_timeout;
    while($timeout >0){
        print "parent $parent_pid timeout=$timeout read_from_child=$re
+ad_from_child - child_pid=$child_pid\n";
        if($read_from_child>0){
            --$read_from_child;
            $_=<KID_TO_READ>;
            print "parent $$ just read: $_";
            unless( $child_pid>0 ){
                chomp($child_pid = $_);
            }else{
                push @child_output, $_;
            }            
        }else{
            sleep 1;
            --$timeout;
        }
    }
    close(KID_TO_READ);
} else {                # child
    print $$ . "\n";    # send child pid
    kill('USR1', $parent_pid); # warn parent there is data
    print STDERR "child $$ is running\n";  # print to screen (DEBUG)
    my $program = "/bin/sleep";
    my @args = qw(3);
    my $ret = system($program, @args);
    print "returncode is $ret\n"; # is $?
    print STDERR "returncode is $ret\n"; # print to screen (DEBUG)
    kill('USR1', $parent_pid); # warn parent there is data
    exit 0;
}

print "\nChild $child_pid is done, we now have:\n@child_output\n";
[download]

which prints something like:

Parent is 5323
reading kid...
parent 5323 timeout=60 read_from_child=0 - child_pid=0
child 5324 is running
parent 5323 timeout=59 read_from_child=1 - child_pid=0
parent 5323 just read: 5324
parent 5323 timeout=59 read_from_child=0 - child_pid=5324
parent 5323 timeout=58 read_from_child=0 - child_pid=5324
parent 5323 timeout=57 read_from_child=0 - child_pid=5324
parent 5323 timeout=56 read_from_child=0 - child_pid=5324
returncode is 0
parent 5323 timeout=55 read_from_child=1 - child_pid=5324
parent 5323 just read: returncode is 0
parent 5323 timeout=55 read_from_child=0 - child_pid=5324
dead child

Child 5324 is done, we now have:
returncode is 0
[download]

Comment on Re: get same return that system gives and get pid Select or Download Code

Replies are listed 'Best First'.
Re^2: get same return that system gives and get pid by FreeBeerReekingMonk (Deacon) on Aug 11, 2016 at 13:58 UTC
Note that you should never `print` inside the subroutines of signals, thus, for production code: BAD: `local $SIG{'CHLD'} = sub { print "dead child\n"; $timeout=0 };` [download] GOOD: `local $SIG{'CHLD'} = sub { $timeout=0 };` [download] Also, in the above code, $pid == $child_pid (only $child_pid is send from the child to the parent in a IPC) So if you look at the code from perlplexer in Perl IPC: Checking Exit Status of Child Process This is something you actually want: #!/usr/bin/perl use strict; use warnings; my $timeout = 10; my $parent_pid = $$; my $child_pid = fork(); die "Can't fork() : $!\n" unless defined $child_pid; if ($child_pid){ # parent eval { local $SIG{ALRM} = sub { die "timed-out\n" }; alarm $timeout; if (waitpid($child_pid, 0) > 0){ my ($rc, $sig, $core) = ($? >> 8, $? & 127, $? & 128); if ($core){ print "$child_pid dumped core\n"; }elsif($sig == 9){ print "$child_pid was murdered!\n"; }else{ print "$child_pid returned $rc"; print ($sig?" after receiving signal $sig":"\n"); } }else{ print "$child_pid... um... disappeared...\n"; } alarm 0; }; if($@ eq "timed-out\n"){ print "$child_pid... parent got bored waiting for it...\n"; } }else{ # child print "child $$ is running...\n"; my $ret = system("sleep 20"); exit $ret; } [download] edit: added alarm edit2: After reading more about what you actually are trying to do, you also need to loop over the waitpid in such a way that it returns the pid of the child that is ready. Implementing multi queued children is a bit harder. And would require more details about what you require, as, for example, you can prestart 10 children, that are idle until some work for them is done, or you have a single activity queue and a maximum of X children to do the work, and spawn them on the fly when they need to do something. Checking which child is ready to give you their exitcode can be done with WNOHANG, see waitpid Depending on what you want to do, independant threads are also an option: threads	[reply] [d/l] [select]

Replies are listed 'Best First'.

Re^2: get same return that system gives and get pid
by FreeBeerReekingMonk (Deacon) on Aug 11, 2016 at 13:58 UTC

print

BAD:

local $SIG{'CHLD'} = sub { print "dead child\n"; $timeout=0 };
[download]

GOOD:

local $SIG{'CHLD'} = sub { $timeout=0 };
[download]

Also, in the above code, $pid == $child_pid (only $child_pid is send from the child to the parent in a IPC)

So if you look at the code from perlplexer in

Perl IPC: Checking Exit Status of Child Process

This is something you actually want:

#!/usr/bin/perl 
use strict;
use warnings;
 
my $timeout = 10;
my $parent_pid = $$;
my $child_pid = fork();

die "Can't fork() : $!\n" unless defined $child_pid;

if ($child_pid){
    # parent
    eval {
        local $SIG{ALRM} = sub { die "timed-out\n" };
        alarm $timeout;
        if (waitpid($child_pid, 0) > 0){
            my ($rc, $sig, $core) = ($? >> 8, $? & 127, $? & 128);
            if ($core){
                print "$child_pid dumped core\n";
            }elsif($sig == 9){
                print "$child_pid was murdered!\n";
            }else{
                print "$child_pid returned $rc";
                print ($sig?" after receiving signal $sig":"\n");
            }
        }else{
          print "$child_pid... um... disappeared...\n";
       }
       alarm 0;
   };
   if($@ eq "timed-out\n"){
        print "$child_pid... parent got bored waiting for it...\n";
   }
   
}else{
    # child
    print "child $$ is running...\n";
    my $ret = system("sleep 20");
    exit $ret;
}
[download]

edit: added alarm

edit2: After reading more about what you actually are trying to do, you also need to loop over the waitpid in such a way that it returns the pid of the child that is ready. Implementing multi queued children is a bit harder. And would require more details about what you require, as, for example, you can prestart 10 children, that are idle until some work for them is done, or you have a single activity queue and a maximum of X children to do the work, and spawn them on the fly when they need to do something.

Checking which child is ready to give you their exitcode can be done with WNOHANG, see waitpid

Depending on what you want to do, independant threads are also an option: threads

[reply]
[d/l]
[select]