Perl 如何使用tie（）仅为某些包重定向STDOUT、STDERR？

我需要使用一些不幸记录诊断的库 发送到STDOUT和STDERR的消息。通过使用

tie

，我可以重定向这些 写入一个函数，该函数捕获这些数据。因为我不想要所有的 要捕获的程序的STDOUT和STDERR输出 系把手，我只想对某些包裹这样做

我已经提出了一个解决方案，其中实际行为是确定的 通过查看caller（），如下所示，但我有这种感觉 必须有更好的方法。。。有更优雅的解决方案吗

package My::Log::Capture;
use strict;
use warnings;
use 5.010;

sub TIEHANDLE {
    my ($class, $channel, $fh, $packages) = @_;
    bless {
        channel => lc $channel,
        fh => $fh,
        packages => $packages,
    }, $class;
}

sub PRINT {
    my $self = shift;
    my $caller = (caller)[0];
    if ($caller ~~ $self->{packages}) {
        local *STDOUT = *STDOUT;
        local *STDERR = *STDERR;
        given ($self->{channel}) {
            when ('stdout') {
                *STDOUT = $self->{fh};
            }
            when ('stderr') {
                *STDERR = $self->{fh};
            }
        }
        # Capturing/Logging code goes here...
    } else {
        $self->{fh}->print(@_);
    }
}

1;

package main;

use My::Foo;
# [...]
use My::Log::Capture;
open my $stderr, '>&', *STDERR;
tie *STDERR, 'My::Log::Capture', (stderr => $stderr, [qw< My::Foo >]);
# My::Foo's STDERR output will be captured, everyone else's STDERR
# output will just be relayed.

package My:：Log:：Capture；
严格使用；
使用警告；
使用5.010；
副拉杆{
我的（$class、$channel、$fh、$packages）=@；
祝福{
频道=>lc$频道，
fh=>$fh，
packages=>$packages，
}，$class；
}
子打印{
我的$self=shift；
我的$caller=（caller）[0]；
if（$caller~~$self->{packages}）{
本地*STDOUT=*STDOUT；
本地*STDERR=*STDERR；
给定（$self->{channel}）{
何时（'stdout'）{
*STDOUT=$self->{fh}；
}
何时（'stderr'）{
*STDERR=$self->{fh}；
}
}
#捕获/记录代码在这里。。。
}否则{
$self->{fh}->打印（@）；
}
}
1.
主包装；
使用My：：Foo；
# [...]
使用My:：Log:：Capture；
打开我的$stderr，'>&'，*stderr；
tie*STDERR，'My:：Log:：Capture'（STDERR=>$STDERR，[qw]）；
#我的：：Foo的STDERR输出将被捕获，其他所有人的STDERR都将被捕获
#输出将被中继。

除了修复库之外，我只能想出一个更好的解决方案

您可以将

STDOUT

和

STDERR

文件句柄重新打开到自己的文件句柄中。然后，用系好的手柄重新打开

STDOUT

和

STDERR

例如，下面是如何为

STDOUT

：

open my $fh, ">&", \*STDOUT or die "cannot reopen STDOUT: $!";
close STDOUT; 

open STDOUT, ">", "/tmp/test.txt"; 

say $fh "foo"; # goes to real STDOUT
say "bar";     # goes to /tmp/test.txt

您可以阅读“>&”等内容的所有血淋淋的细节

无论如何，您可以用绑定文件句柄的设置替换打开的调用，而不是“/tmp/test.txt”

您的代码必须始终使用显式文件句柄来写入或切换文件句柄：

select $fh;
say "foo"; # goes to real STDOUT

select STDOUT;
say "bar"; # goes to /tmp/test.txt

---

顺便说一句，如果您只需要担心

STDOUT

，只需选择

就可以做到这一点。