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

所以我制作了一些函数来捕捉管道

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

但它没有捕捉到任何东西。我似乎想不出怎么修理它。然而，我确信需要修复的是本地*{$\u[$\ u]}，尽管我可能错了。 完整输出为：

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

那么接下来的问题是：是否有可能做我正在尝试的事情，如果有，如何做

---

谢谢。

您需要实际切换文件句柄。为此，首先保存现有句柄。然后创建指向输出数据结构的新数据。运行代码后，恢复原始句柄

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

---

您需要实际切换出文件句柄。为此，首先保存现有句柄。然后创建指向输出数据结构的新数据。运行代码后，恢复原始句柄

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

---

您的代码的问题是，本地的效果在您的代码结束时被撤消

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

循环。在调用$c->时，文件句柄将再次具有其原始值

所以

您希望本地化任意数量的变量。 您不能使用块，例如用于。。。{…}因为local在它所在的作用域的末尾被撤消。 您不能对使用后缀，因为它显然隐式地创建了自己的迷你作用域。 解决方案是什么？后藤，当然

或者你可以使用递归：使用一个块，但不要离开它或循环回来。只需本地化一个变量，然后用剩下的变量调用您自己。但后藤更有趣

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

---

实际上，我们创建了一个循环，而没有进入/离开任何作用域。

代码的问题是，本地的效果在运行结束时被撤消

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

循环。在调用$c->时，文件句柄将再次具有其原始值

所以

您希望本地化任意数量的变量。 您不能使用块，例如用于。。。{…}因为local在它所在的作用域的末尾被撤消。 您不能对使用后缀，因为它显然隐式地创建了自己的迷你作用域。 解决方案是什么？后藤，当然

或者你可以使用递归：使用一个块，但不要离开它或循环回来。只需本地化一个变量，然后用剩下的变量调用您自己。但后藤更有趣

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

实际上，我们在不进入/离开任何作用域的情况下创建了一个循环。

解决方案： 最终产品，没有原始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指出了疏忽。

解决方案： 最终产品，没有原始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指出了疏忽。

那里没有管道，这些是文件句柄。我想你想看看。我相信这就是您试图重新创建的。@simbabque该模块看起来确实与我想要的类似，但功能更有限，因为它只捕获STDOUT和STDERR？而我的潜艇可以抓住任何把手。另外，由于它不是core的一部分，我不能将其用于我的应用程序。@Noino为什么不能？存在。如果您将不同答案的解决方案组合在一起，我们更希望您发布自己的答案并接受它。你可以在值得表扬的地方给予表扬，如果你觉得自己不配从它的得票中获得声誉，那就把它变成一篇社区维基文章。但请不要在问题中包含答案。melpomene的循环正确地处理了捕获的空列表，但您的更改引入了一个几乎无限的循环。那里没有管道，这些是文件句柄。我想你想看看。我相信这就是您试图重新创建的。@simbabque该模块看起来确实与我想要的类似，但功能更有限，因为它只捕获STDOUT和STDERR？而我的潜艇可以抓住任何把手。另外，由于它不是core的一部分，我不能将其用于我的应用程序。@Noino为什么不能？存在。如果您将不同答案的解决方案组合在一起，我们更希望您发布自己的答案并接受它。你可以在值得表扬的地方给予表扬，如果你觉得自己不配从它的得票中获得声誉，那就把它变成一篇社区维基文章。但请不要在问题中包含答案。melpomene的循环正确地处理了捕获的空列表，但您的更改引入了一个几乎无限的循环。我还没有弄清楚局部解决方案不起作用的原因。我还没有弄清楚局部解决方案不起作用的原因。这是有道理的。谢谢我知道我不能为…做任何事。。。{…}，但后来不知何故忘记了范围问题，因为我假设后期修复不会创建自己的。goto看起来很可怕，你一定要去洗手

---

我们正在建造这个。也许还有你的眼睛D@simbabque我在原帖中编辑的最终产品一点也不伤我的眼睛，但为了安全起见，我会洗掉手上的脏东西。谢谢我知道我不能为…做任何事。。。{…}，但后来不知何故忘记了范围问题，因为我假设后期修复不会创建自己的。后藤看起来很可怕，你一定要去洗手后，建立这个。也许还有你的眼睛D@simbabque我在原帖中编辑的最终产品一点也不会伤到我的眼睛，但为了安全起见，我会把脏衣服洗干净