Multiple forks and IO:Pipe - perl

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

Related

Detecting the end of a Pipe in Perl

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;
}

Shutting down a Mojo::IOLoop recurring event connected to a Mojo websocket

I'm playing around with Mojolicious and websockets. I want to send the output of multiple external commands on the server to the webpage. I have no problems with connecting and receiving messages, but I also want to send a message back to the server to stop an external command while letting the others keep sending messages back to the client. I also want to stop checking the external command once it exits.
The external command is simply a one-liner that spits out an integer every few seconds. I have two websockets that display the numbers in separate divs. Clicking either of the stop buttons sends the message, but that's where I need to figure out how to shut down that websocket (and only that websocket) and shut down the external command.
When I connect the websocket, I run the external command and set up a Mojo::IOLoop->recurring to check if there's output.
When I want to stop, I figure that I should call Mojo::IOLoop->remove($id), but that doesn't seem to completely remove it and I get error messages like Mojo::Reactor::Poll: Timer failed: Can't call method "is_websocket" on an undefined value.
If I call finish on the controller object to shut down the websocket, it seems to stop everything.
I have the entire Mojolicious::Lite app as a gist, but here's the parts where I
use feature qw(signatures);
no warnings qw(experimental::signatures);
## other boilerplate redacted
websocket '/find' => sub ( $c ) {
state $loop = Mojo::IOLoop->singleton;
app->log->debug( "websocket for find" );
$c->inactivity_timeout( 50 );
my $id;
$c->on( message => sub ( $ws, $message ) {
my $json = decode_json( $message );
my $command = $json->{c};
my $name = $json->{n};
app->log->debug( "Got $command command for $name" );
if( $command eq "start" ) {
$id = run_command( $ws );
app->log->debug( "run_command for $name returned [$id]" );
}
elsif( $command eq "stop" ) {
app->log->debug( "stopping loop for $name [$id]" );
# XXX What should I do here?
# $ws->finish;
# $loop->remove( $id );
}
elsif( $command eq "open" ) {
app->log->debug( "opening websocket for $name" );
}
}
);
$c->on(
finish => sub ( $c, $code ) {
app->log->debug("WebSocket closed with status $code");
}
);
};
app->start;
sub run_command ( $ws ) {
app->log->debug( "In run_command: $ws" );
open my $fh, "$^X -le '\$|++; while(1) { print int rand(100); sleep 3 }' |";
$fh->autoflush;
my $id;
$id = Mojo::IOLoop->recurring( 1 => sub ($loop) {
my $m = <$fh>;
unless( defined $m ) {
app->log->debug( "Closing down recurring loop from the inside [$id]" );
# XXX: what should I do here?
close $fh;
return;
};
chomp $m;
app->log->debug( "Input [$m] for [$id] from $fh" );
$ws->send( encode_json( { 'm' => $m } ) );
});
return $id;
}
Other questions that may benefit from this answer:
Output command to socket without buffering using Mojo::IOLoop
I played around with this a bit. Logioniz's answer made me think that I shouldn't be polling or handling the filehandle details myself. I still don't know where it was hanging.
Instead, I used Mojo::Reactor's io to set a filehandle to monitor:
sub run_command ( $ws ) {
my $pid = open my $fh, "$^X -le '\$|++; print \$\$; while(1) { print int rand(100); sleep 3 }' |";
$fh->autoflush;
my $reactor = Mojo::IOLoop->singleton->reactor->io(
$fh => sub ($reactor, $writeable) {
my $m = <$fh>;
chomp $m;
$ws->send( encode_json( { 'm' => $m } ) );
}
);
return ( $fh, $pid );
}
When I'm done with that command, I can unwatch that filehandle and kill the process. I finish the websocket:
elsif( $command eq "stop" ) {
$loop->reactor->watch( $fh, 0, 0 );
kill 'KILL', $pid or app->log->debug( "Could not kill $pid: $!" );
$ws->finish;
}
I still don't know why remove($fh) doesn't work. I figure I'm leaking some IOLoop things doing it this way.
I think that you block event loop because your recurrent invoke every second and my $m = <$fh>; wait result about 2-3 second. So you block event loop.
I think so because when i run your app the event finish not call on inactivity timeout, but call event recurrent. finish event MUST call on inactivity timeout always.
I think that your code must be in separate process to avoid blocking event loop.
Try to use this module to execute in separate process.
I write small example.

