r25296 - in /trunk/libipc-run3-perl: ./ debian/ lib/IPC/ lib/IPC/Run3/ t/
dmn at users.alioth.debian.org
dmn at users.alioth.debian.org
Wed Sep 17 20:34:10 UTC 2008
Author: dmn
Date: Wed Sep 17 20:34:07 2008
New Revision: 25296
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=25296
Log:
New upstream release
Added:
trunk/libipc-run3-perl/LICENSE
- copied unchanged from r25295, branches/upstream/libipc-run3-perl/current/LICENSE
trunk/libipc-run3-perl/t/utf8.t
- copied unchanged from r25295, branches/upstream/libipc-run3-perl/current/t/utf8.t
Modified:
trunk/libipc-run3-perl/Changes
trunk/libipc-run3-perl/MANIFEST
trunk/libipc-run3-perl/META.yml
trunk/libipc-run3-perl/Makefile.PL
trunk/libipc-run3-perl/debian/changelog
trunk/libipc-run3-perl/lib/IPC/Run3.pm
trunk/libipc-run3-perl/lib/IPC/Run3/ProfArrayBuffer.pm
trunk/libipc-run3-perl/lib/IPC/Run3/ProfLogReader.pm
trunk/libipc-run3-perl/lib/IPC/Run3/ProfLogger.pm
trunk/libipc-run3-perl/lib/IPC/Run3/ProfPP.pm
trunk/libipc-run3-perl/t/IPC-Run3-ProfPP.t
trunk/libipc-run3-perl/t/IPC-Run3.t
Modified: trunk/libipc-run3-perl/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libipc-run3-perl/Changes?rev=25296&op=diff
==============================================================================
--- trunk/libipc-run3-perl/Changes (original)
+++ trunk/libipc-run3-perl/Changes Wed Sep 17 20:34:07 2008
@@ -1,4 +1,41 @@
Changes file for IPC::Run3
+
+0.042 2008-08-09
+ No code changes
+ Rewrite a test in t/utf8.t that runs afoul of a misfeature
+ in Perl 5.8.0 (turn on ":utf8" by default on all filehandles
+ when running in a UTF8 locale; fixed since 5.8.1)
+
+0.041 2008-08-03
+ Handle arbitrary binmode() layers in "binmode_*" options; for
+ backward compatibility, any true option that doesn't start
+ with ":" is treated as ":raw"
+ NOTE: This does work for the built-in layers, e.g. ":utf8",
+ but all bets are off for fancier stuff like ":via(...)" .
+ Add an option "return_if_system_error" that causes run3()
+ to refrain from throwing an exception when system() returns -1
+ (cf. RT 14272).
+
+0.040 2007-12-26
+ major rewrite of pod:
+ - describe all possible forms of redirectors
+ - list available options
+ - explain how run3() works
+ fix #31343 by using the three argument form of open() for files;
+ unfortunately that isn't available before Perl 5.6.0,
+ hence "use 5.006_00"; also use lexical filehandles everywhere
+ implement options append_{stdout,stderr}; add test cases
+ edit META.yml so that the profiling modules IPC::Run3::Prof*
+ (which aren't of general use) won't show on CPAN
+
+0.039 2007-11-01
+ avoid some warnings while testing profiler (thanks, SCOP)
+
+0.038 2007-10-08
+ remove use warnings for 5.005 compat (thanks, David Golden)
+
+0.037 2006-09-19
+ document license more clearly for META.yml
0.036 2006-09-19
document more clearly the return value of run3
Modified: trunk/libipc-run3-perl/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libipc-run3-perl/MANIFEST?rev=25296&op=diff
==============================================================================
--- trunk/libipc-run3-perl/MANIFEST (original)
+++ trunk/libipc-run3-perl/MANIFEST Wed Sep 17 20:34:07 2008
@@ -1,4 +1,5 @@
Changes
+LICENSE
README
MANIFEST
MANIFEST.SKIP
@@ -21,4 +22,5 @@
t/fork.t
t/pod-coverage.t
t/pod.t
+t/utf8.t
META.yml Module meta-data (added by MakeMaker)
Modified: trunk/libipc-run3-perl/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libipc-run3-perl/META.yml?rev=25296&op=diff
==============================================================================
--- trunk/libipc-run3-perl/META.yml (original)
+++ trunk/libipc-run3-perl/META.yml Wed Sep 17 20:34:07 2008
@@ -1,12 +1,20 @@
-# http://module-build.sourceforge.net/META-spec.html
-#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX#
-name: IPC-Run3
-version: 0.036
-version_from: lib/IPC/Run3.pm
-installdirs: site
-requires:
- Test::More: 0.31
- Time::HiRes: 0
-
-distribution_type: module
-generated_by: ExtUtils::MakeMaker version 6.30
+--- #YAML:1.0
+name: IPC-Run3
+version: 0.042
+abstract: run a subprocess with input/ouput redirection
+license: open_source
+author: Barrie Slaymaker <barries at slaysys.com>
+generated_by: ExtUtils::MakeMaker version 6.42
+distribution_type: module
+requires:
+ perl: 5.6.0
+ Test::More: 0.31
+ Time::HiRes: 0
+no_index:
+ dir:
+ - lib/IPC/Run3
+ file:
+ - bin/run3profpp
+meta-spec:
+ url: http://module-build.sourceforge.net/META-spec-v1.3.html
+ version: 1.3
Modified: trunk/libipc-run3-perl/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libipc-run3-perl/Makefile.PL?rev=25296&op=diff
==============================================================================
--- trunk/libipc-run3-perl/Makefile.PL (original)
+++ trunk/libipc-run3-perl/Makefile.PL Wed Sep 17 20:34:07 2008
@@ -3,11 +3,15 @@
WriteMakefile(
NAME => 'IPC::Run3',
VERSION_FROM => 'lib/IPC/Run3.pm',
+ ABSTRACT_FROM => 'lib/IPC/Run3.pm',
+ AUTHOR => 'Barrie Slaymaker <barries at slaysys.com>',
+ (eval { ExtUtils::MakeMaker->VERSION(6.21) } ? (LICENSE => 'open_source') : ()),
EXE_FILES => [],
PREREQ_PM => {
- 'Test::More' => 0.31,
+ 'Test::More' => '0.31',
'Time::HiRes' => 0,
($^O =~ /Win32/ ? (Win32 => 0) : ())
},
- clean => { FILES => "t/test.txt" },
+ NO_META => 1,
+ clean => { FILES => [ "t/test.txt", "t/utf8.txt" ] },
);
Modified: trunk/libipc-run3-perl/debian/changelog
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libipc-run3-perl/debian/changelog?rev=25296&op=diff
==============================================================================
--- trunk/libipc-run3-perl/debian/changelog (original)
+++ trunk/libipc-run3-perl/debian/changelog Wed Sep 17 20:34:07 2008
@@ -1,4 +1,4 @@
-libipc-run3-perl (0.036-2) UNRELEASED; urgency=low
+libipc-run3-perl (0.042-1) UNRELEASED; urgency=low
* Take over for the Debian Perl Group on maintainer's request
(http://lists.debian.org/debian-perl/2008/09/msg00111.html)
@@ -10,7 +10,9 @@
* debian/watch: use dist-based URL.
* convert to debhelper v7
- -- Damyan Ivanov <dmn at debian.org> Wed, 17 Sep 2008 22:35:35 +0300
+ * New upstream release
+
+ -- Damyan Ivanov <dmn at debian.org> Wed, 17 Sep 2008 23:30:08 +0300
libipc-run3-perl (0.036-1) unstable; urgency=low
Modified: trunk/libipc-run3-perl/lib/IPC/Run3.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libipc-run3-perl/lib/IPC/Run3.pm?rev=25296&op=diff
==============================================================================
--- trunk/libipc-run3-perl/lib/IPC/Run3.pm (original)
+++ trunk/libipc-run3-perl/lib/IPC/Run3.pm Wed Sep 17 20:34:07 2008
@@ -2,144 +2,36 @@
=head1 NAME
-IPC::Run3 - run a subprocess in batch mode (a la system) on Unix, Win32, etc.
+IPC::Run3 - run a subprocess with input/ouput redirection
=head1 VERSION
-version 0.036
+version 0.041
=cut
-$VERSION = '0.036';
+$VERSION = '0.042';
=head1 SYNOPSIS
use IPC::Run3; # Exports run3() by default
run3 \@cmd, \$in, \$out, \$err;
- 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 and none of the bloat and rarely used features of IPC::Run.
+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.) Disk space is not.
-
-=head2 C<< run3(\@cmd, INPUT, OUTPUT, \$err) >>
-
-Note that passing in a reference to C<undef> explicitly redirects the
-associated file descriptor for C<STDIN>, C<STDOUT>, or C<STDERR> from or to the
-local equivalent of C</dev/null> (this does I<not> pass a closed filehandle).
-Passing in C<undef> (or not passing a redirection) allows the child to inherit
-the corresponding C<STDIN>, C<STDOUT>, or C<STDERR> from the parent.
-
-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.
-
-B<Note>: This means that:
-
- run3 \@cmd, undef, \$out; # Pass on parent's STDIN
-
-B<does not close the child's STDIN>, it passes on the parent's. Use
-
- run3 \@cmd, \undef, \$out; # Close child's STDIN
-
-for that. It's not ideal, but it does work.
-
-If the exact same value is passed for C<$stdout> and C<$stderr>, then the child
-will write both to the same filehandle. In general, this means that
-
- run3 \@cmd, \undef, "foo.txt", "foo.txt";
- run3 \@cmd, \undef, \$both, \$both;
-
-will DWYM and pass a single file handle to the child for both C<STDOUT> and
-C<STDERR>, collecting all into C<$both>.
-
-C<run3> returns true if the command executes and throws an exception otherwise.
-It should leave C<$?> intact for inspection of exit and wait status.
-
-=head1 DEBUGGING
-
-To enable debugging use the IPCRUN3DEBUG environment variable to
-a non-zero integer value:
-
- $ IPCRUN3DEBUG=1 myapp
-
-=head1 PROFILING
-
-To enable profiling, set IPCRUN3PROFILE to a number to enable emitting profile
-information to STDERR (1 to get timestamps, 2 to get a summary report at the
-END of the program, 3 to get mini reports after each run) or to a filename to
-emit raw data to a file for later analysis.
-
-=head1 COMPARISON
-
-Here's how it stacks up to existing APIs:
-
-=over
-
-=item compared to C<system()>, C<qx''>, C<open "...|">, C<open "|...">:
-
-=over
-
-=item + redirects more than one file descriptor
-
-=item + returns TRUE on success, FALSE on failure
-
-=item + throws an error if problems occur in the parent process (or the pre-exec child)
-
-=item + allows a very perlish interface to Perl data structures and subroutines
-
-=item + allows 1 word invocations to avoid the shell easily:
-
- run3 ["foo"]; # does not invoke shell
-
-=item - does not return the exit code, leaves it in $?
-
-=back
-
-=item compared to C<open2()>, C<open3()>:
-
-=over
-
-=item + No lengthy, error prone polling / select loop needed
-
-=item + Hides OS dependancies
-
-=item + Allows SCALAR, ARRAY, and CODE references to source and sink I/O
-
-=item + I/O parameter order is like open3() (not like open2()).
-
-=item - Does not allow interaction with the subprocess
-
-=back
-
-=item compared to C<IPC::Run::run()>:
-
-=over
-
-=item + Smaller, lower overhead, simpler, more portable
-
-=item + No select() loop portability issues
-
-=item + Does not fall prey to Perl closure leaks
-
-=item - Does not allow interaction with the subprocess (which
-IPC::Run::run() allows by redirecting subroutines).
-
-=item - Lacks many features of IPC::Run::run() (filters, pipes,
-redirects, pty support).
-
-=back
-
-=back
+to spool input to and output from the child command.)
=cut
+
+use 5.006_000; # i.e. v5.6.0
@EXPORT = qw( run3 );
%EXPORT_TAGS = ( all => \@EXPORT );
@@ -201,23 +93,32 @@
$profiler->app_exit( scalar gettimeofday() ) if profiling;
}
+sub _binmode {
+ my ( $fh, $mode, $what ) = @_;
+ # if $mode is not given, then default to ":raw", except on Windows,
+ # where we default to ":crlf";
+ # otherwise if a proper layer string was given, use that,
+ # else use ":raw"
+ my $layer = !$mode
+ ? (is_win32 ? ":crlf" : ":raw")
+ : ($mode =~ /^:/ ? $mode : ":raw");
+ warn "binmode $what, $layer\n" if debugging >= 2;
+
+ binmode $fh, ":raw" unless $layer eq ":raw"; # remove all layers first
+ binmode $fh, $layer or croak "binmode $layer failed: $!";
+}
+
sub _spool_data_to_child {
my ( $type, $source, $binmode_it ) = @_;
# If undef (not \undef) passed, they want the child to inherit
# the parent's STDIN.
return undef unless defined $source;
- warn "binmode()ing STDIN\n" if is_win32 && debugging && $binmode_it;
my $fh;
if ( ! $type ) {
- local *FH; # Do this the backcompat way
- open FH, "<$source" or croak "$!: $source";
- $fh = *FH{IO};
- if ( is_win32 ) {
- binmode $fh, ":raw"; # Remove all layers
- binmode $fh, ":crlf" unless $binmode_it;
- }
+ open $fh, "<", $source or croak "$!: $source";
+ _binmode($fh, $binmode_it, "STDIN");
warn "run3(): feeding file '$source' to child STDIN\n"
if debugging >= 2;
} elsif ( $type eq "FH" ) {
@@ -228,10 +129,7 @@
$fh = $fh_cache{in} ||= tempfile;
truncate $fh, 0;
seek $fh, 0, 0;
- if ( is_win32 ) {
- binmode $fh, ":raw"; # Remove any previous layers
- binmode $fh, ":crlf" unless $binmode_it;
- }
+ _binmode($fh, $binmode_it, "STDIN");
my $seekit;
if ( $type eq "SCALAR" ) {
@@ -283,7 +181,7 @@
}
sub _fh_for_child_output {
- my ( $what, $type, $dest, $binmode_it ) = @_;
+ my ( $what, $type, $dest, $options ) = @_;
my $fh;
if ( $type eq "SCALAR" && $dest == \undef ) {
@@ -291,9 +189,8 @@
if debugging >= 2;
$fh = $fh_cache{nul} ||= do {
- local *FH;
- open FH, ">" . File::Spec->devnull;
- *FH{IO};
+ open $fh, ">", File::Spec->devnull;
+ $fh;
};
} elsif ( $type eq "FH" ) {
$fh = $dest;
@@ -303,9 +200,8 @@
warn "run3(): feeding child $what to file '$dest'\n"
if debugging >= 2;
- local *FH;
- open FH, ">$dest" or croak "$!: $dest";
- $fh = *FH{IO};
+ open $fh, $options->{"append_$what"} ? ">>" : ">", $dest
+ or croak "$!: $dest";
} else {
warn "run3(): capturing child $what\n"
if debugging >= 2;
@@ -315,11 +211,9 @@
truncate $fh, 0;
}
- if ( is_win32 ) {
- warn "binmode()ing $what\n" if debugging && $binmode_it;
- binmode $fh, ":raw";
- binmode $fh, ":crlf" unless $binmode_it;
- }
+ my $binmode_it = $options->{"binmode_$what"};
+ _binmode($fh, $binmode_it, uc $what);
+
return $fh;
}
@@ -336,7 +230,8 @@
# two read()s are used instead of 1 so that the first will be
# logged even it reads 0 bytes; the second won't.
- my $count = read $fh, $$dest, 10_000;
+ my $count = read $fh, $$dest, 10_000,
+ $options->{"append_$what"} ? length $$dest : 0;
while (1) {
croak "$! reading child $what from temp file"
unless defined $count;
@@ -351,7 +246,11 @@
$count = read $fh, $$dest, 10_000, length $$dest;
}
} elsif ( $type eq "ARRAY" ) {
- @$dest = <$fh>;
+ if ($options->{"append_$what"}) {
+ push @$dest, <$fh>;
+ } else {
+ @$dest = <$fh>;
+ }
if ( debugging >= 2 ) {
my $count = 0;
$count += length for @$dest;
@@ -423,6 +322,13 @@
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;
@@ -442,7 +348,7 @@
$options->{binmode_stdin} if defined $stdin;
my $out_fh = _fh_for_child_output "stdout", $out_type, $stdout,
- $options->{binmode_stdout} if defined $stdout;
+ $options if defined $stdout;
my $tie_err_to_out =
defined $stderr && defined $stdout && $stderr eq $stdout;
@@ -450,10 +356,10 @@
my $err_fh = $tie_err_to_out
? $out_fh
: _fh_for_child_output "stderr", $err_type, $stderr,
- $options->{binmode_stderr} if defined $stderr;
+ $options if defined $stderr;
# this should make perl close these on exceptions
- local *STDIN_SAVE;
+# local *STDIN_SAVE;
local *STDOUT_SAVE;
local *STDERR_SAVE;
@@ -466,6 +372,7 @@
open STDERR_SAVE, ">&STDERR" or croak "run3(): $! saving STDERR"
if defined $err_fh;
+ my $errno;
my $ok = eval {
# The open() call here seems to not force fd 0 in some cases;
# I ran in to trouble when using this in VCP, not sure why.
@@ -501,20 +408,19 @@
: @$cmd
: system $cmd;
+ $errno = $!; # save $!, because later failures will overwrite it
$sys_exit_time = gettimeofday() if profiling;
-
- unless ( defined $r && $r != -1 ) {
- if ( debugging ) {
- my $err_fh = defined $err_fh ? \*STDERR_SAVE : \*STDERR;
- print $err_fh "run3(): system() error $!\n"
- }
- die $!;
- }
-
if ( debugging ) {
my $err_fh = defined $err_fh ? \*STDERR_SAVE : \*STDERR;
- print $err_fh "run3(): \$? is $?\n"
+ if ( defined $r && $r != -1 ) {
+ print $err_fh "run3(): \$? is $?\n";
+ } else {
+ print $err_fh "run3(): \$? is $?, \$! is $errno\n";
+ }
}
+
+ die $! if defined $r && $r == -1 && !$options->{return_if_system_error};
+
1;
};
my $x = $@;
@@ -549,12 +455,263 @@
scalar gettimeofday()
) if profiling;
+ $! = $errno; # restore $! from system()
+
return 1;
}
-=head1 TODO
-
-pty support
+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 successful exit code. Hence you should always check C<$?>.
+
+See L</%options> for an option to handle the case of C<system>
+returning -1 yourself.
+
+=head3 C<$cmd>
+
+Usually C<$cmd> will be an ARRAY reference and the child is invoked via
+
+ 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>
+in case of failure.
+
+ run3 \@cmd, \undef, "out.txt"; # child writes to file "out.txt"
+
+=item a filehandle (either a reference to a GLOB or an C<IO::Handle>)
+
+The filehandle is inherited by the child.
+
+ open my $fh, ">", "out.txt";
+ print $fh "prologue\n";
+ ...
+ run3 \@cmd, \undef, $fh; # child writes to $fh
+ ...
+ print $fh "epilogue\n";
+ close $fh;
+
+=item a SCALAR reference
+
+The referenced scalar is treated as a string to be read from or
+written to. In the latter case, the previous content of the string
+is overwritten.
+
+ my $out;
+ run3 \@cmd, \undef, \$out; # child writes into string
+ 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 *
+
+if the redirector specifies a filename, C<run3()> opens the file
+in the appropriate mode
+
+=item *
+
+in all other cases, C<run3()> opens a temporary file
+(using L<tempfile|Temp/tempfile>)
+
+=back
+
+=item (2)
+
+If C<run3()> opened a temporary file for C<$stdin> in step (1),
+it writes the data using the specified method (either
+from a string, an array or returnd by a function) to the temporary file and rewinds it.
+
+=item (3)
+
+C<run3()> saves the parent's C<STDIN>, C<STDOUT> and C<STDERR> by duplicating
+them to new filehandles. It duplicates the filehandles from step (1)
+to C<STDIN>, C<STDOUT> and C<STDERR>, resp.
+
+=item (4)
+
+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
+by reusing them (i.e. it keeps them open and rewinds and truncates them
+before the next operation).
=head1 LIMITATIONS
@@ -570,6 +727,110 @@
on Win32 is emulated via Win32 threads and hence I/O mix up is possible
between forked children here (C<run3> is "fork safe" on Unix, though).
+=head1 DEBUGGING
+
+To enable debugging use the IPCRUN3DEBUG environment variable to
+a non-zero integer value:
+
+ $ IPCRUN3DEBUG=1 myapp
+
+=head1 PROFILING
+
+To enable profiling, set IPCRUN3PROFILE to a number to enable emitting profile
+information to STDERR (1 to get timestamps, 2 to get a summary report at the
+END of the program, 3 to get mini reports after each run) or to a filename to
+emit raw data to a file for later analysis.
+
+=head1 COMPARISON
+
+Here's how it stacks up to existing APIs:
+
+=head2 compared to C<system()>, C<qx''>, C<open "...|">, C<open "|...">
+
+=over
+
+=item +
+
+redirects more than one file descriptor
+
+=item +
+
+returns TRUE on success, FALSE on failure
+
+=item +
+
+throws an error if problems occur in the parent process (or the pre-exec child)
+
+=item +
+
+allows a very perlish interface to Perl data structures and subroutines
+
+=item +
+
+allows 1 word invocations to avoid the shell easily:
+
+ run3 ["foo"]; # does not invoke shell
+
+=item -
+
+does not return the exit code, leaves it in $?
+
+=back
+
+=head2 compared to C<open2()>, C<open3()>
+
+=over
+
+=item +
+
+no lengthy, error prone polling/select loop needed
+
+=item +
+
+hides OS dependancies
+
+=item +
+
+allows SCALAR, ARRAY, and CODE references to source and sink I/O
+
+=item +
+
+I/O parameter order is like C<open3()> (not like C<open2()>).
+
+=item -
+
+does not allow interaction with the subprocess
+
+=back
+
+=head2 compared to L<IPC::Run::run()|IPC::Run/run>
+
+=over
+
+=item +
+
+smaller, lower overhead, simpler, more portable
+
+=item +
+
+no select() loop portability issues
+
+=item +
+
+does not fall prey to Perl closure leaks
+
+=item -
+
+does not allow interaction with the subprocess (which
+IPC::Run::run() allows by redirecting subroutines)
+
+=item -
+
+lacks many features of C<IPC::Run::run()> (filters, pipes,
+redirects, pty support)
+
+=back
+
=head1 COPYRIGHT
Copyright 2003, R. Barrie Slaymaker, Jr., All Rights Reserved
@@ -588,5 +849,3 @@
Belka, Roderich Schupp, David Morel, and anonymous others.
=cut
-
-1;
Modified: trunk/libipc-run3-perl/lib/IPC/Run3/ProfArrayBuffer.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libipc-run3-perl/lib/IPC/Run3/ProfArrayBuffer.pm?rev=25296&op=diff
==============================================================================
--- trunk/libipc-run3-perl/lib/IPC/Run3/ProfArrayBuffer.pm (original)
+++ trunk/libipc-run3-perl/lib/IPC/Run3/ProfArrayBuffer.pm Wed Sep 17 20:34:07 2008
@@ -1,6 +1,6 @@
package IPC::Run3::ProfArrayBuffer;
-$VERSION = 0.030;
+$VERSION = 0.038;
=head1 NAME
@@ -13,7 +13,6 @@
=cut
use strict;
-use warnings;
=head1 METHODS
Modified: trunk/libipc-run3-perl/lib/IPC/Run3/ProfLogReader.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libipc-run3-perl/lib/IPC/Run3/ProfLogReader.pm?rev=25296&op=diff
==============================================================================
--- trunk/libipc-run3-perl/lib/IPC/Run3/ProfLogReader.pm (original)
+++ trunk/libipc-run3-perl/lib/IPC/Run3/ProfLogReader.pm Wed Sep 17 20:34:07 2008
@@ -1,6 +1,6 @@
package IPC::Run3::ProfLogReader;
-$VERSION = 0.030;
+$VERSION = 0.038;
=head1 NAME
@@ -26,7 +26,6 @@
=cut
use strict;
-use warnings;
=head1 METHODS
Modified: trunk/libipc-run3-perl/lib/IPC/Run3/ProfLogger.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libipc-run3-perl/lib/IPC/Run3/ProfLogger.pm?rev=25296&op=diff
==============================================================================
--- trunk/libipc-run3-perl/lib/IPC/Run3/ProfLogger.pm (original)
+++ trunk/libipc-run3-perl/lib/IPC/Run3/ProfLogger.pm Wed Sep 17 20:34:07 2008
@@ -1,6 +1,6 @@
package IPC::Run3::ProfLogger;
-$VERSION = 0.030;
+$VERSION = 0.038;
=head1 NAME
@@ -32,7 +32,6 @@
=cut
use strict;
-use warnings;
=head1 METHODS
Modified: trunk/libipc-run3-perl/lib/IPC/Run3/ProfPP.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libipc-run3-perl/lib/IPC/Run3/ProfPP.pm?rev=25296&op=diff
==============================================================================
--- trunk/libipc-run3-perl/lib/IPC/Run3/ProfPP.pm (original)
+++ trunk/libipc-run3-perl/lib/IPC/Run3/ProfPP.pm Wed Sep 17 20:34:07 2008
@@ -24,7 +24,6 @@
@ISA = qw( IPC::Run3::ProfReporter );
use strict;
-use warnings;
use POSIX qw( floor );
=head1 METHODS
@@ -34,6 +33,8 @@
Returns a new profile reporting object.
=cut
+
+sub _emit { shift; warn @_ }
sub _t {
sprintf "%10.6f secs", @_;
@@ -57,9 +58,10 @@
sub handle_app_call {
my $self = shift;
- warn "IPC::Run3 parent: ",
+ $self->_emit("IPC::Run3 parent: ",
join( " ", @{$self->get_app_cmd} ),
- "\n";
+ "\n",
+ );
$self->{NeedNL} = 1;
}
@@ -71,37 +73,37 @@
sub handle_app_exit {
my $self = shift;
- warn "\n" if $self->{NeedNL} && $self->{NeedNL} != 1;
+ $self->_emit("\n") if $self->{NeedNL} && $self->{NeedNL} != 1;
- warn "IPC::Run3 total elapsed: ",
+ $self->_emit( "IPC::Run3 total elapsed: ",
_t( $self->get_app_cumulative_time ),
- "\n";
- warn "IPC::Run3 calls to run3(): ",
+ "\n");
+ $self->_emit( "IPC::Run3 calls to run3(): ",
sprintf( "%10d", $self->get_run_count ),
- "\n";
- warn "IPC::Run3 total spent in run3(): ",
+ "\n");
+ $self->_emit( "IPC::Run3 total spent in run3(): ",
_t( $self->get_run_cumulative_time ),
_pct( $self->get_run_cumulative_time, $self->get_app_cumulative_time ),
", ",
_r( $self->get_run_cumulative_time, $self->get_run_count ),
" per call",
- "\n";
+ "\n");
my $exclusive =
$self->get_app_cumulative_time - $self->get_run_cumulative_time;
- warn "IPC::Run3 total spent not in run3(): ",
+ $self->_emit( "IPC::Run3 total spent not in run3(): ",
_t( $exclusive ),
_pct( $exclusive, $self->get_app_cumulative_time ),
- "\n";
- warn "IPC::Run3 total spent in children: ",
+ "\n");
+ $self->_emit( "IPC::Run3 total spent in children: ",
_t( $self->get_sys_cumulative_time ),
_pct( $self->get_sys_cumulative_time, $self->get_app_cumulative_time ),
", ",
_r( $self->get_sys_cumulative_time, $self->get_run_count ),
" per call",
- "\n";
+ "\n");
my $overhead =
$self->get_run_cumulative_time - $self->get_sys_cumulative_time;
- warn "IPC::Run3 total overhead: ",
+ $self->_emit( "IPC::Run3 total overhead: ",
_t( $overhead ),
_pct(
$overhead,
@@ -110,7 +112,7 @@
", ",
_r( $overhead, $self->get_run_count ),
" per call",
- "\n";
+ "\n");
}
=head2 C<< $profpp->handle_run_exit() >>
@@ -121,17 +123,17 @@
my $self = shift;
my $overhead = $self->get_run_time - $self->get_sys_time;
- warn "\n" if $self->{NeedNL} && $self->{NeedNL} != 2;
+ $self->_emit("\n") if $self->{NeedNL} && $self->{NeedNL} != 2;
$self->{NeedNL} = 3;
- warn "IPC::Run3 child: ",
+ $self->_emit( "IPC::Run3 child: ",
join( " ", @{$self->get_run_cmd} ),
- "\n";
- warn "IPC::Run3 run3() : ", _t( $self->get_run_time ), "\n",
+ "\n");
+ $self->_emit( "IPC::Run3 run3() : ", _t( $self->get_run_time ), "\n",
"IPC::Run3 child : ", _t( $self->get_sys_time ), "\n",
"IPC::Run3 overhead: ", _t( $overhead ),
_pct( $overhead, $self->get_sys_time ),
- "\n";
+ "\n");
}
=head1 LIMITATIONS
Modified: trunk/libipc-run3-perl/t/IPC-Run3-ProfPP.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libipc-run3-perl/t/IPC-Run3-ProfPP.t?rev=25296&op=diff
==============================================================================
--- trunk/libipc-run3-perl/t/IPC-Run3-ProfPP.t (original)
+++ trunk/libipc-run3-perl/t/IPC-Run3-ProfPP.t Wed Sep 17 20:34:07 2008
@@ -8,6 +8,8 @@
my @tests = (
sub {
+ local $SIG{__WARN__} = sub { };
+
$p->app_call( [ "parent_prog" ], 1.0 );
$p->run_exit( [ "child_prog" ], 1.1, 1.2, 1.3, 1.4 );
$p->app_exit( 1.5 );
Modified: trunk/libipc-run3-perl/t/IPC-Run3.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libipc-run3-perl/t/IPC-Run3.t?rev=25296&op=diff
==============================================================================
--- trunk/libipc-run3-perl/t/IPC-Run3.t (original)
+++ trunk/libipc-run3-perl/t/IPC-Run3.t Wed Sep 17 20:34:07 2008
@@ -35,6 +35,24 @@
sub {
( $in, $out, $err ) = ();
+ $out = "STUFF";
+ run3 [$^X, '-e', 'print "OUT"' ], \undef, \$out, \$err, { append_stdout => 1 };
+ ok $out, "STUFFOUT";
+},
+
+sub {
+ ( $in, $out, $err ) = ();
+ $err = "STUFF";
+ run3 [$^X, '-e', 'print STDERR "OUT"' ], \undef, \$out, \$err, { append_stderr => 1 };
+ ok $out, "";
+},
+
+sub {
+ ok $err, "STUFFOUT";
+},
+
+sub {
+ ( $in, $out, $err ) = ();
run3 [$^X, '-e', 'print map uc, <>' ], \"in", \$out, \$err;
ok $out, "IN";
},
@@ -61,13 +79,42 @@
sub {
( $in, $out, $err ) = ();
- run3 [$^X, '-e', 'print map length($_)."[$_]", <>' ], \"in1\nin2", \$out;
+ my @ary;
+ run3 [$^X, '-e', 'print map uc, <>' ], [qw( in1 in2 )], \$out;
+ ok $out, "IN1IN2";
+},
+
+sub {
+ ( $in, $out, $err ) = ();
+ my @out;
+ run3 [$^X, '-e', 'print "OUT1\nOUT2"' ], \undef, \@out, \$err;
+ ok scalar(@out), 2;
+ $out = join('', @out);
+},
+sub {
+ ok $out, "OUT1\nOUT2";
+},
+
+sub {
+ ( $in, $out, $err ) = ();
+ my @out = ("STUFF\n");
+ run3 [$^X, '-e', 'print "OUT1\nOUT2"' ], \undef, \@out, \$err, { append_stdout => 1 };
+ ok scalar(@out), 3;
+ $out = join('', @out);
+},
+sub {
+ ok $out, "STUFF\nOUT1\nOUT2";
+},
+
+sub {
+ ( $in, $out, $err ) = ();
+ run3 [$^X, '-e', 'print map { length($_)."[$_]" } <>' ], \"in1\nin2", \$out;
ok $out, "4[in1\n]3[in2]";
},
sub {
( $in, $out, $err ) = ();
- run3 [$^X, '-e', 'binmode STDIN; binmode STDOUT; print map length($_)."[$_]", <>' ],
+ run3 [$^X, '-e', 'binmode STDIN; binmode STDOUT; print map { length($_)."[$_]" } <>' ],
\"in1\nin2", \$out,
{ binmode_stdin => 1 };
ok $out, "4[in1\n]3[in2]";
@@ -75,7 +122,7 @@
sub {
( $in, $out, $err ) = ();
- run3 [$^X, '-e', 'binmode STDIN; binmode STDOUT; print map length($_)."[$_]", <>' ],
+ run3 [$^X, '-e', 'binmode STDIN; binmode STDOUT; print map { length($_)."[$_]" } <>' ],
\"in1\r\nin2", \$out,
{ binmode_stdin => 1, binmode_stdout => 1 };
ok $out, "5[in1\r\n]3[in2]";
@@ -90,7 +137,17 @@
sub {
( $in, $out, $err ) = ();
- my @in = qw( in1 in2 );
+ my @out;
+ run3 [$^X, '-e', 'print map uc, <>' ], \"in1\nin2", sub { push @out, shift };
+ ok scalar(@out), 2;
+ $out = join('', @out);
+},
+sub {
+ ok $out, "IN1\nIN2";
+},
+
+sub {
+ ( $in, $out, $err ) = ();
run3 [$^X, '-e',
'$|=1; select STDERR; $| = 1; for (<>){print STDOUT uc;print STDERR lc}'
], \"in1\nin2\n", \$out,\$out;
@@ -108,7 +165,19 @@
sub {
my $fn = "t/test.txt";
- open FH, ">$fn" or warn "$! opening $fn";
+ unlink $fn or warn "$! unlinking $fn" if -e $fn;
+ open FH, ">", $fn or warn "$! opening $fn";
+ print FH "STUFF";
+ close FH;
+
+ ( $in, $out, $err ) = ();
+ run3 [$^X, '-e', 'print "OUT"' ], \undef, $fn, { append_stdout => 1 };
+ ok -s $fn, 8;
+},
+
+sub {
+ my $fn = "t/test.txt";
+ open FH, ">", $fn or warn "$! opening $fn";
( $in, $out, $err ) = ();
run3 [$^X, '-e', 'print "OUT"' ], \undef, \*FH;
@@ -119,11 +188,12 @@
sub {
my $fn = "t/test.txt";
- open FH, ">$fn" or warn "$! opening $fn";
+ unlink $fn or warn "$! unlinking $fn" if -e $fn;
+ open FH, ">", $fn or warn "$! opening $fn";
print FH "IN1\nIN2\n";
close FH;
- open FH, "<$fn" or warn "$! opening $fn";
+ open FH, "<", $fn or warn "$! opening $fn";
( $in, $out, $err ) = ();
run3 [$^X, '-e', 'print <>' ], \*FH, \$out;
@@ -131,6 +201,24 @@
close FH;
ok $out, "IN1\nIN2\n";
},
+
+# check that run3 doesn't die on platforms where system()
+# returns -1 when SIGCHLD is ignored (RT #14272)
+sub {
+ my $system_child_error = eval
+ {
+ local $SIG{CHLD} = "IGNORE";
+ system $^X, '-e', 0;
+ $?;
+ };
+ my $run3_child_error = eval
+ {
+ local $SIG{CHLD} = "IGNORE";
+ run3 [ $^X, '-e', 0 ], \undef, \undef, \undef, { return_if_system_error => 1 };
+ $?;
+ };
+ ok $run3_child_error, $system_child_error;
+},
);
plan tests => 0+ at tests;
More information about the Pkg-perl-cvs-commits
mailing list