X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FFilter%2FSimple.pm;h=9d88bf11c0f6b25fc45a22b75b940c8663f7513b;hb=cea00dc580b73966c5c98fc99732fe610def4247;hp=e9948aec074143ddf0460a4cf41c429bbbd79335;hpb=7a57cd469db83831120babccaac56d60dcf9c0d3;p=p5sagit%2Fp5-mst-13.2.git diff --git a/lib/Filter/Simple.pm b/lib/Filter/Simple.pm index e9948ae..9d88bf1 100644 --- a/lib/Filter/Simple.pm +++ b/lib/Filter/Simple.pm @@ -2,39 +2,50 @@ package Filter::Simple; 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; } ); } @@ -52,14 +63,20 @@ __END__ 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: @@ -93,6 +110,7 @@ To use the module it is necessary to do the following: =item 1. Download, build, and install the Filter::Util::Call module. +(If you have Perl 5.7.1 or later you already have Filter::Util::Call.) =item 2. @@ -140,7 +158,7 @@ to the sequence C in any piece of code following a C statement (until the next C statement, if any): package BANG; - + use Filter::Util::Call ; sub import { @@ -148,7 +166,7 @@ C statement (until the next C statement, if any): 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; } @@ -185,30 +203,107 @@ a source code filter is reduced to: =item 1. -Set up a module that does a C. +Set up a module that does a C and then +calls C. =item 2. -Within the anonymous subroutine passed to C, process the -contents of $_ to change the source code in the desired manner. +Within the anonymous subroutine or block that is passed to +C, 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 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. + +That second argument may be either a C'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 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 subroutine is not exported by Filter::Simple. + + =head2 How it works -The Filter::Simple module exports into the package that Cs it (e.g. -package "BANG" in the above example) two automagically constructed +The Filter::Simple module exports into the package that calls C +(or Cs it directly) -- such as package "BANG" in the above example -- +two automagically constructed subroutines -- C and C -- which take care of all the nasty details. @@ -217,22 +312,24 @@ list to the filtering subroutine, so the BANG.pm filter could easily 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 -is encountered, and passed all the source code following that call, -up to either the next C call or the end of the source file -(whichever occurs first). Currently, any C call must appear -by itself on a separate line, or it is ignored. +The specified filtering subroutine is called every time a C is +encountered, and passed all the source code following that call, up to +either the next C (or whatever terminator you've set) or the +end of the source file, whichever occurs first. By default, any C call must appear by itself on a separate line, or it is ignored. =head1 AUTHOR @@ -242,5 +339,6 @@ Damian Conway (damian@conway.org) =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)