perl / embperl — IPC :: Open3

Question

我有2種格式的示例程序perl和embperl

perl版本可用作CGI，但embperl版本不起作用。

任何建議或解決方案的指針將不勝感激

操作系統：Linux版本2.6.35.6-48.fc14.i686.PAE（...）（gcc版本4.5.1 20100924（Red Hat 4.5.1-4）（GCC））＃1 SMP 10月22日星期五15:27： 53 UTC 2010

注意：我最初將此問題發布到perlmonks [x]和embperl郵件列表[x]，但沒有得到解決方案。

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

Answer 1

open3重定向與STDOUT關聯的文件描述符，但文件描述符為fd 1 （您exec的程序將其視為STDOUT的文件）。 但這不是1 。 它甚至沒有與之關聯的文件描述符！ 我認為這是open3的錯誤。 我認為您可以按照以下方法解決它：

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

Answer 2

非常感謝池上 !!!!

這是有效的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";
-]