IO handle for STDOUT in Perl on Windows when forking?
I have the following problem: I try to port a perl script to windows. The script forks itself quite often, and uses this code to fork:
sub sub_fork {
my ( $subref, @args ) = @_;
my $fh = new IO::Handle;
my $pid = open( $fh, "-|" );
if ( $pid ) {开发者_StackOverflow # parent
return ( $fh, $pid );
}
else {
&$subref( @args );
exit;
}
}
Windows doesn't like the "-|" it seems. I actually had no idea what this does, as a windows-guy, but there is some interesting stuff here: http://www.cs.tufts.edu/comp/150PPP/notes/perl_ipc.php (search for "Fancy opens") The code is used quite often in the script, so I want to replace the sub with one that works exactly the same, meaning it returns $fh, $pid where $fh is a handle to the stdout of the child.
This construction is used for interprocess communication, specifically to create a filehandle that reads from a new background process's standard output.
my $pid = open my $fh, "-|";
if ($pid == 0) { # child
print "Hello world\n";
exit;
}
print <$fh>; # Hello world\n
See the perlipc
doc for some reasons why this construction is useful.
This only works on systems with a "true fork", though, which excludes Windows. A Windows workaround would involve using socketpair
to create some sockets for IPC (pipe
, alas, isn't up to the task on Windows either). Something like this will work:
sub sub_fork {
my ($subref, @args) = @_;
use Socket;
my ($READER, $WRITER);
socketpair $READER, $WRITER, AF_UNIX, SOCK_STREAM, PF_UNSPEC;
shutdown($READER,1); # close write channel for $READER
shutdown($WRITER,0); # and read channel for $WRITER
my $pid = fork();
if ( $pid ) {
return ($READER, $pid);
} else {
close STDOUT;
open STDOUT, '>&' . fileno($WRITER); # dup STDOUT to print to $WRITER
&$subref(@args);
# both of these steps are required before you exit the child
close STDOUT;
shutdown($WRITER,1);
exit;
}
}
The Forks::Super
module (which I wrote) can also tackle this task in Windows.
use Forks::Super;
sub sub_fork {
my ($subref, @args) = @_;
my $pid = fork { child_fh => 'out' }; # make child's STDOUT available
if ($pid != 0) {
return ($Forks::Super::CHILD_STDOUT{$pid}, $pid);
#alternate: return ($pid->{child_stdout}, $pid);
} else {
&$subref(@args);
exit;
}
}
or even more succintly
use Forks::Super;
sub sub_fork {
my ($subref, @args) = @_;
my $pid = fork {
child_fh => 'out',
sub => $subref, args => \@args # run $subref->(@args) in child
};
return ($Forks::Super::CHILD_STDOUT{$pid}, $pid);
}
精彩评论