Windows fork emulation (and buffering?) problem

[Henry Townsend]

This problem involves forks and pipes. Take a look at this code:

pipe(OREADER, OWRITER) || die "$0: pipe(): $!";
my $pid = fork();
if ($pid) {
print "parent\n";
close OWRITER;
print while(<OREADER>);
print "done\n";
wait;
} else {
die "$0: Error: fork(): $!" if !defined($pid);
print "child\n";
close OREADER;
open(STDOUT, ">&OWRITER") || die "$0: Error: STDOUT: $!";
print "data to stdout\n";
}

On Unix it works correctly, printing:

child
parent
data to stdout
done

On Windows, using the emulated fork semantics it prints:

T:\>perl -w moo.pl
parent
child

and hangs. Upon Ctrl-C the message "Terminating on signal SIGINT(2)" is
printed.

This is with Perl 5.8.6, ActiveState build 811. I've read "perldoc
perlfork" and do not see a reason this should not work on Windows. I'm
guessing there's a buffering problem. Pointers to help?

 

[A. Sinan Unur]

This problem involves forks and pipes. Take a look at this code:

pipe(OREADER, OWRITER) || die "$0: pipe(): $!";
my $pid = fork();
if ($pid) {
print "parent\n";
close OWRITER;
print while(<OREADER>);
print "done\n";
wait;
} else {
die "$0: Error: fork(): $!" if !defined($pid);
print "child\n";
close OREADER;
open(STDOUT, ">&OWRITER") || die "$0: Error: STDOUT: $!";
print "data to stdout\n";
}

Not an expert on how these things work, especially the whole dup thing,
but I just checked,

#! /usr/bin/perl

use strict;
use warnings;

pipe my $reader, my $writer or die "Pipe failed: $!";

my $pid = fork();
if ($pid) {
print "parent\n";
close $writer;
print "received: $_" while(<$reader>);
print "done\n";
wait;
} elsif(defined $pid) {
print "child\n";
close $reader;
local(*STDOUT) = $writer;
print "data to writer\n";
} else {
die "Cannot fork: $!";
}
__END__

seems to do what you want on Windows.

That doesn't mean there is no bug, it might also be related to the
warning against potential for deadlock in

perldoc -f pipe

Dunno if this helps any.

Sinan

 

[Henry Townsend]

Not an expert on how these things work, especially the whole dup thing,
but I just checked,

#! /usr/bin/perl

use strict;
use warnings;

pipe my $reader, my $writer or die "Pipe failed: $!";

my $pid = fork();
if ($pid) {
print "parent\n";
close $writer;
print "received: $_" while(<$reader>);
print "done\n";
wait;
} elsif(defined $pid) {
print "child\n";
close $reader;
local(*STDOUT) = $writer;
print "data to writer\n";
} else {
die "Cannot fork: $!";
}
__END__

seems to do what you want on Windows.

That doesn't mean there is no bug, it might also be related to the
warning against potential for deadlock in

perldoc -f pipe

Yes, this works on Windows as well as Unix. Unfortunately I didn't go
into enough detail about what I'm trying to do. I need to capture stdout
and apply a regular expression to it, and when I say stdout I mean data
flowing from subprocesses as well as that originating from the perl
program. My fault for not making the distinction in the first place, but
the original code did an open() of STDOUT and thus operates on the file
*descriptor*, whereas your version operates on the file *handle*. The
difference being in what they do with (say)

system qw(cat file);

I'm moving on, playing with 4-arg select() and will report progress.

 

[A. Sinan Unur]

....

*handle*. The difference being in what they do with (say)

system qw(cat file);

I understand. Now, the question is, are you in control of the system
call above? If you are, and you need to process the output of an
external program, say cat, you could use backticks to launch it, or open
a pipe to it. The former would return all the output, the latter would
allow you to process the output of the external command line by line, as
in:

#! /usr/bin/perl

use strict;
use warnings;

open my $ls, 'ls -l |'
or die "Cannot pipe ls: $!";

while(<$ls>) {
next unless /\.pl$/;
print "Perl file: $_";
}
__END__


D:\Home\asu1\UseNet\clpmisc> myls
Perl file: -rwxr-xr-x 1 asu1 None 919 Jan 16 11:33 050116-a.pl
Perl file: -rwxr-xr-x 1 asu1 None 919 Jan 16 11:33 050116-b.pl
Perl file: -rwxr-xr-x 1 asu1 None 691 Jan 17 12:56 050117-b.pl
Perl file: -rwxr-xr-x 1 asu1 None 295 Jan 17 09:05 051117-a.pl

I am just not sure what you constraints are, so maybe I am suggesting
somehting that is not relevant to the particular problem you are trying
to solve.

Sinan

 

[Henry Townsend]

I understand. Now, the question is, are you in control of the system
call above? If you are, and you need to process the output of an
external program, say cat, you could use backticks to launch it, or open
a pipe to it. The former would return all the output, the latter would
allow you to process the output of the external command line by line, as
in:

Well ... internally we have a LOT of old scripts. I'm hoping to solve
the problem generically in a module (you could go back just a little
ways in clpm to a thread called "output-monitoring module" to see what
I'm trying to achieve) without having to modify the scripts. And of
course I'd like to come out of it with a module I could contribute back
too. That's why I'm trying to find an OS-level solution which happens to
be implemented in Perl rather than a Perl solution.

I could go a bit farther with your idea and override system(), replacing
it with a sub that uses qx(). But I'm not sure how reliably I could
capture every method of creating subprocesses that might be in use down
deep in some script.

 

[A. Sinan Unur]

Well ... internally we have a LOT of old scripts. I'm hoping to solve
the problem generically in a module (you could go back just a little
ways in clpm to a thread called "output-monitoring module" to see what
I'm trying to achieve) without having to modify the scripts.
....

I could go a bit farther with your idea and override system(),
replacing it with a sub that uses qx(). But I'm not sure how reliably
I could capture every method of creating subprocesses that might be in
use down deep in some script.

Well, I am probably missing something here, but this is what I would
have done:

#! /usr/bin/perl
# harness.pl

use strict;
use warnings;

my $oldscript = shift;
$oldscript or die "Please supply the path to script to be run\n";

open my $h, '-|', "perl $oldscript"
or die "Cannot pipe $oldscript: $!";

while(<$h>) {
print "FILTERED: $_";
}
__END__

#! /usr/bin/perl
# tada.pl
use strict;
use warnings;

my @commands = (q{cat test.txt}, q{grep use *.pl});

for my $command (@commands) {
print "Executing $cmd\n";
system $cmd;
}
__END__

D:\Home> harness tada.pl
FILTERED: Executing cat test.txt
FILTERED: lkdsjflkajdflkn
FILTERED:
FILTERED: safdsdflf;keww;dsf
....
FILTERED: Executing grep use *.pl
....
FILTERED: z.pl:use Archive::Zip ':ERROR_CODES';
FILTERED: z.pl:use Fcntl ':seek';
FILTERED: z.pl:use File::Temp 'tempfile';

Does this help?

Sinan