package Filter::Handle;
use strict;
use vars qw/@ISA/;
use Tie::Handle; @ISA = qw/Tie::Handle/;

sub TIEHANDLE {
	my $class  = shift;
	my $fh = shift;
	bless $fh, $class;
}

sub new {
	my $class = shift;
	my $fh = shift;
	my $sub = shift;
	*fh = $sub;
	tie *{$fh}, __PACKAGE__, $fh;
	bless $fh, $class;
}

sub DESTROY {
	my $self = shift;
	my $fh   = *{ $self };
	{ local $^W = 0; untie *{$fh} }
}

sub PRINT {
	my $self = shift;
	my $fh = *$self;
	my $code = *fh{CODE};
	die "No output handler installed"
		unless defined $code;
	print $fh $code->(@_);
}

sub CLOSE { }

##</code><code>##

#!/usr/bin/perl -w
use strict;
use Filter::Handle;

local *OUTPUT;
open(OUTPUT, ">handle.txt") || die "Can't open: $!";

my $fh = \*OUTPUT;

my $f = Filter::Handle->new($fh,
    sub {
        my($file, $line) = (caller(1))[1,2];
        return sprintf "%s:%d - %s\n", $file, $line, @_;
});

print OUTPUT "Foo";
print OUTPUT "Bar";