Perl creating a pipe and fork a sub-process

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)$/;
...
}

How to get status update in NCBI standalone BLAST?

For example, I am running standalone Blast+ for thousands of EST sequences with remote (NCBI) server. I am not getting any status message like 15 of 100 sequence is running. Is it possible to get any status message like that? or any other way to send one after another sequence using perl scripts?
Many thanks!
I suggest using Bioperl (http://metacpan.org/pod/BioPerl) and the Bio::Tools::Run::RemoteBlast module. See http://metacpan.org/pod/Bio::Tools::Run::RemoteBlast and here is the code example they give in the RemoteBlast.pm module
while (my $input = $str->next_seq()){
#Blast a sequence against a database:
#Alternatively, you could pass in a file with many
#sequences rather than loop through sequence one at a time
#Remove the loop starting 'while (my $input = $str->next_seq())'
#and swap the two lines below for an example of that.
my $r = $factory->submit_blast($input);
#my $r = $factory->submit_blast('amino.fa');
print STDERR "waiting..." if( $v > 0 );
while ( my #rids = $factory->each_rid ) {
foreach my $rid ( #rids ) {
my $rc = $factory->retrieve_blast($rid);
if( !ref($rc) ) {
if( $rc < 0 ) {
$factory->remove_rid($rid);
}
print STDERR "." if ( $v > 0 );
sleep 5;
} else {
my $result = $rc->next_result();
#save the output
my $filename = $result->query_name()."\.out";
$factory->save_output($filename);
$factory->remove_rid($rid);
print "\nQuery Name: ", $result->query_name(), "\n";
while ( my $hit = $result->next_hit ) {
next unless ( $v > 0);
print "\thit name is ", $hit->name, "\n";
while( my $hsp = $hit->next_hsp ) {
print "\t\tscore is ", $hsp->score, "\n";
}
}
}
}
}
}
Look at the method retrieve_blast (http://metacpan.org/pod/Bio::Tools::Run::RemoteBlast#retrieve_blast). It will return a status code to let you know if the blast job is finished. Let me know if you have more questions and I will try to clarify further.
Paul

Is it unpolite to put an END block in a module?

Would it be OK to keep the END block in this example, because nobody wants a broken terminal or shouldn't I put an END block in a module?
package My_Package;
use warnings;
use strict;
use Term::ReadKey;
sub _init_scr {
my ( $arg ) = #_;
$arg->{backup_flush} = $|;
$| = 1;
Term::ReadKey::ReadMode 'ultra-raw';
}
sub _end_win {
my ( $arg ) = #_;
print "\n\r";
Term::ReadKey::ReadMode 'restore';
$| = $arg->{backup_flush};
}
END {
Term::ReadKey::ReadMode 'restore';
}
sub my_function {
my $arg = {};
_init_scr( $arg );
while ( 1 ) {
my $c = ReadKey 0;
if ( ! defined $c ) {
_end_win( $arg );
warn "EOT";
return;
}
next if $c eq "\e";
given ( $c ) {
when ( $c ge 'a' && $c le 'z' ) {
print $c;
$arg->{string} .= $c;
}
when ( $c eq "\cC" ) {
_end_win( $arg );
print STDERR "^C";
kill( 'INT', $$ );
return;
}
when ( $c eq "\r" ) {
_end_win( $arg );
return $arg->{string};
}
}
}
}
If your module changes the terminal mode, then I would think the most polite thing to do would be for it to also install an END block to restore the terminal mode before the program exits.
No, it's polite and expected that you put things back as you found them.
However, it's unwelcome to tidy up someone else's workspace unless you've been asked to do so.
That is, your END routine shouldn't run unless it has reason to do so, and your module probably ought to allow a developer to disable the automatic cleanup. (E.g., use My_Package qw(:no_auto_restore).)
Failing that, the POD ought to explicitly document that the module fiddles with a system resource upon exit.