From 201f48202ca1461d337bdf669489172554d045ef Mon Sep 17 00:00:00 2001 From: Jarkko Hietaniemi Date: Fri, 23 Nov 2001 19:39:57 +0000 Subject: [PATCH] Upgrade to Filter::Simple 0.77. p4raw-id: //depot/perl@13223 --- MANIFEST | 8 ++- lib/Filter/Simple.pm | 109 +++++++++++++++++++++++++------------- lib/Filter/Simple/Changes | 20 +++++++ lib/Filter/Simple/README | 17 ++---- lib/Filter/Simple/t/data.t | 2 +- lib/Filter/Simple/t/export.t | 12 +++++ lib/Filter/Simple/t/filter.t | 2 +- lib/Filter/Simple/t/filter_only.t | 2 +- lib/Filter/Simple/t/import.t | 12 +++++ t/lib/FilterOnlyTest.pm | 11 ---- t/lib/FilterTest.pm | 12 ----- 11 files changed, 129 insertions(+), 78 deletions(-) create mode 100644 lib/Filter/Simple/t/export.t create mode 100644 lib/Filter/Simple/t/import.t delete mode 100644 t/lib/FilterOnlyTest.pm delete mode 100644 t/lib/FilterTest.pm 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 subroutine -You can't directly use Exporter when Filter::Simple. +Filter::Simple generates a special C subroutine for +your module (see L<"How it works">) which would normally replace any +C subroutine you might have explicitly declared. -Filter::Simple generates an C subroutine for your module -(which hides the one inherited from Exporter). +However, Filter::Simple is smart enough to notice your existing +C and Do The Right Thing with it. +That is, if you explcitly define an C subroutine in a package +that's using Filter::Simple, that C subroutine will still +be invoked immediately after any filter you install. -The C code you specify will, however, receive the C's -complete argument list (including the package name in $_[0]), -so you can use that filter block as your C subroutine. +The only thing you have to remember is that the C subroutine +I be declared I the filter is installed. If you use C +to install the filter: -You'll need to call C from your C 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 +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 subroutine appears before +that C 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 always precedes your +C. =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; -- 2.7.4