Beefy Boxes and Bandwidth Generously Provided by pair Networks
There's more than one way to do things
 
PerlMonks  

RE: RE: Filehandle Filter

by btrott (Parson)
on Aug 11, 2000 at 05:06 UTC ( [id://27430]=note: print w/replies, xml ) Need Help??


in reply to RE: Filehandle Filter
in thread Filehandle Filter

Ooh. Thanks so much for that trick. Very nice.

How's this for the output functionality?

package Filter::Handle; use strict; use vars qw/@ISA/; use Tie::Handle; @ISA = qw/Tie::Handle/; sub TIEHANDLE { my $class = shift; bless { @_ }, $class; } sub new { my $class = shift; my $fh = shift; tie *{$fh}, __PACKAGE__, fh => $fh, @_; bless { fh => $fh }, $class; } sub DESTROY { my $self = shift; my $fh = $self->{fh}; { local $^W = 0; untie *{$fh} } } sub PRINT { my $self = shift; my $fh = *{ $self->{fh} }; die "No output handler installed" unless defined $self->{output}; print $fh $self->{output}->(@_); } sub CLOSE { }
Now to be used like this:
my $f = Filter::Handle->new(\*STDOUT, output => sub { my($file, $line) = (caller(1))[1,2]; return sprintf "%s:%d - %s\n", $file, $line, join ' ', @_; } ); print "Foo";
I think this might be nice to put on CPAN. I've just sent in my registration for a user ID. So... thanks very much for that idea!

Replies are listed 'Best First'.
chromatic Fixes Filehandle Filter (part 2)
by chromatic (Archbishop) on Aug 11, 2000 at 06:45 UTC
    Okay, I got rid of the hash and used blessed typeglobs, just because I'm that kinda guy and I want the approval of heroes like chip and merlyn and Damian.
    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 { }
    You can pass an anonymous sub or a sub ref to the constructor:
    #!/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";
    Yeah, that's pretty evil. But hey, why not?

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: note [id://27430]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others pondering the Monastery: (3)
As of 2024-04-26 03:04 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found