PerlIO layer to trace all reads / writes

test.pl

#!/usr/bin/env perl
use strict;
use warnings;
use lib 'lib';
use PerlIO::via::Trace;
use open IO => ':via(Trace)';

open my $fh,'>','some.txt';
print $fh "blah\n";
print $fh "more\n";
close $fh;

Trace.pm

package PerlIO::via::Trace;
use strict;
use warnings;
use Fcntl;
use Devel::StackTrace;

my $log_fh;
sub _trace {
    my $fh = shift;
    local $@;local $!;
    my $name = readlink('/proc/self/fd/'.fileno($fh));
    return unless $name;
    return if $name =~ m{/trace\.log$};
    my $function = (caller(1))[3];
    my $trace = Devel::StackTrace->new(
        ignore_package => __PACKAGE__,
        no_args => 1,
    );
    open $log_fh,'>','/tmp/pio/trace.log'
        unless $log_fh;
    print $log_fh $trace->as_string," $function $name @_\n";
}

sub PUSHED {
    my ($class,$mode,$fh) = @_;
    return bless {},$class;
}

sub POPPED { }

sub UTF8 { 0 }

sub BINMODE { 0 }

sub FILL {
    my ($self,$buffer,$len,$fh) = @_;
    _trace($fh);
    return readline($fh);
}

sub WRITE {
    my ($self,$buffer,$fh) = @_;
    _trace($fh,$buffer);
    print $fh $buffer;
}

sub SEEK {
    my ($self,$pos,$whence,$fh) = @_;
    #_trace($fh,$pos,$whence);
    return seek $fh,$pos,$whence;
}

sub TELL {
    my ($self,$fh) = @_;
    #_trace($fh);
    return tell $fh;
}

sub FLUSH {
    my ($self,$fh) = @_;
    #_trace($fh);
    return  $fh->flush;
}

1;