Update to Filter::Simple 0.60, create a test for it.

p4raw-id: //depot/perl@9942

3 files changed, 154 insertions, 29 deletions

diff --git a/MANIFEST b/MANIFEST
index 1c10b72ed1..e308b68298 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -1446,6 +1446,7 @@ t/io/read.t		See if read works
 t/io/tell.t		See if file seeking works
 t/io/utf8.t		See if file seeking works
 t/lib/1_compile.t	See if the various libraries and extensions compile
+t/lib/MyFilter.pm	Helper file for t/lib/filter-simple.t
 t/lib/abbrev.t		See if Text::Abbrev works
 t/lib/ansicolor.t	See if Term::ANSIColor works
 t/lib/anydbm.t		See if AnyDBM_File works
@@ -1513,6 +1514,7 @@ t/lib/filefunc.t	See if File::Spec::Functions works
 t/lib/filehand.t	See if FileHandle works
 t/lib/filepath.t	See if File::Path works
 t/lib/filespec.t	See if File::Spec works
+t/lib/filter-simple.t	See if Filter::Simple works
 t/lib/filter-util.pl	See if Filter::Util::Call works
 t/lib/filter-util.t	See if Filter::Util::Call works
 t/lib/findbin.t		See if FindBin works
diff --git a/lib/Filter/Simple.pm b/lib/Filter/Simple.pm
index 48ece55a45..401722dd93 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,7 +110,6 @@ To use the module it is necessary to do the following:
 =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.)
 
 =item 2.
 
@@ -141,7 +157,7 @@ to the sequence C<die 'BANG' if $BANG> in any piece of code following a
 C<use BANG;> statement (until the next C<no BANG;> statement, if any):
 
         package BANG;
-
+ 
         use Filter::Util::Call ;
 
         sub import {
@@ -149,7 +165,7 @@ C<use BANG;> statement (until the next C<no BANG;> 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;
                         }
@@ -186,30 +202,107 @@ a source code filter is reduced to:
 
 =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.
 
@@ -218,22 +311,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<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
@@ -243,5 +338,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)
diff --git a/t/lib/filter-simple.t b/t/lib/filter-simple.t
new file mode 100644
index 0000000000..3fb32701c5
--- /dev/null
+++ b/t/lib/filter-simple.t
@@ -0,0 +1,27 @@
+#!./perl
+
+BEGIN {
+    chdir('t') if -d 't';    
+    @INC = 'lib';
+}
+
+print "1..6\n";
+
+use MyFilter qr/not ok/ => "ok", fail => "ok";
+
+sub fail { print "fail ", $_[0], "\n" }
+
+print "not ok 1\n";
+print "fail 2\n";
+
+fail(3);
+&fail(4);
+
+print "not " unless "whatnot okapi" eq "whatokapi";
+print "ok 5\n";
+
+no MyFilter;
+
+print "not " unless "not ok" =~ /^not /;
+print "ok 6\n";
+