Как я могу использовать tie() для перенаправления STDOUT, STDERR только для определенных пакетов?

Question

Мне нужно работать с некоторыми библиотеками, которые, к сожалению, регистрируют диагностические сообщения в 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.

Answer 1

Помимо исправления библиотек, я могу думать только об одном решении, которое может быть лучше.

Вы можете заново открыть 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

Вы можете прочитать perldoc -f open для всех подробностей о том, что делает ">&" и тому подобное.

В любом случае, вместо "/tmp/test.txt" вы можете заменить этот открытый вызов настройкой для вашего дескриптора связанного файла.

Ваш код должен всегда использовать явный дескриптор файла для записи или использовать select для переключения дескрипторов файла:

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

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