package Filter::Handle;
use strict;
sub import {
my $class = shift;
return if !@_;
my $caller = caller;
if ($_[0] eq "subs") {
no strict 'refs';
for my $sub (qw/Filter UnFilter/) {
*{"${caller}::$sub"} = \&{"${class}::$sub"};
}
}
}
sub Filter {
my $fh = $_[0];
tie *{ $fh }, __PACKAGE__, @_;
}
sub UnFilter {
my $fh = shift;
{ local $^W = 0; untie *{ $fh } }
}
sub TIEHANDLE {
my $class = shift;
my $fh = shift or die "Need a filehandle.";
my $output = shift || sub {
my($file, $line) = (caller(1))[1,2];
sprintf "%s:%d - %s\n", $file, $line, "@_"
};
bless { fh => $fh, output => $output }, $class;
}
sub new {
Filter(@_[1..$#_]);
bless { fh => $_[1] }, $_[0]
}
sub DESTROY {
my $self = shift;
UnFilter($self->{fh});
}
sub PRINT {
my $self = shift;
my $fh = *{ $self->{fh} }; ## thanks, chromatic :)
print $fh $self->{output}->(@_);
}
sub PRINTF {
my $self = shift;
my $fmt = shift;
@_ = ($self, sprintf $fmt, @_);
goto &PRINT; ## thanks, tilly :)
}
1;
####
my $f = Filter::Handle->new(\*STDOUT,
sub { "Foo: @_\n" });
print "Bar";
##
##
use Filter::Handle qw/subs/;
Filter \*STDOUT, sub { "Foo: @_\n" };
print "Bar";
UnFilter \*STDOUT;