With perl open, how can I capture bash STDOUT & STDERR without printing to disk?

169 views Asked by At

The perl script below invokes unix find using the open command.

STDOUT goes into the CMD filehandle and STDERR, if any, goes into a temporary file on disk.

STDERR will result if the user makes a mistake on the command line. But even if the user makes a mistake, it is still possible that STDOUT could contain useful data, as in my example below.

Thus we want two separate variables in the perl script, holding respectively STDOUT and STDERR from the unix command.

In the current script, STDERR is only obtained by first printing it to a file on disk and subsequently reading the file.

Is there a way to capture both STDOUT and STDERR in separate variables without the intermediate step of printing STDERR to a physical file on disk? Can it somehow be printed directly to a perl filehandle or a perl variable?

I am aware that one can use File::Find in perl instead of an explicit system call. But open can be applied to other unix commands, so an answer to the current question could be applied to any number of unix commands.

> cat z.pl
#!/usr/bin/env perl
use strict; use warnings;
use Data::Dumper qw(Dumper); $Data::Dumper::Sortkeys = 1;

my$work={};
$work->{tmpfile}='./z';
$work->{command}=join(' ',
    'find -s ',
    @ARGV,
    '2>',
    $work->{tmpfile},
);

open CMD, '-|', $work->{command} or die $work->{command},' cannot open';
$work->{return}{open}=$?;
my@result;
while(<CMD>)
{
    chomp;
    push@result,$_;
}
close CMD;
$work->{return}{close}=$?;
if(-s $work->{tmpfile})
{
    open IN,'<',$work->{tmpfile} or die 'cannot read ',$work->{tmpfile},;
    local$/=undef;
    $work->{stderr}=<IN>;
    close IN;
}
print Dumper $work;
print Dumper \@result;
> ./z.pl . piggy
$VAR1 = {
          'command' => 'find -s  . piggy 2> ./z',
          'return' => {
                        'close' => 256,
                        'open' => 0
                      },
          'stderr' => 'find: piggy: No such file or directory
',
          'tmpfile' => './z'
        };
$VAR1 = [
          '.',
          './.z.pl.swp',
          './body',
          './body~',
          './snap',
          './title',
          './z',
          './z.pl',
          './z.pl~'
        ];
>
3

There are 3 answers

0
ikegami On

IPC::Run makes this easy.

use IPC::Run qw( run );

my @cmd = ( "find", "-s", ".", "piggy" );

run \@cmd, ">", \my $stdout, "2>", \my $stderr;

my $status = $?;

The child inherits STDIN in the above program. You could use the following if that's undesirable:

run \@cmd, "/dev/null", \my $stdout, \my $stderr;

But if you're interested in learning the system calls involved, read on.

  1. Create three pipes.
  2. If this fails,
    1. Abort.
  3. Fork.
  4. If this fails,
    1. Abort.
  5. In the child,
    1. Close the read end of the first pipe.
    2. Close the read end of the second pipe.
    3. Close the read end of the third pipe.
    4. Set the first's pipe's close-on-exec flag.
    5. Open /dev/null.
    6. If this fails,
      1. Write an error message to the first pipe.
      2. Call _exit( 255 ). (The exit code doesn't matter.)
    7. Use dup2 to copy the handle to /dev/null onto fd 0.
    8. If this fails,
      1. Write an error message to the first pipe.
      2. Call _exit( 255 ). (The exit code doesn't matter.)
    9. Close the handle to /dev/null.
    10. Use dup2 to copy the write end the second pipe onto fd 1.
    11. If this fails,
      1. Write an error message to the first pipe.
      2. Call _exit( 255 ). (The exit code doesn't matter.)
    12. Close the write end of the second pipe.
    13. Use dup2 to copy the write end the second pipe onto fd 2.
    14. If this fails,
      1. Write an error message to the first pipe.
      2. Call _exit( 255 ). (The exit code doesn't matter.)
    15. Close the write end of the third pipe.
    16. exec the program.
    17. If this fails (i.e. if we get here),
      1. Write an error message to the first pipe.
      2. Call _exit( 255 ). (The exit code doesn't matter.)
  6. Close the write end of the first pipe.
  7. Close the write end of the second pipe.
  8. Close the write end of the third pipe.
  9. Create variable $error_msg.
  10. Loop,
    1. Read from the first pipe.
    2. If EOF reached,
      1. Exit the loop.
    3. Append what was read to $error_msg.
  11. If $error_msg is defined,
    1. There was an error launching the child. $error_msg contains the reason.
    2. Abort.
  12. Close the first pipe.
  13. Create a select bitfield for second and third pipe.
  14. Create two variables initialized to empty strings. Each will store data received from one of the two remaining pipes.
  15. While the bitfield still has bits set,
    1. Use select to wait for data.
    2. For each ready handle,
      1. Use sysread to read from the ready handle.
      2. If this fails, (i.e. if sysread returned -1),
        1. This shouldn't happen.
        2. Clear the appropriate bit in the bitfield.
      3. If EOF (i.e. if sysread returned zero),
        1. Clear the appropriate bit in the bitfield.
      4. Else,
        1. Append the data read to appropriate variable.
  16. Close the second pipe.
  17. Close the third pipe.
  18. Use waitpid to wait for the child to exit.

IPC::Open3's open3 can handle steps 1 to 12 for you.

IO::Select can simplify steps 13 to 15 for you.

0
zdim On

There is also the simple Capture::Tiny

use warnings;
use strict;
use feature 'say';

use Capture::Tiny qw(capture);

#my @cmd = ('find', '-s', @ARGV);
my @cmd = ( 'ls', '-l', (@ARGV ? shift : '.') );    

my ($stdout, $stderr, $exit) = capture {
  system( @cmd );
};

say $stdout          if $stdout;
say "Error: $stderr" if $stderr;
say "exit: $exit"    if $exit;

One can run any Perl code inside the block, not only external commands via system. So with this there is no need for shell redirections (can drop that 2> filename from the command).

This does use files internally, what can also be managed explicitly (discussed here in detail, for instance). But I thought the question is about avoiding the need to deal with files in code.

Please be careful with passing user input as arguments to commands.

2
Ted Lyngmo On

I suggest that you use IPC::Run like ikegami suggests. I just wanted to answer this part of the question OP asked:

How then do I redirect it myself?

You use open to duplicate the file descriptors. Note that this still writes to a separate file and only answers the redirection part.

sub run {
    my $output = shift; # a file to redirect STDERR to

    print "Running: ('" . join("', '", @_) . "') 2> $output\n";

    # dup STDERR so that we can restore it later
    open(my $err, '>&', \*STDERR) or die "Can't dup stderr: $!";

    # reopen STDERR to output to the supplied file
    open(STDERR, '>', $output) or die "Can't redirect stderr: $!";

    # "open" your command
    open(my $cmd, '-|', @_) or die "Can't exec $_[0]: $!";
    while(<$cmd>) {
        print $_;
    }
    close($cmd);

    # restore STDERR
    open(STDERR, '>&', $err) or die "Can't restore stderr: $!";
    close($err);
}

my @cmd = ('find', '-s', '.', '-maxdepth', '1', '2');

run './z', @cmd;

Output on STDOUT:

Running: ('find', '-s', '.', '-maxdepth', '1', '2') 2> ./z

My find doesn't know -s so output on STDERR (and therefore the content of ./z) became:

find: unknown predicate `-s'