I'm trying to fork a separate process/thread in perl and get the input back to the parent via a pipe. For instance:
my($RD, $WR);
pipe($RD, $WR);
if(fork())
{
#parent
while(!eof $RD) { print "From Child: " . readline($RD); }
print "Parent reached EOF\n";
} else {
#child
for(my $i = 0; $i < 25; $i++) { print $WR "$i\n"; }
close $WR;
}
All of the lines from the child are recieved and printed out by the parent. But the parent never detects EOF and is stuck in that while loop, waiting. What is the proper way to detect EOF here?
A file handle is only closed when all file descriptors referring to that handle are closed. Have the parent close its copy.
pipe(my ($RD, $WR))
or die("pipe: $!\n");
defined( my $pid = fork() )
or die("fork: $!\n");
if ($pid) {
# parent
close($WR);
print "From Child: $_" while <$RD>;
print "Parent reached EOF\n";
} else {
# child
close($RD);
print $WR "$_\n" for 0..25;
}
Related
is it possible in perl to establish a pipe in such a way that the parent has only one READER pipe and many children write to it as they come to life/exit?
The typical cookbook code is:
#!/usr/bin/perl -w
# pipe2 - use pipe and fork so child can send to parent
use IO::Handle;
pipe(READER, WRITER);
WRITER->autoflush(1);
if ($pid = fork) {
close WRITER;
chomp($line = <READER>);
print "Parent Pid $$ just read this: `$line'\n";
// do what you need
} else {
die "cannot fork: $!" unless defined $pid;
close READER;
print WRITER "Child Pid $$ is sending this\n";
close WRITER; # this will happen anyway
exit;
}
Let's instead assume a case where I need my parent "READER" to get messages from multiple children, is it possible to do this without keeping a list of pipes, one per child? I can't close WRITER in the parent because the next child won't get a valid handle to write to. I also need the parent to continue its regular operation and not block on any client data from the pipe.
Pseudocode of what I need:
# parent code
pipe (READER, WRITER)
fork_random_number_of_children(READER,WRITER)
on_some_tick => {
my $data = read_from(READER, non_blocking)
if (data) print "Hey some child sent me: $data"
else print "No data, going back life"
do_other_things_before_next_tick()
}
child_job(R,W) { # lets assume this is called for each child fork
close (R); # no problem, its a copy
sleep (random duration)
print W, "Message from child with pid $$"
exit 0
}
I don't think it's necessary to close WRITER in the parent. It may be a good practice, but since you can't reuse the same pipe for new child processes after you close it, that's a good excuse not to do it. If you keep WRITER open until you are done launching all your child processes, you can reuse the pipe with multiple child processes. Here's a proof of concept:
use IO::Handle;
use POSIX ':sys_wait_h';
pipe(READER,WRITER);
WRITER->autoflush(1);
sub child_process {
my $stage = shift;
close READER; # also a best but optional practice
srand($$);
do {
sleep 1 + 5*rand();
print WRITER "Child Pid $$ ($stage) is sending this\n";
} while (rand > 0.5);
exit;
}
# initial set of children
for (my $i=0; $i<5; $i++) {
if (fork() == 0) {
child_process("LAUNCH");
}
}
# parent
my ($rin,$rout) = ('');
vec($rin,fileno(READER),1) = 1;
while (1) {
# non-blocking read on pipe
my $read_avail = select($rout=$rin, undef, undef, 0.0);
if ($read_avail < 0) {
if (!$!{EINTR}) {
warn "READ ERROR: $read_avail $!\n";
last;
}
} elsif ($read_avail > 0) {
chomp(my $line = <READER>);
print "Read in Parent $$: '$line'\n";
} else {
print STDERR "No input ... do other stuff\n";
# start some run-time child processes
if (time-$^T > 5 && time-$^T < 10) {
# launch a few more children in the middle of the program
if (fork() == 0) {
child_process("RUN");
}
}
sleep 1;
}
last if waitpid(-1,&WNOHANG) < 0; # no more children are alive
}
close WRITER; # now it is safe to do this ...
I almost have no idea of forking. I tried to research, but I couldn't find a simple example of how to do these things. For windows I found a good module and wrote this piece of code, which is doing what I want.
Win32::Process::Create( my $ProcessObj,
"$jobs{$id}->{path}", "execute job", 0, NORMAL_PRIORITY_CLASS, "." )
|| die ErrorReport();
print "Available commands:\n1.Suspend\n2.Resume\n3.Kill\n";
while (1) {
chomp( my $input = <STDIN> );
if ( $input eq "1" ) {
$ProcessObj->Suspend();
}
if ( $input eq "2" ) {
$ProcessObj->Resume();
}
if ( $input eq "3" ) {
print "Returned to main menu.\n";
$ProcessObj->Kill(0);
return;
}
}
So my question is if there is a way to do this with forking?
And here is my try for forking:
unless ( $pid = fork) {
unless (fork) {
exec "$jobs{$id}->{path}";
die "exec failed!";
}
exit 0;
}
waitpid($pid, 0);
I have a program which is printing Hello world every 3 seconds and I want to pause it, resume it and kill it, if this example will help.
Forks::Super makes this simple and platform-independent.
use Forks::Super;
...
my $pid = fork { exec => $jobs{$id}->{path} };
...
$pid->suspend;
...
$pid->resume;
...
$pid->kill; # or $pid->kill('TERM'), $pid->kill('QUIT'), etc.
If you must go by hand, the signals to use are 'SIGSTOP' and 'SIGCONT'.
A command-line demo
perl -wE'
$pid = fork // die "Cant fork: $!";
if ($pid == 0) {
for (1..6) { say "\tkid ..."; sleep 1; };
say "\tKID DONE"; exit;
};
sleep 3;
kill "STOP", $pid;
for (1..2) { say "Parent here!"; sleep 1};
kill "CONT", $pid;
wait;
'
prints
kid ...
kid ...
kid ...
Parent here!
Parent here!
kid ...
kid ...
kid ...
KID DONE
Then you'd need to implement this in your STDIN-driven management.
But I suggest to try to resolve the installation of Forks::Super, from mob's answer.
A STDIN controlled example. The forked process and the parent write to a file for a test.
use warnings;
use strict;
use feature 'say';
#use IO::Handle; # needed pre v5.16 (for autoflush)
my $fh_kid;
$SIG{INT} = sub { close $fh_kid; exit 1 };
my $file = 'kidfile.out';
open $fh_kid, '>', $file or die "Can't open $file: $!";
$fh_kid->autoflush;
my $pid = fork // die "Can't fork: $!";
if ($pid == 0) {
$SIG{TERM} = sub { close $fh_kid; exit 1 };
for (1..20) {
say $fh_kid "\tkid, $_";
sleep 1;
}
exit;
}
say "Parent: started $pid";
while (1) {
chomp (my $input = <STDIN>);
if (not $input) {
close $fh_kid;
last;
}
if ($input == 1) {
kill 'STOP', $pid;
say "Parent: STOP-ed $pid";
say $fh_kid "Parent STOP-ed $pid";
}
elsif ($input == 2) {
say "Parent: CONT the $pid";
kill 'CONT', $pid;
}
elsif ($input == 3) {
close $fh_kid;
kill 'TERM', $pid;
say "Parent: TERM-ed the $pid";
}
}
my $gone = waitpid $pid, 0;
if ($gone > 0) { say "Child $gone exited with: $?" }
elsif ($gone < 0) { say "No such process ($gone), reaped already?" }
else { say "Still out there?" }
This needs more detail but it does show what kinds of things get involved.
Output (with comments)
Parent: started 19628
1 # entered a few seconds after starting
Parent: STOP-ed 19628
2 # after waiting for a minute
Parent: CONT the 19628
3 # after waiting for a few more seconds
Parent: TERM-ed the 19628
^C # quit STDIN
We allow the kid to print to a file for a few seconds (so a few times) and then STOP it (1), then wait for a bit and then CONTinue the child (2) and let it print a few more times before killing it (3).
The output kidfile.out has a few lines from the child, then a line from the parent, and then a few more lines from the child, confirming that the child was paused, resumed, and stopped.
All im trying to do here is:
Create a pipe
Fork a sub-process
Parent gets a message from the user, sends it to the child
Child gets the message, prints it to the screen
Repeat until user doesn't enter a message
This is what I got now so far: I still need to implement a loop to repeat until user doesn't enter a message.
#!perl -w
use strict
pipe(PIPE_READ, PIPE_WRITE);
autoflush PIPE_WRITE 1;
my $pid = fork();
if ($pid) {
&write_pipe ($pid);
waitpid($pid,0);
}
elsif (defined $pid) {
&read_pipe;
}
else {
die "cannot fork: $!";
}
sub write_pipe {
print "pid $$ \n";
print "Enter message: ";
sleep 1;
my $usr_msg = <>;
print "Parent pid = $$ message = $usr_msg";
print PIPE_WRITE "$usr_msg\n";
close(PIPE_WRITE)
close(PIPE_READ);
}
sub read_pipe {
print "child pid = $pid";
my $msg_read = <PIPE_READ>;
close(PIPE_WRITE);
print "received from pipe $msg_read";
}
First of all, you are unintentionally creating two children. Replace
if ($pid = fork)
with
if ($pid)
In the child, call
close(PIPE_WRITE);
In the parent, call
close(PIPE_READ);
In the parent (when done writing), call
close(PIPE_WRITE);
As for reading from a file handle until EOF or a specific command is entered,
while (my $line = <>) {
last if $line =~ /^(?:quit|exit)$/;
...
}
I am trying to build a program wich creates some forks and writes the results of the forks back to the main program. Thereby I try to use IO::Pipe
sub ForkRequests {
my $pipe = IO::Pipe->new();
my $pid;
foreach my $feature ( #features ) {
if ( $pid = fork() ) {
$pipe->reader();
while ( <$pipe> ) {
print $_. "\n";
}
}
elsif ( defined $pid ) {
#child
$pipe->writer();
#somecalculations [...]
print $pipe $calcresults;
}
}
}
I got my code for doing a pipe from the module's documentation.
If i now try to execute, I get an error message
Can't locate object method "reader" via package "IO::Pipe::End" at lmtest3.pl line 56.
Can't locate object method "writer" via package "IO::Pipe::End" at lmtest3.pl line 63.
Can't locate object method "reader" via package "IO::Pipe::End" at lmtest3.pl line 56, <GEN0> line 1.
Can't locate object method "writer" via package "IO::Pipe::End" at lmtest3.pl line 63, <GEN0> line 1.
So, my code does not seem to initiate a pipe object, but an IO::Pipe::End.
So my question is, can anybody see the mistake in there? Why does it return the wrong object, and how would this be done correctly?
EDIT
I have some requests to some servers (most of the time 1 request to 7 ervers).
Those request names are saved in #features, and will be executed at the point of #somecalculations.
Because the server response is pretty slow, I want those requests to start in parallel. They all have to get back to the main program and print the reply to the console.
I tried this code
sub ForkRequests {
my $i = 0;
my #pipes;
my $pid;
foreach my $feature ( #features ) {
#pipes[$i] = IO::Pipe->new();
if ( $pid = fork() ) {
#pipes[$i]->reader();
}
elsif ( defined $pid ) {
#child
#pipes[$i]->writer();
# calculations
my $w = #pipes[$i];
print $w $calc;
print $w "end\n";
}
$i++;
}
}
if ( $pid == 1 ) {
while ( 1 ) {
foreach my $pipe ( #pipes ) {
while ( <$pipe> ) {
unless ( $_ == "end" ) {
print $_. "\n";
}
else { last; }
}
}
}
}
else {
exit;
}
}
as said, to save those pipes, but I still got a problem in reading them, as the program exits before it gets answers.
The problem is that you are forking multiple child processes but trying to use the same pipe for all of them.
The reader method converts $pipe into an IO::Pipe::End object that you can read data from, so the first child is connected correctly. But you then call reader again on the same $pipe, and the error is thrown because it is no longer an object of the right class.
You simply need to create a new pipe for each child process:
sub fork_requests {
for my $feature ( #features ) {
my $pipe = IO::Pipe->new;
my $pid;
if ( $pid = fork ) {
$pipe->reader;
print while <$pipe>;
}
elsif ( defined $pid ) {
$pipe->writer;
# some calculations . . .
print $pipe $calcresults;
exit;
}
}
}
Update
Okay I think I understand what it is you need. This complete program should show you.
I have written fork_requests so that it expects a list of features as parameters, and I have written the child code so that it sleeps for two seconds to emulate the processing time and then simply prints the name of the feature.
The parent code stores all the pipes in an array, as I suggested, and prints the output from each of them in the order they were queued. All five child processes complete after two seconds, so the parent is suspended for that time and then prints the features originally passed in.
use strict;
use warnings;
use IO::Pipe;
STDOUT->autoflush;
fork_requests('A' .. 'E');
sub fork_requests {
my #pipes;
for my $feature ( #_ ) {
my $pipe = IO::Pipe->new;
my $pid;
if ( $pid = fork ) {
$pipe->reader;
push #pipes, $pipe;
}
elsif ( defined $pid ) {
$pipe->writer;
select $pipe;
# some calculations . . .
sleep 2;
my $calcresults = $feature;
print $calcresults, "\n";
exit;
}
}
for my $pipe ( #pipes ) {
print while <$pipe>;
}
}
output
A
B
C
D
E
I'm having some trouble getting the exit status of child processes. For some reason the kill 0, $pid way doesn't seem to work. I'm running the following script on a Unix machine:
for ( my $count = 1; $count <= 2; $count++) {
my $pid = fork();
if ($pid) {
# parent
push(#childs, $pid);
} elsif ($pid == 0) {
# child
sleep(10);
exit 0;
} else {
die "couldnt fork: $!\n";
}
}
foreach (#childs) {
if (kill 0, $_){
print "$_ is running...\n";
}
else {
print "$_ is complete\n";
}
}
sleep (20);
foreach (#childs) {
if (kill 0, $_){
print "$_ is running...\n";
}
else {
print "$_ is complete\n";
}
}
The prints I get are:
23285 is running...
23286 is running...
23285 is running...
23286 is running...
Can anybody please explain why this won't work, and maybe suggest a solution or workaround ?
Many thanks!
Whenever I need to fork one child and wait for it I use the wait() function.
When I have to fork multiple children and wait for them, I use the Parallel::ForkManager module.