2

perl と embperl の 2 つの形式のサンプル プログラムがあります。

perl 版は CGI として動作しますが、embperl 版は動作しません。

解決策への提案や指針をいただければ幸いです

OS: Linux バージョン 2.6.35.6-48.fc14.i686.PAE (...) (gcc バージョン 4.5.1 20100924 (Red Hat 4.5.1-4) (GCC) ) #1 SMP Fri Oct 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";

emperlの動かないスクリプト

[-
  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
4

2 に答える 2

1

open3fd（ STDOUTと見なす1プログラム）を除いて、STDOUTに関連付けられたファイル記述子をリダイレクトします。execしかし、そうではありません1。それに関連付けられたファイル記述子すらありません! これは のバグだと思いopen3ます。以下の方法で回避できると思います。

local *STDOUT;
open(STDOUT, '>&=', 1) or die $!;
...open3...
于 2014-05-21T23:42:50.907 に答える
0

池上さん本当にありがとう！！！

これが機能する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";
-]
于 2014-05-22T21:24:23.653 に答える