Как перенаправить вывод из канала, предоставленного в качестве аргумента в переменную

Question

Итак, я сделал функции для захвата каналов

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

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

Они отлично работают.Теперь передо мной стоит задача: я хочу создать функцию, которая принимает каналы в качестве аргументов и перенаправляет их все в одну подпрограмму.Мне пока не удалось заставить его работать.До сих пор я готовил что-то, что компилируется:

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; } );

, но это ничего не захватывает.Я не могу понять, как это исправить.Однако я убежден, что это local *{$_[$_]} нуждается в исправлении, хотя я могу ошибаться.Полный вывод:

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

Итак, вопрос: можно ли вообще делать то, что я пытаюсь, и если да, то как?

Спасибо.

Answer 1

Проблема с вашим кодом заключается в том, что эффекты local отменяются в конце цикла

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

.К тому времени, когда вы вызываете $c->(), файловые дескрипторы снова получают свои исходные значения.

Итак ...

• Вы хотите локализовать произвольное количество переменных.
• Вы не можете использовать блоки (например, for (...) { ... }), потому что local отменяется в конце области, в которой он находится.
• Вы не можете использовать постфикс for, потому что, очевидно, он неявно создает егособственный мини-прицел.

Решение?goto, конечно!

(Или вы можете использовать рекурсию: используйте блок, но никогда не оставляйте его или не возвращайте его назад. Просто локализуйте одну переменную, затем вызовите себя с остальными переменными. Но gotoсмешнее.)

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;
}

По сути, мы создали цикл без входа / выхода из каких-либо областей.

Answer 2

РЕШЕНИЕ:

Конечный продукт, не такой сложный, как в оригинальном цикле goto:

=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];
}

Большое спасибо @melpomene и @simbabque за помощь в решении начальной проблемы,и @ikegami за указание на упущения.

Answer 3

Вы должны фактически отключить файловые дескрипторы.Для этого сначала сохраните существующие маркеры.Затем создайте новые, которые указывают на вашу структуру выходных данных.После запуска кода восстановите исходные дескрипторы.

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;
}