How can I use tie() to redirect STDOUT, STDERR only for certain packages?

问题

I need to work with some libraries that unfortunately log diagnostic messages to STDOUT and STDERR. By using tie, I can redirect those writes to a function that captures those. Since I don't want all STDOUT and STDERR output of my programs to be captured thtough the tied handle, I'd like to do this only for certain packages.

I have come up with a solution where the actual behavior is determined by looking at caller() as can be seen below, but I have the feeling that there has to be a better way... Is there a more elegant solution?

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.

回答1:

Aside from fixing the libraries, I can think of only one solution that might be better.

You can re-open STDOUT and STDERR file handles into your own file handles. Then, re-open STDOUT and STDERR with your tied handles.

For example, here's how you do it for 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

You can read perldoc -f open for all the gory details on what ">&" and such does.

Anyway, instead of "/tmp/test.txt" you can replace that open call with the setup for your tied file handle.

Your code will have to always use an explicit file handle to write or use select to switch file handles:

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

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

来源：https://stackoverflow.com/questions/11461794/how-can-i-use-tie-to-redirect-stdout-stderr-only-for-certain-packages

标签

perl

filehandle

tie