in reply to Re: why IPC::Open3 can't execute MS-DOS "dir" command? in thread why IPC::Open3 can't execute MS-DOS "dir" command?
If passed the ends of socket pairs instead of unopened handled, you could use open3 on Windows. I think the following will allow you to use select on Windows too:
use Socket qw( AF_INET SOCK_STREAM PF_UNSPEC );
use IPC::Open3 qw( open3 );
sub _pipe {
socketpair($_[0], $_[1], AF_INET, SOCK_STREAM, PF_UNSPEC)
or return undef;
shutdown($_[0], 1); # No more writing for reader
shutdown($_[1], 0); # No more reading for writer
return 1;
}
sub _open3 {
local (*TO_CHLD_R, *TO_CHLD_W);
local (*FR_CHLD_R, *FR_CHLD_W);
local (*FR_CHLD_ERR_R, *FR_CHLD_ERR_W);
if ($^O =~ /Win32/) {
_pipe(*TO_CHLD_R, *TO_CHLD_W ) or die $!;
_pipe(*FR_CHLD_R, *FR_CHLD_W ) or die $!;
_pipe(*FR_CHLD_ERR_R, *FR_CHLD_ERR_W) or die $!;
} else {
pipe(*TO_CHLD_R, *TO_CHLD_W ) or die $!;
pipe(*FR_CHLD_R, *FR_CHLD_W ) or die $!;
pipe(*FR_CHLD_ERR_R, *FR_CHLD_ERR_W) or die $!;
}
my $pid = open3('>&TO_CHLD_R', '<&FR_CHLD_W', '<&FR_CHLD_ERR_W', @
+_);
return ( $pid, *TO_CHLD_W, *FR_CHLD_R, *FR_CHLD_ERR_R );
}
my ($pid, $to_chld, $fr_chld, $fr_chld_err) = _open3(...);
Re^3: why IPC::Open3 can't execute MS-DOS "dir" command?
by BrowserUk (Patriarch) on Dec 04, 2009 at 19:56 UTC
|
| [reply] |
Re^3: why IPC::Open3 can't execute MS-DOS "dir" command?
by Anonymous Monk on Dec 07, 2009 at 01:45 UTC
|
Unknown error at C:\811150.pl line 18
use Socket qw( AF_INET SOCK_STREAM PF_UNSPEC );
use IPC::Open3 qw( open3 );
sub _pipe {
socketpair($_[0], $_[1], AF_INET, SOCK_STREAM, PF_UNSPEC)
or return undef;
shutdown($_[0], 1); # No more writing for reader
shutdown($_[1], 0); # No more reading for writer
return 1;
}
sub _open3 {
local (*TO_CHLD_R, *TO_CHLD_W);
local (*FR_CHLD_R, *FR_CHLD_W);
local (*FR_CHLD_ERR_R, *FR_CHLD_ERR_W);
if ($^O =~ /Win32/) {
_pipe(*TO_CHLD_R, *TO_CHLD_W ) or die $!;
_pipe(*FR_CHLD_R, *FR_CHLD_W ) or die $!;
_pipe(*FR_CHLD_ERR_R, *FR_CHLD_ERR_W) or die $!;
} else {
pipe(*TO_CHLD_R, *TO_CHLD_W ) or die $!;
pipe(*FR_CHLD_R, *FR_CHLD_W ) or die $!;
pipe(*FR_CHLD_ERR_R, *FR_CHLD_ERR_W) or die $!;
}
my $pid = open3('>&TO_CHLD_R', '<&FR_CHLD_W', '<&FR_CHLD_ERR_W', @
+_);
return ( $pid, *TO_CHLD_W, *FR_CHLD_R, *FR_CHLD_ERR_R );
}
my $log="TestOpen3.log";
open FHO, ">$log";
select FHO;
my ($pid, $to_chld, $fr_chld, $fr_chld_err) = _open3("cmd /c dir * \/b
+\/s");
if((my $returnCode = $? >> 8) !=0){
print "[ERROR] ($returnCode) : ";
while(<$fr_chld_err>)
{
print;
}
close $fr_chld_err;
die $returnCode;
}
while(<$fr_chld>)
{
print "\t".$_;
}
close $fr_chld;
close FHO;
| [reply] [d/l] [select] |
|
use strict;
use warnings;
use IO::Select qw( );
use IPC::Open3 qw( open3 );
use Socket qw( AF_UNIX SOCK_STREAM PF_UNSPEC );
sub _pipe {
socketpair($_[0], $_[1], AF_UNIX, SOCK_STREAM, PF_UNSPEC)
or return undef;
shutdown($_[0], 1); # No more writing for reader
shutdown($_[1], 0); # No more reading for writer
return 1;
}
sub _open3 {
local (*TO_CHLD_R, *TO_CHLD_W);
local (*FR_CHLD_R, *FR_CHLD_W);
local (*FR_CHLD_ERR_R, *FR_CHLD_ERR_W);
if ($^O =~ /Win32/) {
_pipe(*TO_CHLD_R, *TO_CHLD_W ) or die $^E;
_pipe(*FR_CHLD_R, *FR_CHLD_W ) or die $^E;
_pipe(*FR_CHLD_ERR_R, *FR_CHLD_ERR_W) or die $^E;
} else {
pipe(*TO_CHLD_R, *TO_CHLD_W ) or die $!;
pipe(*FR_CHLD_R, *FR_CHLD_W ) or die $!;
pipe(*FR_CHLD_ERR_R, *FR_CHLD_ERR_W) or die $!;
}
my $pid = open3('>&TO_CHLD_R', '<&FR_CHLD_W', '<&FR_CHLD_ERR_W', @
+_);
return ( $pid, *TO_CHLD_W, *FR_CHLD_R, *FR_CHLD_ERR_R );
}
my ($pid, $to_chld, $fr_chld, $fr_chld_err) =
_open3('cmd /c "dir /s/b"');
my %objs;
my $in_sel = IO::Select->new();
my $out_sel = IO::Select->new();
for my $fh ($fr_chld, $fr_chld_err) {
my $obj = {
buf => '',
};
$objs{ fileno($fh) } = $obj;
$in_sel->add($fh);
}
close($to_chld);
while ($in_sel->count() + $out_sel->count()) {
my ($ins, $outs) = IO::Select::select($in_sel, $out_sel, undef);
for my $fh (@$ins) {
my $obj = $objs{ fileno($fh) };
our $buf; local *buf = \( $obj->{buf} );
my $bytes_read = sysread($fh, $buf, 64*1024, length($buf));
if (!$bytes_read) {
warn("Error reading from child: $!\n")
if !defined($bytes_read);
$in_sel->remove($fh);
}
}
for my $fh (@$outs) {
}
}
waitpid($pid, 0);
print("STDOUT:\n$objs{ fileno( $fr_chld ) }{buf}");
print("\n";
print("STDERR:\n$objs{ fileno( $fr_chld_err ) }{buf}");
| [reply] [d/l] |
|
_pipe(*TO_CHLD_R, *TO_CHLD_W ) or die $!;
_pipe(*FR_CHLD_R, *FR_CHLD_W ) or die $!;
_pipe(*FR_CHLD_ERR_R, *FR_CHLD_ERR_W) or die $!;
to
_pipe(*TO_CHLD_R, *TO_CHLD_W ) or die $^E;
_pipe(*FR_CHLD_R, *FR_CHLD_W ) or die $^E;
_pipe(*FR_CHLD_ERR_R, *FR_CHLD_ERR_W) or die $^E;
to get a better error message.
| [reply] [d/l] [select] |
|
|