Mailing List Archive: perl / embperl -- IPC::Open3 (with readable code)

Ack... Sorry about the last email with unreadable code. My email system does something strange with some text. Here is the email again with readable code.

Hello.

I have a sample program in 2 formats perl & embperl.

The perl version works as a CGI but the embperl version does not work.

Any suggestions or pointers to solutions would be appreciated

OS: Linux version 2.6.35.6-48.fc14.i686.PAE (...) (gcc version 4.5.1 20100924 (Red Hat 4.5.1-4) (GCC) ) #1 SMP Fri Oct 22 15:27:53 UTC 2010

perl working script:

#!/usr/bin/perl
use warnings;
use strict;
use IPC::Open3;
use Symbol 'gensym';

print "Content-type: text/plain\n\n";

my $cmd = '/bin/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 non-working script:

Here is the output I receive.
STDERR: ls: write error: Bad file descriptor

child_exit_status: 2

[.-
use warnings;
use strict;
use IPC::Open3;
use Symbol 'gensym';

$http_headers_out{'Content-Type'} = "text/plain";

my $cmd = '/bin/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";
-]

With the help of user ikegami over at stackoverflow. The following solutions works.

[.-
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";
-]