Goff, Nathan wrote:
> Below is a simple example of a more complex mulit-platform perl script that I have
>written. Basically, a child process(thread) needs to be able to redirect STDOUT and
>STDERR to files. When the child process does so in the script below I get STDERR &
>STDOUT print statements in the files, but the STDOUT from the system command still
>goes to the screen. The STDERR seems to go correctly to the file. I was able to dig
>up a bug report that described a similar problem. Is there a version of activeperl
>that fixes this problem? If not, is there a workaround?
>
> It only happens when the fork() call is involved and it works properly when I use
>the cygwin port of perl.
>
> I have tried it on activeperl 5.6.1 build 628 & 633.
>
> Thanks,
>
> Nathan Goff
> Build Engineer
> Mentor Graphics Corp
>
> $SIG{'CHLD'} = 'IGNORE';
> $ERR_FILE = "c:\\tmp\\err.txt";
> $OUT_FILE = "c:\\tmp\\out.txt";
>
> unlink($ERR_FILE);
> unlink($OUT_FILE);
>
> while(TRUE)
> {
> #print STDOUT "parent\n";
> #print STDERR "parent\n";
> #open(SAVEOUT, ">&STDOUT");
> #open(SAVEERR, ">&STDERR");
>
> close(STDOUT);
> close(STDERR);
You're closing STDOUT/ERR here which means you can't get them back in run.
> $pid1 = fork();
>
> if($pid1 == 0)
> {
> run();
> exit(0);
> }
>
> sleep(5);
> }
>
>
> sub run
> {
> open(SAVEOUT, ">&STDOUT");
> open(SAVEERR, ">&STDERR");
STDOUT and STDERR are already closed from main routine.
> open(STDERR,">>${ERR_FILE}");
> open(STDOUT,">>${OUT_FILE}");
>
> print STDOUT "child_file_out\n";
> print STDERR "child_file_err\n";
>
> system("xcopy");
>
> close(STDERR);
> close(STDOUT);
>
> open(STDOUT, ">&SAVEOUT");
> open(STDERR, ">&SAVEERR");
>
> print STDOUT "child_screen_out\n";
> print STDERR "child_screen_err\n";
> }
This test seems to function as expected:
my $ERR_FILE = "c:\\tmp\\err.txt";
my $OUT_FILE = "c:\\tmp\\out.txt";
unlink $ERR_FILE;
unlink $OUT_FILE;
foreach (1 .. 3) {
print STDOUT "parentscreenout ($_)\n"; # prints to screen
print STDERR "parentscreenerr ($_)\n"; # prints to screen
my $pid1 = fork ();
if ($pid1 == 0) {
run ($_);
exit 0;
}
sleep 5;
print STDOUT "parentscreenout2 ($_)\n"; # prints to screen
print STDERR "parentscreenerr2 ($_)\n"; # prints to screen
}
exit;
sub run {
local $_ = shift;
print STDOUT "childscreenout ($_)\n"; # prints to screen
print STDERR "childscreenerr ($_)\n"; # prints to screen
open SAVEOUT, ">&STDOUT";
open SAVEERR, ">&STDERR";
open STDERR, ">>${ERR_FILE}";
open STDOUT, ">>${OUT_FILE}";
print STDOUT "child_file_out ($_)\n"; # prints to file
print STDERR "child_file_err ($_)\n"; # prints to file
close STDERR;
close STDOUT;
open STDOUT, ">&SAVEOUT";
open STDERR, ">&SAVEERR";
print STDOUT "childscreenout2 ($_)\n"; # prints to screen
print STDERR "childscreenerr2 ($_)\n"; # prints to screen
}
__END__
--
,-/- __ _ _ $Bill Luebkert ICQ=162126130
(_/ / ) // // DBE Collectibles Mailto:[EMAIL PROTECTED]
/ ) /--< o // // http://dbecoll.tripod.com/ (Free site for Perl)
-/-' /___/_<_</_</_ Castle of Medieval Myth & Magic http://www.todbe.com/
_______________________________________________
ActivePerl mailing list
[EMAIL PROTECTED]
To unsubscribe: http://listserv.ActiveState.com/mailman/mysubs
