capturing STDERR from commands and pipe STDOUT in perl under windows

Question

I'm working on a Perl script that uses system to run a pipe of external commands like this:

system( "command1 | command2 | command3 > outfile" );

now I'd like to capture the STDERR from all these commands to one file. This works in OS X:

system( "command1 2> error.log | command2 2> error.log | command3 2> error.log > outfile" );

but not in Windows, where I get the error:

"the process cannot access the file because it is being used by another process"

Is there any workaround? I need this to be portable, so I'd like to avoid modules, if possible. Thanks in advance.

Answer 1

No shells, no temporary files, and nothing from outside of core.

use strict;
use warnings;

use IPC::Open3 qw( open3 );

my @pids;
{
   my @cmd1 = ( 'perl', '-E',  q{say for qw( ABC DEF );}     );
   my @cmd2 = ( 'perl', '-pe', q{$_=lc; warn(qq{x\n});}      );
   my @cmd3 = ( 'perl', '-pe', q{$_=ucfirst; warn(qq{y\n});} );

   my $nul = $^O eq 'MSWin32' ? 'nul' : '/dev/null';

   open(local *CHILD_STDIN,  '<', $nul       ) or die $!;
   open(local *CHILD_STDOUT, '>', 'outfile'  ) or die $!;
   open(local *CHILD_STDERR, '>', 'error.log') or die $!;

   push @pids, open3('<&CHILD_STDIN', local *PIPE1,     '>&CHILD_STDERR', @cmd1);
   push @pids, open3('<&PIPE1',       local *PIPE2,     '>&CHILD_STDERR', @cmd2);
   push @pids, open3('<&PIPE2',       '>&CHILD_STDOUT', '>&CHILD_STDERR', @cmd3);

   *CHILD_STDIN if 0;  # Silence warning. Already closed by open3.
   *PIPE1       if 0;  # Silence warning. Already closed by open3.
   *PIPE2       if 0;  # Silence warning. Already closed by open3.

   close(CHILD_STDOUT);
   close(CHILD_STDERR);
}

waitpid($_, 0) for @pids;

Answer 2

That's because '>' doesn't like to share files. Give each stage of the pipeline its own error log, and then execute something like this after the pipeline finishes:

  system("cat error1.log erorr2.log error3.log > error.log");

Here's a platform independent way to aggregate the logs:

my @error_logs = qw( error1.log error2.log error3.log );
open my $errlog, ">>", "error.log" || die "probelm opening error log: $!";

foreach my $sublog ( @error_logs ) {
   open my $fh, "<", $sublog || die "oh boy: $sublog: $!";
   print "$sublog:"
   print $errlog while $fh;
   close $fh;
}

close $errlog;

But there also exist IO::Cat and File::Cat if you decide to lean that way.

---

1)Corrected the name of the selfish meany that will not share files.

2) added log file collection