App-Dex
view release on metacpan or search on metacpan
scripts/dex view on Meta::CPAN
=head1 SYNOPSIS
use IPC::Run3; # Exports run3() by default
run3 \@cmd, \$in, \$out, \$err;
=head1 DESCRIPTION
This module allows you to run a subprocess and redirect stdin, stdout,
and/or stderr to files and perl data structures. It aims to satisfy 99% of the
need for using C<system>, C<qx>, and C<open3>
with a simple, extremely Perlish API.
Speed, simplicity, and portability are paramount. (That's speed of Perl code;
which is often much slower than the kind of buffered I/O that this module uses
to spool input to and output from the child command.)
=cut
use Exporter;
scripts/dex view on Meta::CPAN
my $run_call_time;
my $sys_call_time;
my $sys_exit_time;
sub run3 {
$run_call_time = gettimeofday() if profiling;
my $options = @_ && ref $_[-1] eq "HASH" ? pop : {};
my ( $cmd, $stdin, $stdout, $stderr ) = @_;
print STDERR "run3(): running ",
join( " ", map "'$_'", ref $cmd ? @$cmd : $cmd ),
"\n"
if debugging;
if ( ref $cmd ) {
croak "run3(): empty command" unless @$cmd;
croak "run3(): undefined command" unless defined $cmd->[0];
croak "run3(): command name ('')" unless length $cmd->[0];
} else {
croak "run3(): missing command" unless @_;
croak "run3(): undefined command" unless defined $cmd;
croak "run3(): command ('')" unless length $cmd;
}
foreach (qw/binmode_stdin binmode_stdout binmode_stderr/) {
if (my $mode = $options->{$_}) {
croak qq[option $_ must be a number or a proper layer string: "$mode"]
unless $mode =~ /^(:|\d+$)/;
}
}
my $in_type = _type $stdin;
my $out_type = _type $stdout;
my $err_type = _type $stderr;
if ($fh_cache_pid != $$) {
# fork detected, close all cached filehandles and clear the cache
close $_ foreach values %fh_cache;
%fh_cache = ();
$fh_cache_pid = $$;
}
# This routine proceeds in stages so that a failure in an early
# stage prevents later stages from running, and thus from needing
# cleanup.
my $in_fh = _spool_data_to_child $in_type, $stdin,
$options->{binmode_stdin} if defined $stdin;
my $out_fh = _fh_for_child_output "stdout", $out_type, $stdout,
$options if defined $stdout;
my $tie_err_to_out =
defined $stderr && defined $stdout && $stderr eq $stdout;
my $err_fh = $tie_err_to_out
? $out_fh
: _fh_for_child_output "stderr", $err_type, $stderr,
$options if defined $stderr;
# this should make perl close these on exceptions
# local *STDIN_SAVE;
local *STDOUT_SAVE;
local *STDERR_SAVE;
my $saved_fd0 = dup( 0 ) if defined $in_fh;
# open STDIN_SAVE, "<&STDIN"# or croak "run3(): $! saving STDIN"
# if defined $in_fh;
scripts/dex view on Meta::CPAN
if defined $out_fh;
open STDERR, ">&STDERR_SAVE" or push @errs, "run3(): $! restoring STDERR"
if defined $err_fh;
croak join ", ", @errs if @errs;
die $x unless $ok;
_read_child_output_fh "stdout", $out_type, $stdout, $out_fh, $options
if defined $out_fh && $out_type && $out_type ne "FH";
_read_child_output_fh "stderr", $err_type, $stderr, $err_fh, $options
if defined $err_fh && $err_type && $err_type ne "FH" && !$tie_err_to_out;
$profiler->run_exit(
$cmd,
$run_call_time,
$sys_call_time,
$sys_exit_time,
scalar gettimeofday()
) if profiling;
$! = $errno; # restore $! from system()
return 1;
}
1;
__END__
=head2 C<< run3($cmd, $stdin, $stdout, $stderr, \%options) >>
All parameters after C<$cmd> are optional.
The parameters C<$stdin>, C<$stdout> and C<$stderr> indicate how the child's
corresponding filehandle (C<STDIN>, C<STDOUT> and C<STDERR>, resp.) will be
redirected. Because the redirects come last, this allows C<STDOUT> and
C<STDERR> to default to the parent's by just not specifying them -- a common
use case.
C<run3> throws an exception if the wrapped C<system> call returned -1 or
anything went wrong with C<run3>'s processing of filehandles. Otherwise it
returns true. It leaves C<$?> intact for inspection of exit and wait status.
Note that a true return value from C<run3> doesn't mean that the command had a
scripts/dex view on Meta::CPAN
system @$cmd;
But C<$cmd> may also be a string in which case the child is invoked via
system $cmd;
(cf. L<perlfunc/system> for the difference and the pitfalls of using
the latter form).
=head3 C<$stdin>, C<$stdout>, C<$stderr>
The parameters C<$stdin>, C<$stdout> and C<$stderr> can take one of the
following forms:
=over 4
=item C<undef> (or not specified at all)
The child inherits the corresponding filehandle from the parent.
run3 \@cmd, $stdin; # child writes to same STDOUT and STDERR as parent
run3 \@cmd, undef, $stdout, $stderr; # child reads from same STDIN as parent
=item C<\undef>
The child's filehandle is redirected from or to the local equivalent of
C</dev/null> (as returned by C<< File::Spec->devnull() >>).
run3 \@cmd, \undef, $stdout, $stderr; # child reads from /dev/null
=item a simple scalar
The parameter is taken to be the name of a file to read from
or write to. In the latter case, the file will be opened via
open FH, ">", ...
i.e. it is created if it doesn't exist and truncated otherwise.
Note that the file is opened by the parent which will L<croak|Carp/croak>
scripts/dex view on Meta::CPAN
run3 \@cmd, \<<EOF; # child reads from string (can use "here" notation)
Input
to
child
EOF
=item an ARRAY reference
For C<$stdin>, the elements of C<@$stdin> are simply spooled to the child.
For C<$stdout> or C<$stderr>, the child's corresponding file descriptor
is read line by line (as determined by the current setting of C<$/>)
into C<@$stdout> or C<@$stderr>, resp. The previous content of the array
is overwritten.
my @lines;
run3 \@cmd, \undef, \@lines; # child writes into array
=item a CODE reference
For C<$stdin>, C<&$stdin> will be called repeatedly (with no arguments) and
the return values are spooled to the child. C<&$stdin> must signal the end of
input by returning C<undef>.
For C<$stdout> or C<$stderr>, the child's corresponding file descriptor
is read line by line (as determined by the current setting of C<$/>)
and C<&$stdout> or C<&$stderr>, resp., is called with the contents of the line.
Note that there's no end-of-file indication.
my $i = 0;
sub producer {
return $i < 10 ? "line".$i++."\n" : undef;
}
run3 \@cmd, \&producer; # child reads 10 lines
Note that this form of redirecting the child's I/O doesn't imply
any form of concurrency between parent and child - run3()'s method of
operation is the same no matter which form of redirection you specify.
=back
If the same value is passed for C<$stdout> and C<$stderr>, then the child
will write both C<STDOUT> and C<STDERR> to the same filehandle.
In general, this means that
run3 \@cmd, \undef, "foo.txt", "foo.txt";
run3 \@cmd, \undef, \$both, \$both;
will DWIM and pass a single file handle to the child for both C<STDOUT> and
C<STDERR>, collecting all into file "foo.txt" or C<$both>.
=head3 C<\%options>
The last parameter, C<\%options>, must be a hash reference if present.
Currently the following keys are supported:
=over 4
=item C<binmode_stdin>, C<binmode_stdout>, C<binmode_stderr>
The value must a "layer" as described in L<perlfunc/binmode>. If specified the
corresponding parameter C<$stdin>, C<$stdout> or C<$stderr>, resp., operates
with the given layer.
For backward compatibility, a true value that doesn't start with ":"
(e.g. a number) is interpreted as ":raw". If the value is false
or not specified, the default is ":crlf" on Windows and ":raw" otherwise.
Don't expect that values other than the built-in layers ":raw", ":crlf",
and (on newer Perls) ":bytes", ":utf8", ":encoding(...)" will work.
=item C<append_stdout>, C<append_stderr>
If their value is true then the corresponding parameter C<$stdout> or
C<$stderr>, resp., will append the child's output to the existing "contents" of
the redirector. This only makes sense if the redirector is a simple scalar (the
corresponding file is opened in append mode), a SCALAR reference (the output is
appended to the previous contents of the string) or an ARRAY reference (the
output is C<push>ed onto the previous contents of the array).
=item C<return_if_system_error>
If this is true C<run3> does B<not> throw an exception if C<system> returns -1
(cf. L<perlfunc/system> for possible failure scenarios.), but returns true
instead. In this case C<$?> has the value -1 and C<$!> contains the errno of
the failing C<system> call.
=back
=head1 HOW IT WORKS
=over 4
=item (1)
For each redirector C<$stdin>, C<$stdout>, and C<$stderr>, C<run3()> furnishes
a filehandle:
=over 4
=item *
if the redirector already specifies a filehandle it just uses that
=item *
scripts/dex view on Meta::CPAN
C<run3()> runs the child by invoking L<system|perlfunc/system> with C<$cmd> as
specified above.
=item (5)
C<run3()> restores the parent's C<STDIN>, C<STDOUT> and C<STDERR> saved in step (3).
=item (6)
If C<run3()> opened a temporary file for C<$stdout> or C<$stderr> in step (1),
it rewinds it and reads back its contents using the specified method (either to
a string, an array or by calling a function).
=item (7)
C<run3()> closes all filehandles that it opened explicitly in step (1).
=back
Note that when using temporary files, C<run3()> tries to amortize the overhead
xt/author/00-compile.t view on Meta::CPAN
use File::Spec;
use IPC::Open3;
use IO::Handle;
open my $stdin, '<', File::Spec->devnull or die "can't open devnull: $!";
my @warnings;
for my $lib (@module_files)
{
# see L<perlfaq8/How can I capture STDERR from an external command?>
my $stderr = IO::Handle->new;
diag('Running: ', join(', ', map { my $str = $_; $str =~ s/'/\\'/g; q{'} . $str . q{'} }
$^X, @switches, '-e', "require q[$lib]"))
if $ENV{PERL_COMPILE_TEST_DEBUG};
my $pid = open3($stdin, '>&STDERR', $stderr, $^X, @switches, '-e', "require q[$lib]");
binmode $stderr, ':crlf' if $^O eq 'MSWin32';
my @_warnings = <$stderr>;
waitpid($pid, 0);
is($?, 0, "$lib loaded ok");
shift @_warnings if @_warnings and $_warnings[0] =~ /^Using .*\bblib/
and not eval { +require blib; blib->VERSION('1.01') };
if (@_warnings)
{
warn @_warnings;
push @warnings, @_warnings;
xt/author/00-compile.t view on Meta::CPAN
{ SKIP: {
open my $fh, '<', $file or warn("Unable to open $file: $!"), next;
my $line = <$fh>;
close $fh and skip("$file isn't perl", 1) unless $line =~ /^#!\s*(?:\S*perl\S*)((?:\s+-\w*)*)(?:\s*#.*)?$/;
@switches = (@switches, split(' ', $1)) if $1;
close $fh and skip("$file uses -T; not testable with PERL5LIB", 1)
if grep { $_ eq '-T' } @switches and $ENV{PERL5LIB};
my $stderr = IO::Handle->new;
diag('Running: ', join(', ', map { my $str = $_; $str =~ s/'/\\'/g; q{'} . $str . q{'} }
$^X, @switches, '-c', $file))
if $ENV{PERL_COMPILE_TEST_DEBUG};
my $pid = open3($stdin, '>&STDERR', $stderr, $^X, @switches, '-c', $file);
binmode $stderr, ':crlf' if $^O eq 'MSWin32';
my @_warnings = <$stderr>;
waitpid($pid, 0);
is($?, 0, "$file compiled ok");
shift @_warnings if @_warnings and $_warnings[0] =~ /^Using .*\bblib/
and not eval { +require blib; blib->VERSION('1.01') };
# in older perls, -c output is simply the file portion of the path being tested
if (@_warnings = grep { !/\bsyntax OK$/ }
grep { chomp; $_ ne (File::Spec->splitpath($file))[2] } @_warnings)
{
( run in 0.239 second using v1.01-cache-2.11-cpan-26ccb49234f )