use vars qw{ $VERSION };
-$VERSION = '0.50';
+$VERSION = '0.60';
use Filter::Util::Call;
use Carp;
sub import {
+ if (@_>1) { shift; goto &FILTER }
+ else { *{caller()."::FILTER"} = \&FILTER }
+}
+
+sub FILTER (&;$) {
my $caller = caller;
- my ($class, $filter) = @_;
- croak "Usage: use Filter::Simple sub {...}" unless ref $filter eq CODE;
- *{"${caller}::import"} = gen_filter_import($caller, $filter);
+ my ($filter, $terminator) = @_;
+ croak "Usage: use Filter::Simple sub {...}, $terminator_opt;"
+ unless ref $filter eq CODE;
+ *{"${caller}::import"} = gen_filter_import($caller,$filter,$terminator);
*{"${caller}::unimport"} = \*filter_unimport;
}
sub gen_filter_import {
- my ($class, $filter) = @_;
+ my ($class, $filter, $terminator) = @_;
return sub {
my ($imported_class, @args) = @_;
+ $terminator = qr/^\s*no\s+$imported_class\s*;\s*$/
+ unless defined $terminator;
filter_add(
sub {
my ($status, $off);
+ my $count = 0;
my $data = "";
while ($status = filter_read()) {
- if (m/^\s*no\s+$class\s*;\s*$/) {
+ return $status if $status < 0;
+ if ($terminator && m/$terminator/) {
$off=1;
last;
}
$data .= $_;
+ $count++;
$_ = "";
}
$_ = $data;
$filter->(@args) unless $status < 0;
- $_ .= "no $class;\n" if $off;
- return length;
+ $_ .= "no $imported_class;\n" if $off;
+ return $count;
}
);
}
Filter::Simple - Simplified source filtering
+
=head1 SYNOPSIS
# in MyFilter.pm:
package MyFilter;
- use Filter::Simple sub { ... };
+ use Filter::Simple;
+
+ FILTER { ... };
+ # or just:
+ #
+ # use Filter::Simple sub { ... };
# in user's code:
=item 1.
Download, build, and install the Filter::Util::Call module.
-(If you are using Perl 5.7.1 or later, you already have Filter::Util::Call.)
+(If you have Perl 5.7.1 or later you already have Filter::Util::Call.)
=item 2.
C<use BANG;> statement (until the next C<no BANG;> statement, if any):
package BANG;
-
+
use Filter::Util::Call ;
sub import {
my $caller = caller;
my ($status, $no_seen, $data);
while ($status = filter_read()) {
- if (/^\s*no\s+$caller\s*;\s*$/) {
+ if (/^\s*no\s+$caller\s*;\s*?$/) {
$no_seen=1;
last;
}
=item 1.
-Set up a module that does a C<use Filter::Simple sub { ... }>.
+Set up a module that does a C<use Filter::Simple> and then
+calls C<FILTER { ... }>.
=item 2.
-Within the anonymous subroutine passed to C<use Filter::Simple>, process the
-contents of $_ to change the source code in the desired manner.
+Within the anonymous subroutine or block that is passed to
+C<FILTER>, process the contents of $_ to change the source code in
+the desired manner.
=back
In other words, the previous example, would become:
package BANG;
-
- use Filter::Simple sub {
+ use Filter::Simple;
+
+ FILTER {
s/BANG\s+BANG/die 'BANG' if \$BANG/g;
};
1 ;
+=head2 Disabling or changing <no> behaviour
+
+By default, the installed filter only filters to a line of the form:
+
+ no ModuleName;
+
+but this can be altered by passing a second argument to C<use Filter::Simple>.
+
+That second argument may be either a C<qr>'d regular expression (which is then
+used to match the terminator line), or a defined false value (which indicates
+that no terminator line should be looked for).
+
+For example, to cause the previous filter to filter only up to a line of the
+form:
+
+ GNAB esu;
+
+you would write:
+
+ package BANG;
+ use Filter::Simple;
+
+ FILTER {
+ s/BANG\s+BANG/die 'BANG' if \$BANG/g;
+ }
+ => qr/^\s*GNAB\s+esu\s*;\s*?$/;
+
+and to prevent the filter's being turned off in any way:
+
+ package BANG;
+ use Filter::Simple;
+
+ FILTER {
+ s/BANG\s+BANG/die 'BANG' if \$BANG/g;
+ }
+ => "";
+ # or: => 0;
+
+
+=head2 All-in-one interface
+
+Separating the loading of Filter::Simple:
+
+ use Filter::Simple;
+
+from the setting up of the filtering:
+
+ FILTER { ... };
+
+is useful because it allows other code (typically parser support code
+or caching variables) to be defined before the filter is invoked.
+However, there is often no need for such a separation.
+
+In those cases, it is easier to just append the filtering subroutine and
+any terminator specification directly to the C<use> statement that loads
+Filter::Simple, like so:
+
+ use Filter::Simple sub {
+ s/BANG\s+BANG/die 'BANG' if \$BANG/g;
+ };
+
+This is exactly the same as:
+
+ use Filter::Simple;
+ BEGIN {
+ Filter::Simple::FILTER {
+ s/BANG\s+BANG/die 'BANG' if \$BANG/g;
+ };
+ }
+
+except that the C<FILTER> subroutine is not exported by Filter::Simple.
+
+
=head2 How it works
-The Filter::Simple module exports into the package that C<use>s it (e.g.
-package "BANG" in the above example) two automagically constructed
+The Filter::Simple module exports into the package that calls C<FILTER>
+(or C<use>s it directly) -- such as package "BANG" in the above example --
+two automagically constructed
subroutines -- C<import> and C<unimport> -- which take care of all the
nasty details.
be made parametric:
package BANG;
-
- use Filter::Simple sub {
+
+ use Filter::Simple;
+
+ FILTER {
my ($die_msg, $var_name) = @_;
s/BANG\s+BANG/die '$die_msg' if \${$var_name}/g;
};
# and in some user code:
- use BANG "BOOM", "BAM; # "BANG BANG" becomes: die 'BOOM' if $BAM
+ use BANG "BOOM", "BAM"; # "BANG BANG" becomes: die 'BOOM' if $BAM
-The specified filtering subroutine is called every time a C<use BANG>
-is encountered, and passed all the source code following that call,
-up to either the next C<no BANG;> call or the end of the source file
-(whichever occurs first). Currently, any C<no BANG;> call must appear
-by itself on a separate line, or it is ignored.
+The specified filtering subroutine is called every time a C<use BANG> is
+encountered, and passed all the source code following that call, up to
+either the next C<no BANG;> (or whatever terminator you've set) or the
+end of the source file, whichever occurs first. By default, any C<no
+BANG;> call must appear by itself on a separate line, or it is ignored.
=head1 AUTHOR
=head1 COPYRIGHT
Copyright (c) 2000, Damian Conway. All Rights Reserved.
-This module is free software; you can redistribute it and/or
-modify it under the same terms as Perl itself.
+ This module is free software. It may be used, redistributed
+and/or modified under the terms of the Perl Artistic License
+ (see http://www.perl.com/perl/misc/Artistic.html)
projects / p5sagit/p5-mst-13.2.git / blobdiff