perl / embperl – IPC :: Open3

我有一个样本程序的两种格式的Perl和embperl

perl版本作为一个CGI,但embperl版本不起作用。

任何build议或指针解决scheme,将不胜感激

操作系统:Linux版本2.6.35.6-48.fc14.i686.PAE(…)(gcc版本4.5.1 20100924(红帽4.5.1-4)(GCC))#1 SMP周五10月22日15:27: 2010年UTC

注:我最初发布这个问题perlmonks [x]和emberl邮件列表[x]但没有得到解决scheme。

perl工作脚本

#!/usr/bin/perl use warnings; use strict; use IPC::Open3; print "Content-type: text/plain\n\n"; my $cmd = 'ls'; my $pid = open3(*HIS_IN, *HIS_OUT, *HIS_ERR, $cmd); close(HIS_IN); # give end of file to kid, or feed him my @outlines = <HIS_OUT>; # read till EOF my @errlines = <HIS_ERR>; # XXX: block potential if massive print "STDOUT: ", @outlines, "\n"; print "STDERR: ", @errlines, "\n"; waitpid( $pid, 0 ); my $child_exit_status = $? >> 8; print "child_exit_status: $child_exit_status\n"; 

embperl非工作脚本

 [- use warnings; use strict; use IPC::Open3; my $cmd = 'ls'; my $pid = open3(*HIS_IN, *HIS_OUT, *HIS_ERR, $cmd); close(HIS_IN); # give end of file to kid, or feed him my @outlines = <HIS_OUT>; # read till EOF my @errlines = <HIS_ERR>; # XXX: block potential if massive print OUT "STDOUT: ", @outlines, "\n"; print OUT "STDERR: ", @errlines, "\n"; waitpid( $pid, 0 ); my $child_exit_status = $? >> 8; print OUT "child_exit_status: $child_exit_status\n"; -] 

这是我收到的输出

 STDERR: ls: write error: Bad file descriptor child_exit_status: 2 

open3重定向与STDOUT相关的文件描述符,除了它是fd 1 (你exec的程序会考虑STDOUT)。 但不是1 。 它甚至没有与它关联的文件描述符! 我认为这是open3一个错误。 我想你可以解决它,如下所示:

 local *STDOUT; open(STDOUT, '>&=', 1) or die $!; ...open3... 

非常感谢你ikegami !!!!

这是工作的embperl代码。 PS STDIN有类似的问题。 我还不知道这个解决方案,但我认为它是相似的。

 [- use warnings; use strict; use IPC::Open3; use POSIX; $http_headers_out{'Content-Type'} = "text/plain"; my $cmd = 'ls'; open(my $fh, '>', '/dev/null') or die $!; dup2(fileno($fh), 1) or die $! if fileno($fh) != 1; local *STDOUT; open(STDOUT, '>&=', 1) or die $!; my $pid = open3(*HIS_IN, *HIS_OUT, *HIS_ERR, $cmd); close(HIS_IN); # give end of file to kid, or feed him my @outlines = <HIS_OUT>; # read till EOF my @errlines = <HIS_ERR>; # XXX: block potential if massive print OUT "STDOUT: ", @outlines, "\n"; print OUT "STDERR: ", @errlines, "\n"; waitpid( $pid, 0 ); my $child_exit_status = $? >> 8; print OUT "child_exit_status: $child_exit_status\n"; -]