use vars qw{ $VERSION @EXPORT };
-$VERSION = '0.70';
+$VERSION = '0.78';
use Filter::Util::Call;
use Carp;
sub FILTER (&;$) {
my $caller = caller;
my ($filter, $terminator) = @_;
- no warnings 'redefine';
+ local $SIG{__WARN__} = sub{};
*{"${caller}::import"} = gen_filter_import($caller,$filter,$terminator);
- *{"${caller}::unimport"} = \*filter_unimport;
+ *{"${caller}::unimport"} = gen_filter_unimport($caller);
}
sub fail {
| ^=pod .*? $CUT
| ^=for .*? $EOP
| ^=begin \s* (\S+) .*? \n=end \s* \1 .*? $EOP
- | ^__(DATA|END)__\n.*
+ | ^__(DATA|END)__\r?\n.*
/smx;
my %extractor_for = (
sub gen_std_filter_for {
my ($type, $transform) = @_;
return sub { my (@pieces, $instr);
+ $DB::single=1;
for (extract_multiple($_,$extractor_for{$type})) {
if (ref()) { push @pieces, $_; $instr=0 }
elsif ($instr) { $pieces[-1] .= $_ }
s/$extractor/${$pieces[unpack('N',$1)]}/g;
}
else {
- $DB::single=1;
my $selector = $selector_for{$type}->($transform);
$_ = join "", map $selector->(@_), @pieces;
}
};
sub FILTER_ONLY {
- $DB::single = 1;
my $caller = caller;
while (@_ > 1) {
my ($what, $how) = splice(@_, 0, 2);
no warnings 'redefine';
*{"${caller}::import"} =
gen_filter_import($caller,$multitransform,$terminator);
- *{"${caller}::unimport"} = \*filter_unimport;
+ *{"${caller}::unimport"} = gen_filter_unimport($caller);
}
my $ows = qr/(?:[ \t]+|#[^\n]*)*/;
sub gen_filter_import {
my ($class, $filter, $terminator) = @_;
+ my %terminator;
+ my $prev_import = *{$class."::import"}{CODE};
return sub {
my ($imported_class, @args) = @_;
my $def_terminator =
- qr/^(?:\s*no\s+$imported_class\s*;$ows|__(?:END|DATA)__)$/;
+ qr/^(?:\s*no\s+$imported_class\s*;$ows|__(?:END|DATA)__)\r?$/;
if (!defined $terminator) {
- $terminator->{terminator} = $def_terminator;
+ $terminator{terminator} = $def_terminator;
}
- elsif (!ref $terminator) {
- $terminator->{terminator} = $terminator;
+ elsif (!ref $terminator || ref $terminator eq 'Regexp') {
+ $terminator{terminator} = $terminator;
}
elsif (ref $terminator ne 'HASH') {
croak "Terminator must be specified as scalar or hash ref"
}
elsif (!exists $terminator->{terminator}) {
- $terminator->{terminator} = $def_terminator;
+ $terminator{terminator} = $def_terminator;
}
filter_add(
sub {
my $data = "";
while ($status = filter_read()) {
return $status if $status < 0;
- if ($terminator->{terminator} &&
- m/$terminator->{terminator}/) {
+ if ($terminator{terminator} &&
+ m/$terminator{terminator}/) {
$lastline = $_;
last;
}
$count++;
$_ = "";
}
- $DB::single=1;
$_ = $data;
$filter->($imported_class, @args) unless $status < 0;
if (defined $lastline) {
- if (defined $terminator->{becomes}) {
- $_ .= $terminator->{becomes};
+ if (defined $terminator{becomes}) {
+ $_ .= $terminator{becomes};
}
elsif ($lastline =~ $def_terminator) {
$_ .= $lastline;
return $count;
}
);
+ if ($prev_import) {
+ goto &$prev_import;
+ }
+ elsif ($class->isa('Exporter')) {
+ $class->export_to_level(1,@_);
+ }
}
}
-sub filter_unimport {
- filter_del();
+sub gen_filter_unimport {
+ my ($class) = @_;
+ my $prev_unimport = *{$class."::unimport"}{CODE};
+ return sub {
+ filter_del();
+ goto &$prev_unimport if $prev_unimport;
+ }
}
1;
1 ;
+Note that the source code is passed as a single string, so any regex that
+uses C<^> or C<$> to detect line boundaries will need the C</m> flag.
=head2 Disabling or changing <no> behaviour
}
{ terminator => "" };
-B<Note that, no matter what you set the terminator pattern too,
+B<Note that, no matter what you set the terminator pattern to,
the actual terminator itself I<must> be contained on a single source line.>
FILTER_ONLY
code => sub { s/BANG\s+BANG/die 'BANG' if \$BANG/g },
- quotelike => sub { s/BANG\s+BANG/CHITTY CHITYY/g };
+ quotelike => sub { s/BANG\s+BANG/CHITTY CHITTY/g };
The C<"code"> subroutine will only be used to filter parts of the source
code that are not quotelikes, POD, or C<__DATA__>. The C<quotelike>
Note that you can also apply two or more of the same type of filter in
a single C<FILTER_ONLY>. For example, here's a simple
macro-preprocessor that is only applied within regexes,
-with a final debugging pass that printd the resulting source code:
+with a final debugging pass that prints the resulting source code:
use Regexp::Common;
FILTER_ONLY
defabc
-=head2 Using Filter::Simple and Exporter together
+=head2 Using Filter::Simple with an explicit C<import> subroutine
-You can't directly use Exporter when Filter::Simple.
+Filter::Simple generates a special C<import> subroutine for
+your module (see L<"How it works">) which would normally replace any
+C<import> subroutine you might have explicitly declared.
-Filter::Simple generates an C<import> subroutine for your module
-(which hides the one inherited from Exporter).
+However, Filter::Simple is smart enough to notice your existing
+C<import> and Do The Right Thing with it.
+That is, if you explicitly define an C<import> subroutine in a package
+that's using Filter::Simple, that C<import> subroutine will still
+be invoked immediately after any filter you install.
-The C<FILTER> code you specify will, however, receive the C<import>'s
-complete argument list (including the package name in $_[0]),
-so you can use that filter block as your C<import> subroutine.
+The only thing you have to remember is that the C<import> subroutine
+I<must> be declared I<before> the filter is installed. If you use C<FILTER>
+to install the filter:
-You'll need to call C<Exporter::export_to_level> from your C<FILTER> code
-to make it work correctly.
+ package Filter::TurnItUpTo11;
-For example:
+ use Filter::Simple;
- use Filter::Simple;
+ FILTER { s/(\w+)/\U$1/ };
+
+that will almost never be a problem, but if you install a filtering
+subroutine by passing it directly to the C<use Filter::Simple>
+statement:
- use base Exporter;
- @EXPORT = qw(foo);
- @EXPORT_OK = qw(bar);
+ package Filter::TurnItUpTo11;
- sub foo { print "foo\n" }
- sub bar { print "bar\n" }
+ use Filter::Simple sub{ s/(\w+)/\U$1/ };
- FILTER {
- # Your filtering code here
- __PACKAGE__->export_to_level(2,@_);
- }
+then you must make sure that your C<import> subroutine appears before
+that C<use> statement.
+
+
+=head2 Using Filter::Simple and Exporter together
+
+Likewise, Filter::Simple is also smart enough
+to Do The Right Thing if you use Exporter:
+
+ package Switch;
+ use base Exporter;
+ use Filter::Simple;
+
+ @EXPORT = qw(switch case);
+ @EXPORT_OK = qw(given when);
+
+ FILTER { $_ = magic_Perl_filter($_) }
+
+Immediately after the filter has been applied to the source,
+Filter::Simple will pass control to Exporter, so it can do its magic too.
+
+Of course, here too, Filter::Simple has to know you're using Exporter
+before it applies the filter. That's almost never a problem, but if you're
+nervous about it, you can guarantee that things will work correctly by
+ensuring that your C<use base Exporter> always precedes your
+C<use Filter::Simple>.
=head2 How it works
projects / p5sagit/p5-mst-13.2.git / blobdiff