如何将输出从作为参数提供的管道重定向到变量

Question

So i've made functions to capture pipes

sub capture_stdout (&) {    
    my $s;
    open(local *STDOUT, '>', \$s);
    shift->();
    return $s;
}

sub capture_stderr (&) {
    my $s;
    open(local *STDERR, '>', \$s);
    shift->();
    return $s;
}

These work great. Now the challenge i am facing is, i want to make a function that takes the pipe(s) as arguments, and redirects all of them in a single sub. I have yet been unsuccessful in making it work. So far I've cooked up something that compiles;

sub capture(@&) {
    my $c = pop;
    my $o = [];
    say {$_[$_]} $_[$_] for (0 .. $#_);
    open(local *{$_[$_]}, '>', \$o->[$_]) for (0 .. $#_);
    $c->();
    return $o;
}

use Data::Dumper;
say Dumper( capture *STDOUT, *STDERR, sub{ say 1; warn 2; } );

but it does not capture anything. I cant seem to figure out how to fix it. I'm convinced however that it is the local *{$_[$_]} that needs fixing, though i could be wrong. The complete output is:

*main::STDOUT
*main::STDERR
1
2 at capture.pl line 15.
$VAR1 = [
      undef,
      undef
    ];

So then the question: Is it even possible to do what I'm attempting, and if so, how?

Thank you.

Answer 1

The problem with your code is that the effects of local are undone at the end of your

... for (0 .. $#_);

loop. By the time you call $c->() , the filehandles have their original values again.

So ...

• You want to localize an arbitrary number of variables.
• You can't use blocks (eg for (...) { ... } ) because local is undone at the end of the scope it's in.
• You can't use postfix for because apparently it implicitly creates its own mini-scope.

The solution? goto , of course!

(Or you could use recursion: Use a block, but never leave it or loop back. Just localize a single variable, then call yourself with the remaining variables. But goto is funnier.)

sub capture {
    my $c = pop;
    my $o = [];

    my $i = 0;
    LOOP: goto LOOP_END if $i >= @_;
    local *{$_[$i++]};
    goto LOOP;
    LOOP_END:

    open(*{$_[$_]}, '>', \$o->[$_]) or die "$_[$_]: $!" for 0 .. $#_;
    $c->();
    return $o;
}

Effectively we've created a loop without entering/leaving any scopes.

Answer 2

You need to actually switch out the file handles. To do that, first save the existing handles. Then create new ones that point into your output data structure. Once you've run the code, restore the original handles.

sub capture {
    my $c = pop;

    # we will keep the original handles in here to restore them later
    my @old_handles;

    my $o = [];
    foreach my $i (0 .. $#_) {

        # store the original handle
        push @old_handles, $_[$i];

        # create a new handle
        open my $fh, '>', \$o->[$i] or die $!;

        # stuff it into the handle slot of the typeglob associated with the old handle
        *{$_[$i]} = $fh;
    }

    # run callback
    $c->();

    # restore the old handles
    *{$_[$_]} = $old_handles[$_] for 0 .. $#_;

    return $o;
}

Answer 3

SOLUTION:

The final product, not nearly as convoluted as the original goto loop:

=pod

=item C<capture>

capture takes a list of pipes/filehandles, a code block or sub, optionally arguments to send to
said block and returns any captured output as a string, or an array of strings.

    my ($out, $err) = capture *STDOUT, *STDERR, sub { say 'faijas'; warn @_; }, 'jee';
    my $output = capture *STDOUT, sub { say 'jee'; };

=cut

sub capture(@&;@) {
    my (@o, @h);
    # walk through @_, grab all filehandles and the code block into @h
    push @h, shift while @_ && ref $h[$#h] ne 'CODE';
    my $c = pop @h; # then separate the code block from @h, leaving only handles

    # Really we want to do: open(local *{$_[$_]}, '>', \$o->[$_]) for (0 .. $#_);
    # but because of scoping issues with the local keyword, we have to loop without
    # creating an inner scope
    my $i = 0;
    R: open(local *{$h[$i]}, '>', \$o[$i]) or die "$h[$i]: $!" ;
    goto R if ++$i <= $#h;

    $c->(@_);
    return wantarray ? @o : $o[0];
}

Big thanks to @melpomene and @simbabque for helping me around the initial problem, and @ikegami for pointing out oversights.