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