Plack-App-MCCS
view release on metacpan or search on metacpan
local/lib/perl5/IPC/Run.pm view on Meta::CPAN
=head1 LIMITATIONS
On Unix, requires a system that supports C<waitpid( $pid, WNOHANG )> so
it can tell if a child process is still running.
PTYs don't seem to be non-blocking on some versions of Solaris. Here's a
test script contributed by Borislav Deianov <borislav@ensim.com> to see
if you have the problem. If it dies, you have the problem.
#!/usr/bin/perl
use IPC::Run qw(run);
use Fcntl;
use IO::Pty;
sub makecmd {
return ['perl', '-e',
'<STDIN>, print "\n" x '.$_[0].'; while(<STDIN>){last if /end/}'];
}
#pipe R, W;
#fcntl(W, F_SETFL, O_NONBLOCK);
#while (syswrite(W, "\n", 1)) { $pipebuf++ };
#print "pipe buffer size is $pipebuf\n";
my $pipebuf=4096;
my $in = "\n" x ($pipebuf * 2) . "end\n";
my $out;
$SIG{ALRM} = sub { die "Never completed!\n" };
print "reading from scalar via pipe...";
alarm( 2 );
run(makecmd($pipebuf * 2), '<', \$in, '>', \$out);
alarm( 0 );
print "done\n";
print "reading from code via pipe... ";
alarm( 2 );
run(makecmd($pipebuf * 3), '<', sub { $t = $in; undef $in; $t}, '>', \$out);
alarm( 0 );
print "done\n";
$pty = IO::Pty->new();
$pty->blocking(0);
$slave = $pty->slave();
while ($pty->syswrite("\n", 1)) { $ptybuf++ };
print "pty buffer size is $ptybuf\n";
$in = "\n" x ($ptybuf * 3) . "end\n";
print "reading via pty... ";
alarm( 2 );
run(makecmd($ptybuf * 3), '<pty<', \$in, '>', \$out);
alarm(0);
print "done\n";
No support for ';', '&&', '||', '{ ... }', etc: use perl's, since run()
returns TRUE when the command exits with a 0 result code.
Does not provide shell-like string interpolation.
No support for C<cd>, C<setenv>, or C<export>: do these in an init() sub
run(
\cmd,
...
init => sub {
chdir $dir or die $!;
$ENV{FOO}='BAR'
}
);
Timeout calculation does not allow absolute times, or specification of
days, months, etc.
B<WARNING:> Function coprocesses (C<run \&foo, ...>) suffer from two
limitations. The first is that it is difficult to close all filehandles the
child inherits from the parent, since there is no way to scan all open
FILEHANDLEs in Perl and it both painful and a bit dangerous to close all open
file descriptors with C<POSIX::close()>. Painful because we can't tell which
fds are open at the POSIX level, either, so we'd have to scan all possible fds
and close any that we don't want open (normally C<exec()> closes any
non-inheritable but we don't C<exec()> for &sub processes.
The second problem is that Perl's DESTROY subs and other on-exit cleanup gets
run in the child process. If objects are instantiated in the parent before the
child is forked, the DESTROY will get run once in the parent and once in
the child. When coprocess subs exit, POSIX::_exit is called to work around this,
but it means that objects that are still referred to at that time are not
cleaned up. So setting package vars or closure vars to point to objects that
rely on DESTROY to affect things outside the process (files, etc), will
lead to bugs.
I goofed on the syntax: "<pipe" vs. "<pty<" and ">filename" are both
oddities.
=head1 TODO
=over
=item Allow one harness to "adopt" another:
$new_h = harness \@cmd2;
$h->adopt( $new_h );
=item Close all filehandles not explicitly marked to stay open.
The problem with this one is that there's no good way to scan all open
FILEHANDLEs in Perl, yet you don't want child processes inheriting handles
willy-nilly.
=back
=head1 INSPIRATION
Well, select() and waitpid() badly needed wrapping, and open3() isn't
open-minded enough for me.
The shell-like API inspired by a message Russ Allbery sent to perl5-porters,
which included:
I've thought for some time that it would be
( run in 4.658 seconds using v1.01-cache-2.11-cpan-5b529ec07f3 )