in reply to Filehandle Filter
All right, here's a new version. This one has support for filtering
and unfiltering filehandles by calling functions on them, as
opposed to the object going out of scope method.
Usage below.
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;
Usage is either what we had before:
my $f = Filter::Handle->new(\*STDOUT,
sub { "Foo: @_\n" });
print "Bar";
Or the new
use Filter::Handle qw/subs/;
Filter \*STDOUT, sub { "Foo: @_\n" };
print "Bar";
UnFilter \*STDOUT;
RE: RE: Filehandle Filter
by btrott (Parson) on Aug 12, 2000 at 22:10 UTC
|
Here's my POD documentation for this module (which is
basically what the latest version looks like):
=head1 NAME
Filter::Handle - Apply filters to output filehandles
=head1 SYNOPSIS
use Filter::Handle;
my $f = Filter::Handle->new(\*STDOUT);
use Filter::Handle qw/subs/;
Filter \*STDOUT;
...
UnFilter \*STDOUT;
=head1 DESCRIPTION
I<Filter::Handle> allows you to apply arbitrary filters
to output filehandles. You can perform any sorts of
transformations on the outgoing text: you can prepend it
with some data, you can replace all instances of one word
with another, etc.
You can even filter all of your output to one filehandle
and send it to another; for example, you can filter
everything written to STDOUT and write it instead to
another filehandle. To do this, you need to explicitly
use the I<tie> interface (see below).
=head2 Calling Interfaces
There are three interfaces to filtering a handle:
=over 4
=item * Functional
use Filter::Handle qw/subs/;
Filter \*STDOUT;
print "I am filtered text";
UnFilter \*STDOUT;
print "I am normal text";
The functional interface works by exporting two functions
into the caller's namespace: I<Filter> and I<UnFilter>. To
start filtering a filehandle, call the I<Filter> function;
to stop, call I<UnFilter> on that same filehandle.
Any writes between the time you start and stop filtering
will be filtered.
=item * Object-Oriented
use Filter::Handle;
{
my $f = Filter::Handle->new(\*STDOUT);
print "I am filtered text";
}
print "I am normal text";
The object-oriented interface works by filtering the
filehandle while your object is in scope. Once all
references to that object have gone out of scope--typically,
this is after your one reference has gone away--the
filehandle will no longer be filtered.
=item * Tie Interface
use Filter::Handle;
local *HANDLE;
tie *STDOUT, 'Filter::Handle', \*HANDLE;
print "I am filtered text written to HANDLE";
untie *STDOUT;
The I<tie> interface will filter your filehandle until
you explicitly I<untie> it. This is the only interface
that allows you to filter one filehandle through another.
The above example will filter all writes to STDOUT through
the output filter, then write it out on HANDLE. Note that
this is different behavior than that of the first two
interfaces; if you want your output written to the same
handle that you're filtering, you could use:
tie *STDOUT, 'Filter::Handle', \*STDOUT;
Which is exactly what the first two interfaces do.
=back
=head2 Customized Filters
The default filter is relatively boring: it simply prepends
any text you print with the filename and line of the invoking
caller. You'll probably want to do something more interesting.
To do so, pass an anonymous subroutine as a second argument
to either the I<new> method, if you're using the OO interface,
or to the I<Filter> function, if you're using the functional
interface. Your subroutine will be passed the list originally
passed to print, and it should return another list, suitable
for passing to your (unfiltered) output filehandle.
For example, say that we want to replace all instances of
"blue" with "red". We could say:
use Filter::Handle qw/subs/;
Filter \*STDOUT,
sub { local $_ = "@_"; s/blue/red/g; $_ };
print "My house is blue.\n";
print "So is my cat, whose nose is blue.\n";
UnFilter \*STDOUT;
print "And the plane is also blue.\n";
This prints:
My house is red.
So is my cat, whose nose is red.
And the plane is also blue.
As expected.
=head1 CAVEATS
Note that this won't work correctly with output from
XSUBs or system calls. This is due to a limitation of
Perl's I<tie> mechanism when tying filehandles.
=head1 AUTHOR
Benjamin Trott, ben@rhumba.pair.com
=head1 CREDITS
Thanks to tilly, chromatic, Adam, and merlyn at
PerlMonks.org for suggestions, critiques, and code samples.
=cut
| [reply] [d/l] |
|
Excellent! And for those who look at the code and are
totally lost, here is a useful hint on how tie works. All
that tie does is allow an object in a class that defines
the right methods to look like a native Perl datatype. The
only thing you have to do is make sure that you are
providing the OO interface that Perl is looking for.
To find out what methods are part of the interface
that Perl knows to look for type "perldoc -f tie". Note
that the documentation here of tie is somewhat
misleading since it documents the
limitations of tie that were in Perl 5.003. For instance
you probably can create a full tied
interface
to an array.
It feels strange the first few times you create an
implementation of a tied class, but it really is not very
hard and it is an excellent example of how encapsulation
can lead to good things later. :-)
| [reply] |
Re^2: Filehandle Filter
by cadphile (Beadle) on Nov 23, 2021 at 00:10 UTC
|
Hey now, 21 years after this inspired module was added, I just wanted to note a small bug in the Filter subroutine (in package Filter::Handle). It should be:
sub Filter {
my $fh = shift;
tie *{ $fh }, __PACKAGE__, @_;
}
Note how the subroutine UnFilter uses the shift correctly.
Also, it's a shame that this is no longer on CPAN. But this chunk of module is enough to put into one's "private" library for use. Using a CODE reference, you can duplicate all your STDOUT and STDERR (including any that comes out of perl warnings), like the following:
select STDERR; $|=1;
select STDOUT; $|=1;
use FileHandle;
my $LOG_FH = new FileHandle($logfile, "w");
$LOG_FH->autoflush;
open(DUPOUT, ">&STDOUT") or die "Couldn't dup STDOUT: $!\n";
open(DUPERR, ">&STDERR") or die "Couldn't dup STDERR: $!\n";
use Filter::Handle qw/subs/;
our $FILTER_STDOUT = sub
{ local $_ = "@_";
print DUPOUT $_;
sprintf "[STDOUT]: %s", "@_"
if (defined $LOG_FH && $LOG_FH->opened);
};
our $FILTER_STDERR = sub
{ local $_ = "@_";
print DUPERR $_;
sprintf "[STDERR]: %s", "@_"
if (defined $LOG_FH && $LOG_FH->opened);
};
## Call Filter to tie the filehandles
## Call UnFilter to untie the filehandles (don't care)
Filter \*STDOUT, $LOG_FH, $FILTER_STDOUT;
Filter \*STDERR, $LOG_FH, $FILTER_STDERR;
I like this much better than IO::Tee, because I don't need a custom filehandle to print to to get a logfile of all output. I'm continuing to play around with this and may update this thread more later.
| [reply] [d/l] [select] |
|
What version of Perl are you using? The original usage example
use Filter::Handle qw/subs/;
Filter \*STDOUT, sub { "Foo: @_\n" };
print "Bar";
UnFilter \*STDOUT;
works for me correctly in 5.6.2, but fails in 5.10.1 with
Deep recursion on subroutine "Filter::Handle::PRINT" at .../lib/Filter
+/Handle.pm line 51.
Segmentation fault (core dumped)
When I replace $_[0] with shift, it fails in all the versions from 5.6.2 to blead:
Not a GLOB reference at .../lib/Filter/Handle.pm line 50.
(in cleanup) Not a GLOB reference at .../lib/Filter/Handle.pm line
+ 25 during global destruction.
> it's a shame that this is no longer on CPAN
See Text::OutputFilter.
map{substr$_->[0],$_->[1]||0,1}[\*||{},3],[[]],[ref qr-1,-,-1],[{}],[sub{}^*ARGV,3]
| [reply] [d/l] [select] |
(Adam: usage for:) REx2 Filehandle Filter
by Adam (Vicar) on Aug 12, 2000 at 00:23 UTC
|
That module is really cool. I wrote the following filter to use with it to generate line numbers:
use Filter::Handle qw/subs/;
use strict;
{
my( $i, $n ) = (0,1); # Scoped, only the filter sees them
Filter \*STDOUT,
sub
{
@_ = @_; # Laziness
my $string = $n ? "Line ".++$i.": " : "";
for(@_){ s/\n(.)/"\nLine ".++$i.": $1"/egm; $string .= $_ }
$n = $_[$#_] =~ /\n$/;
return $string;
}
}
# A quick test:
print "line 1\n";
print 'line 2', ' line 2 cont.';
print ' more stuff for line 2', "\n";
print "this is line 3\nand this is line 4";
print "\nthis is line 5";
__END__
# And yes, this prints:
Line 1: line 1
Line 2: line 2 line 2 cont. more stuff for line 2
Line 3: this is line 3
Line 4: and this is line 4
Line 5: this is line 5
| [reply] [d/l] |
|
|