From: Jarkko Hietaniemi <jhi@iki.fi>
Date: Fri, 23 Nov 2001 19:39:57 +0000 (+0000)
Subject: Upgrade to Filter::Simple 0.77.
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=201f48202ca1461d337bdf669489172554d045ef;p=p5sagit%2Fp5-mst-13.2.git

Upgrade to Filter::Simple 0.77.

p4raw-id: //depot/perl@13223
---

diff --git a/MANIFEST b/MANIFEST
index 8618ff2..dbe9c51 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -988,8 +988,10 @@ lib/Filter/Simple.pm		Simple frontend to Filter::Util::Call
 lib/Filter/Simple/Changes	Filter::Simple
 lib/Filter/Simple/README	Filter::Simple
 lib/Filter/Simple/t/data.t	See if Filter::Simple works
+lib/Filter/Simple/t/export.t	See if Filter::Simple works
 lib/Filter/Simple/t/filter.t	See if Filter::Simple works
 lib/Filter/Simple/t/filter_only.t	See if Filter::Simple works
+lib/Filter/Simple/t/import.t	See if Filter::Simple works
 lib/find.pl			A find emulator--used by find2perl
 lib/FindBin.pm			Find name of currently executing program
 lib/FindBin.t			See if FindBin works
@@ -2078,8 +2080,10 @@ t/lib/dprof/test6_t		Perl code profiler tests
 t/lib/dprof/test6_v		Perl code profiler tests
 t/lib/dprof/V.pm		Perl code profiler tests
 t/lib/filter-util.pl		See if Filter::Util::Call works
-t/lib/FilterOnlyTest.pm		Helper file for lib/Filter/Simple/t/filter_only.t
-t/lib/FilterTest.pm		Helper file for lib/Filter/Simple/t/filter.t
+t/lib/Filter/Simple/ExportTest.pm		Helper file for lib/Filter/Simple/t/export.t
+t/lib/Filter/Simple/FilterOnlyTest.pm		Helper file for lib/Filter/Simple/t/filter_only.t
+t/lib/Filter/Simple/FilterTest.pm		Helper file for lib/Filter/Simple/t/filter.t
+t/lib/Filter/Simple/ImportTest.pm		Helper file for lib/Filter/Simple/t/import.t
 t/lib/h2ph.h			Test header file for h2ph
 t/lib/h2ph.pht			Generated output from h2ph.h by h2ph, for comparison
 t/lib/locale/latin1		Part of locale.t in Latin 1
diff --git a/lib/Filter/Simple.pm b/lib/Filter/Simple.pm
index a0b4a5c..5af910d 100644
--- a/lib/Filter/Simple.pm
+++ b/lib/Filter/Simple.pm
@@ -4,7 +4,7 @@ use Text::Balanced ':ALL';
 
 use vars qw{ $VERSION @EXPORT };
 
-$VERSION = '0.70';
+$VERSION = '0.77';
 
 use Filter::Util::Call;
 use Carp;
