Jos I. Boumans wrote:
>On Feb 18, 2005, at 2:10 PM, Steve Hay wrote:
>
>
>
>
>>The attached program contains what I believe is the relevant code,
>>lifted from CPANPLUS::Tools::Cmd, to try open IPC::Open3 vs IPC::Run.
>>
>>
>Best to lift from IPC::Cmd, as that's the library we're actually using
>-- cpanplus::tools::cmd is rather obsolete (luckily the ipc::open3
>implementation hasn't changed.. the ipc::run one has though)
>
>
OK, I've updated the attached program to use code from IPC::Cmd.
>
>
>
>
>
>>Presumably IO::Select->can_read() doesn't work on Win32 because it
>>uses a 4-arg select(), which is only implemented for sockets on Win32.
>> Is the above change safe, or did we need to call can_read() for some
>>reason? Would the proposed "selectable pipes" change have any impact
>>on this?
>>
>>
>I have no idea myself, i'm not much of an IPC guru, i just RTFM'd on
>this. But if others can assure me it's safe & portable, it's an easy
>patch to do.
>
>
Ton says it isn't (always) safe, so I think that's not the way to go :(
>
>
>>What do I need to do to test out whether IPC::Open3 is working with
>>pipes or not? (Open3.t doesn't seem to include any such tests.)
>>
>>
>That might be a very useful addition to the open3.t tests...
>Perhaps something like this would work as a test case:
> "$^X -e'print 1' | $^X -e'print 1 + <>'"
>
I've put that $cmd into the attached test.pl, but something's not
right. The IPC::Run version with this new $cmd doesn't work. It gives
me the error:
'ARRAY' not allowed as a source for input redirection at test.pl line 68
I think the scan for $special_chars has got confused over the "<>" in
the Perl one-liner -- it thinks they are shell redirection characters.
Presumably this would affect other OS's too, and is really a bug in
IPC::Cmd?
Using IPC::Open3 I get the same as "perl -v" gave me before:
err=[0]
buffer=[]
buferr=[]
bufout=[]
and again removing the can_read() calls "fixes" it:
err=[0]
buffer=[2]
buferr=[]
bufout=[2]
That's great news, as it gives us hope that IPC::Open3 + pipes is OK.
So the only issue here is that can_read() doesn't work because pipes
aren't selectable on Win32. I'm therefore interested what work would be
involved (either using C code in the core, or equivalent Perl code in
IPC::Cmd) to fix it.
- Steve
------------------------------------------------
Radan Computational Ltd.
The information contained in this message and any files transmitted with it are
confidential and intended for the addressee(s) only. If you have received this
message in error or there are any problems, please notify the sender
immediately. The unauthorized use, disclosure, copying or alteration of this
message is strictly forbidden. Note that any views or opinions presented in
this email are solely those of the author and do not necessarily represent
those of Radan Computational Ltd. The recipient(s) of this message should
check it and any attached files for viruses: Radan Computational will accept no
liability for any damage caused by any virus transmitted by this email.
use strict;
use warnings;
use IPC::Open3;
use IPC::Run;
use IO::Select;
use Symbol;
MAIN: {
my (@buffer,@buferr,@bufout);
my $verbose = 0;
### STDOUT message handler
my $_out_handler = sub {
my $buf = shift;
return unless defined $buf;
print STDOUT $buf if $verbose;
push @buffer, $buf;
push @bufout, $buf;
};
### STDERR message handler
my $_err_handler = sub {
my $buf = shift;
return unless defined $buf;
print STDERR $buf if $verbose;
push @buffer, $buf;
push @buferr, $buf;
};
# my $cmd = "$^X -v";
my $cmd = qq[$^X -e "print 1" | $^X -e "print 1 + <>"];
my @cmd = ref ($cmd) ? grep(length, @{$cmd}) : $cmd;
printf "Running [%s]...\n", join(' ', @cmd) if $verbose;
my $err;
if (@ARGV and $ARGV[0] =~ /run/) {
STDOUT->autoflush(1); STDERR->autoflush(1);
my @command; my $special_chars;
if (ref $cmd) {
my $aref = [];
for my $item (@cmd) {
if ($item =~ /[<>|&]/) {
push @command, $aref, $item;
$aref = [];
$special_chars++;
}
else {
push @$aref, $item;
}
}
push @command, $aref;
}
else {
@command = map { if (/[<>|&]/) {
$special_chars++; $_;
}
else {
[ split / +/ ]
}
} split(/\s*([<>|&])\s*/, $cmd);
}
if ($special_chars) {
IPC::Run::run(@command, \*STDIN, '>', $_out_handler,
'>', $_err_handler) or $err++;
}
else {
IPC::Run::run(@command, \*STDIN, $_out_handler,
$_err_handler) or $err++;
}
}
elsif (@ARGV and $ARGV[0] =~ /open/) {
my $rv;
($rv,$err) = _open3_run([EMAIL PROTECTED], $_out_handler, $_err_handler, $verbose);
}
else {
die "Usage: $0 {run|open}\n";
}
$err ||= $?;
print "err=[$err]\n";
print "[EMAIL PROTECTED]";
print "[EMAIL PROTECTED]";
print "[EMAIL PROTECTED]";
}
sub _open3_run {
my ($cmdref, $_out_handler, $_err_handler, $verbose) = @_;
my $cmd = join " ", @$cmdref;
my ($infh, $outfh, $errfh); # open3 handles
my $pid = eval {
IPC::Open3::open3(
$infh = Symbol::gensym(),
$outfh = Symbol::gensym(),
$errfh = Symbol::gensym(),
$cmd,
)
};
return (undef, $@) if $@;
my $sel = IO::Select->new; # create a select object
$sel->add($outfh, $errfh); # and add the fhs
STDOUT->autoflush(1); STDERR->autoflush(1);
$outfh->autoflush(1) if UNIVERSAL::can($outfh, 'autoflush');
$errfh->autoflush(1) if UNIVERSAL::can($errfh, 'autoflush');
while (my @ready = $sel->can_read) {
foreach my $fh (@ready) { # loop through buffered handles
# read up to 4096 bytes from this fh.
my $len = sysread $fh, my($buf), 4096;
if (not defined $len){
# There was an error reading
warn "Error from child: $!";
return(undef, $!);
}
elsif ($len == 0){
$sel->remove($fh); # finished reading
next;
}
elsif ($fh == $outfh) {
$_out_handler->($buf);
} elsif ($fh == $errfh) {
$_err_handler->($buf);
} else {
warn "IO::Select error";
return(undef, $!);
}
}
}
waitpid $pid, 0; # wait for it to die
return 1;
}
