Question

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.

Answer 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