@@ -22,7 +22,7 @@ sub FILTER (&;$) {
 	my ($filter, $terminator) = @_;
 	no warnings 'redefine';
 	*{"${caller}::import"} = gen_filter_import($caller,$filter,$terminator);
-	*{"${caller}::unimport"} = \*filter_unimport;
+	*{"${caller}::unimport"} = gen_filter_unimport($caller);
 }
 
 sub fail {
@@ -115,7 +115,6 @@ sub gen_std_filter_for {
 			s/$extractor/${$pieces[unpack('N',$1)]}/g;
 		     }
 		     else {
-			$DB::single=1;
 		        my $selector = $selector_for{$type}->($transform);
 		        $_ = join "", map $selector->(@_), @pieces;
 		     }
@@ -123,7 +122,6 @@ sub gen_std_filter_for {
 };
 
 sub FILTER_ONLY {
-	$DB::single = 1;
 	my $caller = caller;
 	while (@_ > 1) {
 		my ($what, $how) = splice(@_, 0, 2);
@@ -143,28 +141,30 @@ sub FILTER_ONLY {
 	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)__)$/;
 	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 {
@@ -173,8 +173,8 @@ sub gen_filter_import {
 			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;
 				}
@@ -182,12 +182,11 @@ sub gen_filter_import {
 				$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;
@@ -196,11 +195,22 @@ sub gen_filter_import {
 			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;
@@ -633,35 +643,62 @@ and hence print:
         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 explcitly 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
diff --git a/lib/Filter/Simple/Changes b/lib/Filter/Simple/Changes
index 9113bdc..6fbdebc 100644
--- a/lib/Filter/Simple/Changes
+++ b/lib/Filter/Simple/Changes
@@ -44,3 +44,23 @@ Revision history for Perl extension Filter::Simple
 	  (thanks, Christian) and to handle __DATA__ and __END__
 
 	- Fixed handling of __DATA__ and *DATA
+
+
+0.75	Fri Nov 16 14:36:07 2001
+
+	- Corified tests (thanks Jarkko)
+
+	- Added automatic preservation of existing &import subroutines
+
+	- Added automatic preservation of Exporter semantics 
+
+
+0.76	Fri Nov 16 15:08:42 2001
+
+	- Modified call to explicit &import so as to be invoked in original 
+	  call context
+
+
+0.77	Sat Nov 24 06:48:47 2001
+
+	- Re-allowed user-defined terminators to be regexes
diff --git a/lib/Filter/Simple/README b/lib/Filter/Simple/README
index 5f22642..832643d 100644
--- a/lib/Filter/Simple/README
+++ b/lib/Filter/Simple/README
@@ -1,5 +1,5 @@
 ==============================================================================
-                  Release of version 0.70 of Filter::Simple
+                  Release of version 0.77 of Filter::Simple
 ==============================================================================
 
 
@@ -46,21 +46,10 @@ COPYRIGHT
 
 ==============================================================================
 
-CHANGES IN VERSION 0.70
+CHANGES IN VERSION 0.77
 
 
-	- Added FILTER_ONLY for fine-grained filtering of code,
-	  strings, or regexes
-
-	- Fixed document snafu regarding optional terminators
-
-	- Fixed bug so that FILTER now receives *all* import args
-	  (i.e. including the class name in $_[0])
-
-	- Allowed default terminator to allow comments embedded in it
-	  (thanks, Christian) and to handle __DATA__ and __END__
-
-	- Fixed handling of __DATA__ and *DATA
+	- Re-allowed user-defined terminators to be regexes
 
 
 ==============================================================================
diff --git a/lib/Filter/Simple/t/data.t b/lib/Filter/Simple/t/data.t
index 8307f04..c90702b 100644
--- a/lib/Filter/Simple/t/data.t
+++ b/lib/Filter/Simple/t/data.t
@@ -1,7 +1,7 @@
 BEGIN {
     if ($ENV{PERL_CORE}) {
         chdir('t') if -d 't';
-        @INC = qw(lib ../lib);
+        @INC = qw(lib/Filter/Simple ../lib);
     }
 }
 
diff --git a/lib/Filter/Simple/t/export.t b/lib/Filter/Simple/t/export.t
new file mode 100644
index 0000000..805a67a
--- /dev/null
+++ b/lib/Filter/Simple/t/export.t
@@ -0,0 +1,12 @@
+BEGIN {
+    if ($ENV{PERL_CORE}) {
+        chdir('t') if -d 't';
+        @INC = qw(lib/Filter/Simple ../lib);
+    }
+}
+
+BEGIN { print "1..1\n" }
+
+use ExportTest 'ok';
+
+notok 1;
diff --git a/lib/Filter/Simple/t/filter.t b/lib/Filter/Simple/t/filter.t
index 618d9f4..d971b81 100644
--- a/lib/Filter/Simple/t/filter.t
+++ b/lib/Filter/Simple/t/filter.t
@@ -1,7 +1,7 @@
 BEGIN {
     if ($ENV{PERL_CORE}) {
         chdir('t') if -d 't';
-        @INC = qw(lib ../lib);
+        @INC = qw(lib/Filter/Simple ../lib);
     }
 }
 
diff --git a/lib/Filter/Simple/t/filter_only.t b/lib/Filter/Simple/t/filter_only.t
index 60d83d8..9f81a3c 100644
--- a/lib/Filter/Simple/t/filter_only.t
+++ b/lib/Filter/Simple/t/filter_only.t
@@ -1,7 +1,7 @@
 BEGIN {
     if ($ENV{PERL_CORE}) {
         chdir('t') if -d 't';
-        @INC = qw(lib ../lib);
+        @INC = qw(lib/Filter/Simple ../lib);
     }
 }
 
diff --git a/lib/Filter/Simple/t/import.t b/lib/Filter/Simple/t/import.t
new file mode 100644
index 0000000..99306de
--- /dev/null
+++ b/lib/Filter/Simple/t/import.t
@@ -0,0 +1,12 @@
+BEGIN {
+    if ($ENV{PERL_CORE}) {
+        chdir('t') if -d 't';
+        @INC = qw(lib/Filter/Simple ../lib);
+    }
+}
+
+BEGIN { print "1..4\n" }
+
+use ImportTest (1..3);
+
+say "not ok 4\n";
diff --git a/t/lib/FilterOnlyTest.pm b/t/lib/FilterOnlyTest.pm
deleted file mode 100644
index 856e79d..0000000
--- a/t/lib/FilterOnlyTest.pm
+++ /dev/null
@@ -1,11 +0,0 @@
-package FilterOnlyTest;
-
-use Filter::Simple;
-
-FILTER_ONLY
-	string => sub {
-		my $class = shift;
-		while (my($pat, $str) = splice @_, 0, 2) {
-			s/$pat/$str/g;
-		}
-	};
diff --git a/t/lib/FilterTest.pm b/t/lib/FilterTest.pm
deleted file mode 100644
index c49e280..0000000
--- a/t/lib/FilterTest.pm
+++ /dev/null
@@ -1,12 +0,0 @@
-package FilterTest;
-
-use Filter::Simple;
-
-FILTER {
-	my $class = shift;
-	while (my($pat, $str) = splice @_, 0, 2) {
-		s/$pat/$str/g;
-	}
-};
-
-1;