In a Perl script, I want to execute a system command and write the output in the console. Here is a snippet who reproduce the behavior of my script:
use strict;
use warnings FATAL => 'all';
sub safe_run_cmd {
my ($cmd) = @_;
my $pid;
my $sleep_count;
my $fcmd;
do {
$pid = open($fcmd, "$cmd 2>&1 |");
unless(defined $pid) {
warn("Cannot fork: $!\n");
die("Bailing out\n") if $sleep_count++ > 6;
sleep(1);
}
} until (defined $pid);
if($pid) {
while ( my $line = <$fcmd> ) {
print $line;
}
close $fcmd;
} else {
exit(0);
}
print("End safe_run_cmd\n");
}
eval{safe_run_cmd("bad_command")};
print(`ps aux | egrep open`);
print("-----\n");
eval{safe_run_cmd("echo good_command")};
print(`ps aux | egrep open`);
I called the function safe because I follow what is described in the documentation.
If I run my script, I get this:
pierre 146161 21.0 0.0 21916 4548 pts/1 S+ 14:32 0:00 perl open.pl
pierre 146163 0.0 0.0 21916 2816 pts/1 S+ 14:32 0:00 perl open.pl
pierre 146164 0.0 0.0 4320 756 pts/1 S+ 14:32 0:00 sh -c ps aux | egrep open
pierre 146166 0.0 0.0 12752 1008 pts/1 S+ 14:32 0:00 grep -E open
-----
good_command
End safe_run_cmd
pierre 146161 10.5 0.0 21916 4548 pts/1 S+ 14:32 0:00 perl open.pl
pierre 146163 0.0 0.0 21916 3516 pts/1 S+ 14:32 0:00 perl open.pl
pierre 146168 0.0 0.0 4320 756 pts/1 S+ 14:32 0:00 sh -c ps aux | egrep open
pierre 146170 0.0 0.0 12752 996 pts/1 S+ 14:32 0:00 grep -E open
End safe_run_cmd
pierre 146161 10.5 0.0 21916 4744 pts/1 S+ 14:32 0:00 perl open.pl
pierre 146171 0.0 0.0 4320 708 pts/1 S+ 14:32 0:00 sh -c ps aux | egrep open
pierre 146173 0.0 0.0 12752 1008 pts/1 S+ 14:32 0:00 grep -E open
-----
good_command
End safe_run_cmd
pierre 146161 10.5 0.0 21916 4744 pts/1 S+ 14:32 0:00 perl open.pl
pierre 146175 0.0 0.0 4320 788 pts/1 S+ 14:32 0:00 sh -c ps aux | egrep open
pierre 146177 0.0 0.0 12752 1012 pts/1 S+ 14:32 0:00 grep -E open
We can see, when I print the list of the processes after running the bad command, I have two perl forks. When the first one ends, the second one continue from the call of open. But, when the command is right, open doesn't fork.
What can I do to avoid this fork (or to manage it) and to display an error message when the command is bad?
The use of warnings FATAL => 'all' has a side-effect on the open function. Indeed, if open gets a warning, it immediately dies. So, if I remove it from the code, I get a correct output:
Cannot fork: No such file or directory
Cannot fork: No such file or directory
Cannot fork: No such file or directory
Cannot fork: No such file or directory
Cannot fork: No such file or directory
Cannot fork: No such file or directory
Cannot fork: No such file or directory
Cannot fork: No such file or directory
pierre 207725 2.3 0.0 21644 4432 pts/1 S+ 15:28 0:00 perl open.pl
pierre 207750 0.0 0.0 4320 816 pts/1 S+ 15:28 0:00 sh -c ps aux | egrep open
pierre 207752 0.0 0.0 12752 984 pts/1 S+ 15:28 0:00 grep -E open
-----
good_command
End safe_run_cmd
pierre 207725 2.3 0.0 21644 4448 pts/1 S+ 15:28 0:00 perl open.pl
pierre 207754 0.0 0.0 4320 748 pts/1 S+ 15:28 0:00 sh -c ps aux | egrep open
pierre 207756 0.0 0.0 12752 996 pts/1 S+ 15:28 0:00 grep -E open
To automaticly die if the command doesn't exist, it is possible to use autodie instead of the do block:
sub safe_run_cmd {
my ($cmd) = @_;
my $pid;
my $sleep_count;
my $fcmd;
use autodie;
$pid = open($fcmd, "$cmd 2>&1 |");
while ( my $line = <$fcmd> ) {
print $line;
}
close $fcmd;
print("End safe_run_cmd\n");
}
I get:
pierre 211968 11.5 0.0 26544 7244 pts/1 S+ 15:32 0:00 perl open.pl
pierre 211971 0.0 0.0 4320 768 pts/1 S+ 15:32 0:00 sh -c ps aux | egrep open
pierre 211973 0.0 0.0 12752 1064 pts/1 S+ 15:32 0:00 grep -E open
-----
good_command
End safe_run_cmd
pierre 211968 11.5 0.0 26544 7264 pts/1 S+ 15:32 0:00 perl open.pl
pierre 211975 0.0 0.0 4320 792 pts/1 S+ 15:32 0:00 sh -c ps aux | egrep open
pierre 211977 0.0 0.0 12752 1032 pts/1 S+ 15:32 0:00 grep -E open