开发者

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

上一篇:

下一篇:

精彩评论

暂无评论...
验证码 换一张
取 消

最新问答

问答排行榜