From 1b629f663be5c842b180f89a744745f7d805916d Mon Sep 17 00:00:00 2001 From: Rafael Garcia-Suarez Date: Mon, 27 Jun 2005 13:46:25 +0000 Subject: [PATCH] Upgrade to Filter::Simple 0.82 p4raw-id: //depot/perl@24990 --- lib/Filter/Simple.pm | 643 ++++++++++++++++++---------------- lib/Filter/Simple/Changes | 26 ++ lib/Filter/Simple/t/data.t | 12 +- lib/Filter/Simple/t/export.t | 12 +- lib/Filter/Simple/t/filter.t | 14 +- lib/Filter/Simple/t/filter_only.t | 15 +- lib/Filter/Simple/t/import.t | 13 +- t/lib/Filter/Simple/ExportTest.pm | 2 +- t/lib/Filter/Simple/FilterOnlyTest.pm | 2 +- t/lib/Filter/Simple/FilterTest.pm | 2 +- t/lib/Filter/Simple/ImportTest.pm | 2 +- 11 files changed, 413 insertions(+), 330 deletions(-) diff --git a/lib/Filter/Simple.pm b/lib/Filter/Simple.pm index 1ab5b98..f5404e9 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.78'; +$VERSION = '0.82'; use Filter::Util::Call; use Carp; @@ -13,136 +13,148 @@ use Carp; sub import { - if (@_>1) { shift; goto &FILTER } - else { *{caller()."::$_"} = \&$_ foreach @EXPORT } -} - -sub FILTER (&;$) { - my $caller = caller; - my ($filter, $terminator) = @_; - local $SIG{__WARN__} = sub{}; - *{"${caller}::import"} = gen_filter_import($caller,$filter,$terminator); - *{"${caller}::unimport"} = gen_filter_unimport($caller); + if (@_>1) { shift; goto &FILTER } + else { *{caller()."::$_"} = \&$_ foreach @EXPORT } } sub fail { - croak "FILTER_ONLY: ", @_; + croak "FILTER_ONLY: ", @_; } my $exql = sub { - my @bits = extract_quotelike $_[0], qr//; - return unless $bits[0]; - return \@bits; + my @bits = extract_quotelike $_[0], qr//; + return unless $bits[0]; + return \@bits; }; -my $ws = qr/\s+/; +my $ncws = qr/\s+/; +my $comment = qr/(? [ $ws, $id, { MATCH => \&extract_quotelike } ], - regex => [ $ws, $pod_or_DATA, $id, $exql ], - string => [ $ws, $pod_or_DATA, $id, $exql ], - code => [ $ws, { DONT_MATCH => $pod_or_DATA }, - $id, { DONT_MATCH => \&extract_quotelike } ], - executable => [ $ws, { DONT_MATCH => $pod_or_DATA } ], - all => [ { MATCH => qr/(?s:.*)/ } ], + quotelike => [ $ws, \&extract_variable, $id, { MATCH => \&extract_quotelike } ], + regex => [ $ws, $pod_or_DATA, $id, $exql ], + string => [ $ws, $pod_or_DATA, $id, $exql ], + code => [ $ws, { DONT_MATCH => $pod_or_DATA }, + \&extract_variable, + $id, { DONT_MATCH => \&extract_quotelike } ], + code_no_comments + => [ { DONT_MATCH => $comment }, + $ncws, { DONT_MATCH => $pod_or_DATA }, + \&extract_variable, + $id, { DONT_MATCH => \&extract_quotelike } ], + executable => [ $ws, { DONT_MATCH => $pod_or_DATA } ], + executable_no_comments + => [ { DONT_MATCH => $comment }, + $ncws, { DONT_MATCH => $pod_or_DATA } ], + all => [ { MATCH => qr/(?s:.*)/ } ], ); my %selector_for = ( - all => sub { my ($t)=@_; sub{ $_=$$_; $t->(@_); $_} }, - executable=> sub { my ($t)=@_; sub{ref() ? $_=$$_ : $t->(@_); $_} }, - quotelike => sub { my ($t)=@_; sub{ref() && do{$_=$$_; $t->(@_)}; $_} }, - regex => sub { my ($t)=@_; - sub{ref() or return $_; - my ($ql,undef,$pre,$op,$ld,$pat) = @$_; - return $_->[0] unless $op =~ /^(qr|m|s)/ - || !$op && ($ld eq '/' || $ld eq '?'); - $_ = $pat; - $t->(@_); - $ql =~ s/^(\s*\Q$op\E\s*\Q$ld\E)\Q$pat\E/$1$_/; - return "$pre$ql"; - }; - }, - string => sub { my ($t)=@_; - sub{ref() or return $_; - local *args = \@_; - my ($pre,$op,$ld1,$str1,$rd1,$ld2,$str2,$rd2,$flg) = @{$_}[2..10]; - return $_->[0] if $op =~ /^(qr|m)/ - || !$op && ($ld1 eq '/' || $ld1 eq '?'); - if (!$op || $op eq 'tr' || $op eq 'y') { - local *_ = \$str1; - $t->(@args); - } - if ($op =~ /^(tr|y|s)/) { - local *_ = \$str2; - $t->(@args); - } - my $result = "$pre$op$ld1$str1$rd1"; - $result .= $ld2 if $ld1 =~ m/[[({<]/; #])}> - $result .= "$str2$rd2$flg"; - return $result; - }; - }, + all => sub { my ($t)=@_; sub{ $_=$$_; $t->(@_); $_} }, + executable=> sub { my ($t)=@_; sub{ref() ? $_=$$_ : $t->(@_); $_} }, + quotelike => sub { my ($t)=@_; sub{ref() && do{$_=$$_; $t->(@_)}; $_} }, + regex => sub { my ($t)=@_; + sub{ref() or return $_; + my ($ql,undef,$pre,$op,$ld,$pat) = @$_; + return $_->[0] unless $op =~ /^(qr|m|s)/ + || !$op && ($ld eq '/' || $ld eq '?'); + $_ = $pat; + $t->(@_); + $ql =~ s/^(\s*\Q$op\E\s*\Q$ld\E)\Q$pat\E/$1$_/; + return "$pre$ql"; + }; + }, + string => sub { my ($t)=@_; + sub{ref() or return $_; + local *args = \@_; + my ($pre,$op,$ld1,$str1,$rd1,$ld2,$str2,$rd2,$flg) = @{$_}[2..10]; + return $_->[0] if $op =~ /^(qr|m)/ + || !$op && ($ld1 eq '/' || $ld1 eq '?'); + if (!$op || $op eq 'tr' || $op eq 'y') { + local *_ = \$str1; + $t->(@args); + } + if ($op =~ /^(tr|y|s)/) { + local *_ = \$str2; + $t->(@args); + } + my $result = "$pre$op$ld1$str1$rd1"; + $result .= $ld2 if $ld1 =~ m/[[({<]/; #])}> + $result .= "$str2$rd2$flg"; + return $result; + }; + }, ); 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] .= $_ } - else { push @pieces, $_; $instr=1 } - } - if ($type eq 'code') { - my $count = 0; - local $placeholder = qr/\Q$;\E(?:\C{4})\Q$;\E/; - my $extractor = qr/\Q$;\E(\C{4})\Q$;\E/; - $_ = join "", - map { ref $_ ? $;.pack('N',$count++).$; : $_ } - @pieces; - @pieces = grep { ref $_ } @pieces; - $transform->(@_); - s/$extractor/${$pieces[unpack('N',$1)]}/g; - } - else { - my $selector = $selector_for{$type}->($transform); - $_ = join "", map $selector->(@_), @pieces; - } - } + my ($type, $transform) = @_; + return sub { + my $instr; + local @components; + for (extract_multiple($_,$extractor_for{$type})) { + if (ref()) { push @components, $_; $instr=0 } + elsif ($instr) { $components[-1] .= $_ } + else { push @components, $_; $instr=1 } + } + if ($type =~ /^code/) { + my $count = 0; + local $placeholder = qr/\Q$;\E(\C{4})\Q$;\E/; + my $extractor = qr/\Q$;\E(\C{4})\Q$;\E/; + $_ = join "", + map { ref $_ ? $;.pack('N',$count++).$; : $_ } + @components; + @components = grep { ref $_ } @components; + $transform->(@_); + s/$extractor/${$components[unpack('N',$1)]}/g; + } + else { + my $selector = $selector_for{$type}->($transform); + $_ = join "", map $selector->(@_), @components; + } + } }; +sub FILTER (&;$) { + my $caller = caller; + my ($filter, $terminator) = @_; + no warnings 'redefine'; + *{"${caller}::import"} = gen_filter_import($caller,$filter,$terminator); + *{"${caller}::unimport"} = gen_filter_unimport($caller); +} + sub FILTER_ONLY { - my $caller = caller; - while (@_ > 1) { - my ($what, $how) = splice(@_, 0, 2); - fail "Unknown selector: $what" - unless exists $extractor_for{$what}; - fail "Filter for $what is not a subroutine reference" - unless ref $how eq 'CODE'; - push @transforms, gen_std_filter_for($what,$how); - } - my $terminator = shift; - - my $multitransform = sub { - foreach my $transform ( @transforms ) { - $transform->(@_); - } - }; - no warnings 'redefine'; - *{"${caller}::import"} = - gen_filter_import($caller,$multitransform,$terminator); - *{"${caller}::unimport"} = gen_filter_unimport($caller); + my $caller = caller; + while (@_ > 1) { + my ($what, $how) = splice(@_, 0, 2); + fail "Unknown selector: $what" + unless exists $extractor_for{$what}; + fail "Filter for $what is not a subroutine reference" + unless ref $how eq 'CODE'; + push @transforms, gen_std_filter_for($what,$how); + } + my $terminator = shift; + + my $multitransform = sub { + foreach my $transform ( @transforms ) { + $transform->(@_); + } + }; + no warnings 'redefine'; + *{"${caller}::import"} = + gen_filter_import($caller,$multitransform,$terminator); + *{"${caller}::unimport"} = gen_filter_unimport($caller); } my $ows = qr/(?:[ \t]+|#[^\n]*)*/; @@ -152,66 +164,66 @@ sub gen_filter_import { 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)__)\r?$/; - if (!defined $terminator) { - $terminator{terminator} = $def_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; - } - filter_add( - sub { - my ($status, $lastline); - my $count = 0; - my $data = ""; - while ($status = filter_read()) { - return $status if $status < 0; - if ($terminator{terminator} && - m/$terminator{terminator}/) { - $lastline = $_; - last; - } - $data .= $_; - $count++; - $_ = ""; - } - $_ = $data; - $filter->($imported_class, @args) unless $status < 0; - if (defined $lastline) { - 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,@_); - } + my ($imported_class, @args) = @_; + my $def_terminator = + qr/^(?:\s*no\s+$imported_class\s*;$ows|__(?:END|DATA)__)\r?$/; + if (!defined $terminator) { + $terminator{terminator} = $def_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; + } + filter_add( + sub { + my ($status, $lastline); + my $count = 0; + my $data = ""; + while ($status = filter_read()) { + return $status if $status < 0; + if ($terminator{terminator} && + m/$terminator{terminator}/) { + $lastline = $_; + last; + } + $data .= $_; + $count++; + $_ = ""; + } + return $count if not $count; + $_ = $data; + $filter->($imported_class, @args) unless $status < 0; + if (defined $lastline) { + 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 gen_filter_unimport { - my ($class) = @_; - my $prev_unimport = *{$class."::unimport"}{CODE}; - return sub { - filter_del(); - goto &$prev_unimport if $prev_unimport; - } + my ($class) = @_; + return sub { + filter_del(); + goto &$prev_unimport if $prev_unimport; + } } 1; @@ -227,25 +239,25 @@ Filter::Simple - Simplified source filtering # in MyFilter.pm: - package MyFilter; + package MyFilter; - use Filter::Simple; - - FILTER { ... }; + use Filter::Simple; + + FILTER { ... }; - # or just: - # - # use Filter::Simple sub { ... }; + # or just: + # + # use Filter::Simple sub { ... }; # in user's code: - use MyFilter; + use MyFilter; - # this code is filtered + # this code is filtered - no MyFilter; + no MyFilter; - # this code is not + # this code is not =head1 DESCRIPTION @@ -316,35 +328,35 @@ BANG.pm. It simply converts every occurrence of the sequence C to the sequence C in any piece of code following a C statement (until the next C statement, if any): - package BANG; + package BANG; - use Filter::Util::Call ; - - sub import { - filter_add( sub { - my $caller = caller; - my ($status, $no_seen, $data); - while ($status = filter_read()) { - if (/^\s*no\s+$caller\s*;\s*?$/) { - $no_seen=1; - last; - } - $data .= $_; - $_ = ""; - } - $_ = $data; - s/BANG\s+BANG/die 'BANG' if \$BANG/g - unless $status < 0; - $_ .= "no $class;\n" if $no_seen; - return 1; - }) + use Filter::Util::Call ; + + sub import { + filter_add( sub { + my $caller = caller; + my ($status, $no_seen, $data); + while ($status = filter_read()) { + if (/^\s*no\s+$caller\s*;\s*?$/) { + $no_seen=1; + last; + } + $data .= $_; + $_ = ""; } + $_ = $data; + s/BANG\s+BANG/die 'BANG' if \$BANG/g + unless $status < 0; + $_ .= "no $class;\n" if $no_seen; + return 1; + }) + } - sub unimport { - filter_del(); - } + sub unimport { + filter_del(); + } - 1 ; + 1 ; This level of sophistication puts filtering out of the reach of many programmers. @@ -380,14 +392,14 @@ the desired manner. In other words, the previous example, would become: - package BANG; - use Filter::Simple; - - FILTER { - s/BANG\s+BANG/die 'BANG' if \$BANG/g; - }; + package BANG; + use Filter::Simple; + + FILTER { + s/BANG\s+BANG/die 'BANG' if \$BANG/g; + }; - 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 flag. @@ -397,15 +409,15 @@ uses C<^> or C<$> to detect line boundaries will need the C flag. By default, the installed filter only filters up to a line consisting of one of the three standard source "terminators": - no ModuleName; # optional comment + no ModuleName; # optional comment or: - __END__ + __END__ or: - __DATA__ + __DATA__ but this can be altered by passing a second argument to C or C (just remember: there's I comma after the initial block when @@ -420,41 +432,41 @@ C<'terminator'>. For example, to cause the previous filter to filter only up to a line of the form: - GNAB esu; + 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*?$/; + package BANG; + use Filter::Simple; + + FILTER { + s/BANG\s+BANG/die 'BANG' if \$BANG/g; + } + qr/^\s*GNAB\s+esu\s*;\s*?$/; or: - FILTER { - s/BANG\s+BANG/die 'BANG' if \$BANG/g; - } - { terminator => qr/^\s*GNAB\s+esu\s*;\s*?$/ }; + FILTER { + s/BANG\s+BANG/die 'BANG' if \$BANG/g; + } + { terminator => 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 + package BANG; + use Filter::Simple; + + FILTER { + s/BANG\s+BANG/die 'BANG' if \$BANG/g; + } + ""; # or: 0 or: - FILTER { - s/BANG\s+BANG/die 'BANG' if \$BANG/g; - } - { terminator => "" }; + FILTER { + s/BANG\s+BANG/die 'BANG' if \$BANG/g; + } + { terminator => "" }; B be contained on a single source line.> @@ -464,11 +476,11 @@ the actual terminator itself I be contained on a single source line.> Separating the loading of Filter::Simple: - use Filter::Simple; + use Filter::Simple; from the setting up of the filtering: - FILTER { ... }; + FILTER { ... }; is useful because it allows other code (typically parser support code or caching variables) to be defined before the filter is invoked. @@ -478,18 +490,18 @@ 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; - }; + 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; - }; - } + 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. @@ -498,20 +510,20 @@ except that the C subroutine is not exported by Filter::Simple. One of the problems with a filter like: - use Filter::Simple; + use Filter::Simple; - FILTER { s/BANG\s+BANG/die 'BANG' if \$BANG/g }; + FILTER { s/BANG\s+BANG/die 'BANG' if \$BANG/g }; is that it indiscriminately applies the specified transformation to the entire text of your source program. So something like: - warn 'BANG BANG, YOU'RE DEAD'; - BANG BANG; + warn 'BANG BANG, YOU'RE DEAD'; + BANG BANG; will become: - warn 'die 'BANG' if $BANG, YOU'RE DEAD'; - die 'BANG' if $BANG; + warn 'die 'BANG' if $BANG, YOU'RE DEAD'; + die 'BANG' if $BANG; It is very common when filtering source to only want to apply the filter to the non-character-string parts of the code, or alternatively to I @@ -524,11 +536,11 @@ C takes a sequence of specifiers that install separate (and possibly multiple) filters that act on only parts of the source code. For example: - use Filter::Simple; + use Filter::Simple; - FILTER_ONLY - code => sub { s/BANG\s+BANG/die 'BANG' if \$BANG/g }, - quotelike => sub { s/BANG\s+BANG/CHITTY CHITTY/g }; + FILTER_ONLY + code => sub { s/BANG\s+BANG/die 'BANG' if \$BANG/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 @@ -543,10 +555,19 @@ The full list of alternatives is: Filters only those sections of the source code that are not quotelikes, POD, or C<__DATA__>. +=item C<"code_no_comments"> + +Filters only those sections of the source code that are not quotelikes, POD, +comments, or C<__DATA__>. + =item C<"executable"> Filters only those sections of the source code that are not POD or C<__DATA__>. +=item C<"executable_no_comments"> + +Filters only those sections of the source code that are not POD, comments, or C<__DATA__>. + =item C<"quotelike"> Filters only Perl quotelikes (as interpreted by @@ -578,12 +599,12 @@ a single C. For example, here's a simple macro-preprocessor that is only applied within regexes, with a final debugging pass that prints the resulting source code: - use Regexp::Common; - FILTER_ONLY - regex => sub { s/!\[/[^/g }, - regex => sub { s/%d/$RE{num}{int}/g }, - regex => sub { s/%f/$RE{num}{real}/g }, - all => sub { print if $::DEBUG }; + use Regexp::Common; + FILTER_ONLY + regex => sub { s/!\[/[^/g }, + regex => sub { s/%d/$RE{num}{int}/g }, + regex => sub { s/%f/$RE{num}{real}/g }, + all => sub { print if $::DEBUG }; @@ -591,15 +612,15 @@ with a final debugging pass that prints the resulting source code: Most source code ceases to be grammatically correct when it is broken up into the pieces between string literals and regexes. So the C<'code'> -component filter behaves slightly differently from the other partial filters -described in the previous section. +and C<'code_no_comments'> component filter behave slightly differently +from the other partial filters described in the previous section. Rather than calling the specified processor on each individual piece of -code (i.e. on the bits between quotelikes), the C<'code'> partial filter -operates on the entire source code, but with the quotelike bits -"blanked out". +code (i.e. on the bits between quotelikes), the C<'code...'> partial +filters operate on the entire source code, but with the quotelike bits +(and, in the case of C<'code_no_comments'>, the comments) "blanked out". -That is, a C<'code'> filter I each quoted string, quotelike, +That is, a C<'code...'> filter I each quoted string, quotelike, regex, POD, and __DATA__ section with a placeholder. The delimiters of this placeholder are the contents of the C<$;> variable at the time the filter is applied (normally C<"\034">). The remaining @@ -607,43 +628,57 @@ four bytes are a unique identifier for the component being replaced. This approach makes it comparatively easy to write code preprocessors without worrying about the form or contents of strings, regexes, etc. -For convenience, during a C<'code'> filtering operation, Filter::Simple -provides a package variable (C<$Filter::Simple::placeholder>) that contains -a pre-compiled regex that matches any placeholder. Placeholders can be + +For convenience, during a C<'code...'> filtering operation, Filter::Simple +provides a package variable (C<$Filter::Simple::placeholder>) that +contains a pre-compiled regex that matches any placeholder...and +captures the identifier within the placeholder. Placeholders can be moved and re-ordered within the source code as needed. -Once the filtering has been applied, the original strings, regexes, -POD, etc. are re-inserted into the code, by replacing each -placeholder with the corresponding original component. +In addition, a second package variable (C<@Filter::Simple::components>) +contains a list of the various pieces of C<$_>, as they were originally split +up to allow placeholders to be inserted. + +Once the filtering has been applied, the original strings, regexes, POD, +etc. are re-inserted into the code, by replacing each placeholder with +the corresponding original component (from C<@components>). Note that +this means that the C<@components> variable must be treated with extreme +care within the filter. The C<@components> array stores the "back- +translations" of each placeholder inserted into C<$_>, as well as the +interstitial source code between placeholders. If the placeholder +backtranslations are altered in C<@components>, they will be similarly +changed when the placeholders are removed from C<$_> after the filter +is complete. For example, the following filter detects concatentated pairs of strings/quotelikes and reverses the order in which they are concatenated: - package DemoRevCat; - use Filter::Simple; + package DemoRevCat; + use Filter::Simple; - FILTER_ONLY code => sub { my $ph = $Filter::Simple::placeholder; - s{ ($ph) \s* [.] \s* ($ph) }{ $2.$1 }gx - }; + FILTER_ONLY code => sub { + my $ph = $Filter::Simple::placeholder; + s{ ($ph) \s* [.] \s* ($ph) }{ $2.$1 }gx + }; Thus, the following code: - use DemoRevCat; + use DemoRevCat; - my $str = "abc" . q(def); + my $str = "abc" . q(def); - print "$str\n"; + print "$str\n"; would become: - my $str = q(def)."abc"; + my $str = q(def)."abc"; - print "$str\n"; + print "$str\n"; and hence print: - defabc + defabc =head2 Using Filter::Simple with an explicit C subroutine @@ -662,19 +697,19 @@ 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: - package Filter::TurnItUpTo11; + package Filter::TurnItUpTo11; - use Filter::Simple; + use Filter::Simple; - FILTER { s/(\w+)/\U$1/ }; - + 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: - package Filter::TurnItUpTo11; + package Filter::TurnItUpTo11; - use Filter::Simple sub{ s/(\w+)/\U$1/ }; + use Filter::Simple sub{ s/(\w+)/\U$1/ }; then you must make sure that your C subroutine appears before that C statement. @@ -685,14 +720,14 @@ that C statement. Likewise, Filter::Simple is also smart enough to Do The Right Thing if you use Exporter: - package Switch; - use base Exporter; - use Filter::Simple; + package Switch; + use base Exporter; + use Filter::Simple; - @EXPORT = qw(switch case); - @EXPORT_OK = qw(given when); + @EXPORT = qw(switch case); + @EXPORT_OK = qw(given when); - FILTER { $_ = magic_Perl_filter($_) } + 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. @@ -716,18 +751,18 @@ In addition, the generated C subroutine passes its own argument list to the filtering subroutine, so the BANG.pm filter could easily be made parametric: - package BANG; + package BANG; - use Filter::Simple; - - FILTER { - my ($die_msg, $var_name) = @_; - s/BANG\s+BANG/die '$die_msg' if \${$var_name}/g; - }; + 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: + # 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 @@ -745,4 +780,4 @@ Damian Conway (damian@conway.org) Copyright (c) 2000-2001, Damian Conway. All Rights Reserved. This module is free software. It may be used, redistributed - and/or modified under the same terms as Perl itself. + and/or modified under the same terms as Perl itself. diff --git a/lib/Filter/Simple/Changes b/lib/Filter/Simple/Changes index 732e7ed..739aaf0 100644 --- a/lib/Filter/Simple/Changes +++ b/lib/Filter/Simple/Changes @@ -79,3 +79,29 @@ Revision history for Perl extension Filter::Simple - added prereq for Text::Balanced in Makefile.PL - Added note about use of /m flag when using ^ or $ in filter regexes + +0.79 Sat Sep 20 21:56:24 2003 + + - Fixed tests to use t/lib modules so F::S is testable without + a previous version of F::S installed. (schwern) + +0.80 Sun May 29 23:19:54 2005 + + - Added Sarathy's patch for \r\n newlinery (thanks Jarkko) + + - Added recognition of comments as whitespace (thanks Jeff) + + - Added @components variable (thanks Dean) + + - Fixed handling of vars in FILTER_ONLY code=>... (thanks Lasse) + + - Fixed spurious extra filter at end of file (thanks Dean) + + - Added INSTALLDIRS=>core to Makefile.PL + + +0.82 Mon Jun 27 02:31:06 GMT 2005 + + - Fixed INSTALLDIRS=>perl in Makefile.PL (thanks all) + + - Fixed other problems caused by de-schwernification diff --git a/lib/Filter/Simple/t/data.t b/lib/Filter/Simple/t/data.t index 8d58046..b8db6d8 100644 --- a/lib/Filter/Simple/t/data.t +++ b/lib/Filter/Simple/t/data.t @@ -1,11 +1,15 @@ BEGIN { - if ($ENV{PERL_CORE}) { - chdir('t') if -d 't'; - @INC = qw(lib/Filter/Simple ../lib); + if( $ENV{PERL_CORE} ) { + chdir 't'; + @INC = '../lib'; + } + else { + unshift @INC, 't/lib/'; } } +chdir 't'; -use FilterOnlyTest qr/ok/ => "not ok", "bad" => "ok"; +use Filter::Simple::FilterOnlyTest qr/ok/ => "not ok", "bad" => "ok"; print "1..6\n"; print "bad 1\n"; diff --git a/lib/Filter/Simple/t/export.t b/lib/Filter/Simple/t/export.t index 40c62da..d72fcfa 100644 --- a/lib/Filter/Simple/t/export.t +++ b/lib/Filter/Simple/t/export.t @@ -1,12 +1,16 @@ BEGIN { - if ($ENV{PERL_CORE}) { - chdir('t') if -d 't'; - @INC = qw(lib/Filter/Simple ../lib); + if( $ENV{PERL_CORE} ) { + chdir 't'; + @INC = '../lib'; + } + else { + unshift @INC, 't/lib/'; } } +chdir 't'; BEGIN { print "1..1\n" } -use ExportTest 'ok'; +use Filter::Simple::ExportTest 'ok'; notok 1; diff --git a/lib/Filter/Simple/t/filter.t b/lib/Filter/Simple/t/filter.t index f1d71d9..b0de707 100644 --- a/lib/Filter/Simple/t/filter.t +++ b/lib/Filter/Simple/t/filter.t @@ -1,11 +1,15 @@ BEGIN { - if ($ENV{PERL_CORE}) { - chdir('t') if -d 't'; - @INC = qw(lib/Filter/Simple ../lib); + if( $ENV{PERL_CORE} ) { + chdir 't'; + @INC = '../lib'; + } + else { + unshift @INC, 't/lib/'; } } +chdir 't'; -use FilterTest qr/not ok/ => "ok", fail => "ok"; +use Filter::Simple::FilterTest qr/not ok/ => "ok", fail => "ok"; print "1..6\n"; @@ -20,7 +24,7 @@ fail(3); print "not " unless "whatnot okapi" eq "whatokapi"; print "ok 5\n"; -no FilterTest; +no Filter::Simple::FilterTest; print "not " unless "not ok" =~ /^not /; print "ok 6\n"; diff --git a/lib/Filter/Simple/t/filter_only.t b/lib/Filter/Simple/t/filter_only.t index e537609..2fc425b 100644 --- a/lib/Filter/Simple/t/filter_only.t +++ b/lib/Filter/Simple/t/filter_only.t @@ -1,11 +1,16 @@ BEGIN { - if ($ENV{PERL_CORE}) { - chdir('t') if -d 't'; - @INC = qw(lib/Filter/Simple ../lib); + if( $ENV{PERL_CORE} ) { + chdir 't'; + @INC = '../lib'; + } + else { + unshift @INC, 't/lib/'; } } +chdir 't'; -use FilterOnlyTest qr/not ok/ => "ok", "bad" => "ok", fail => "die"; +use Filter::Simple::FilterOnlyTest qr/not ok/ => "ok", + "bad" => "ok", fail => "die"; print "1..9\n"; sub fail { print "ok ", $_[0], "\n" } @@ -22,7 +27,7 @@ print "ok 5\n"; ok 7 unless not ok 6; -no FilterOnlyTest; # THE FUN STOPS HERE +no Filter::Simple::FilterOnlyTest; # THE FUN STOPS HERE print "not " unless "not ok" =~ /^not /; print "ok 8\n"; diff --git a/lib/Filter/Simple/t/import.t b/lib/Filter/Simple/t/import.t index d087692..2bc7760 100644 --- a/lib/Filter/Simple/t/import.t +++ b/lib/Filter/Simple/t/import.t @@ -1,12 +1,17 @@ BEGIN { - if ($ENV{PERL_CORE}) { - chdir('t') if -d 't'; - @INC = qw(lib/Filter/Simple ../lib); + if( $ENV{PERL_CORE} ) { + chdir 't'; + @INC = '../lib'; + } + else { + unshift @INC, 't/lib'; } } +chdir 't'; BEGIN { print "1..4\n" } -use ImportTest (1..3); +use lib 'lib'; +use Filter::Simple::ImportTest (1..3); say "not ok 4\n"; diff --git a/t/lib/Filter/Simple/ExportTest.pm b/t/lib/Filter/Simple/ExportTest.pm index d6da629..10d764e 100755 --- a/t/lib/Filter/Simple/ExportTest.pm +++ b/t/lib/Filter/Simple/ExportTest.pm @@ -1,4 +1,4 @@ -package ExportTest; +package Filter::Simple::ExportTest; use Filter::Simple; use base Exporter; diff --git a/t/lib/Filter/Simple/FilterOnlyTest.pm b/t/lib/Filter/Simple/FilterOnlyTest.pm index 856e79d..c10e8ea 100644 --- a/t/lib/Filter/Simple/FilterOnlyTest.pm +++ b/t/lib/Filter/Simple/FilterOnlyTest.pm @@ -1,4 +1,4 @@ -package FilterOnlyTest; +package Filter::Simple::FilterOnlyTest; use Filter::Simple; diff --git a/t/lib/Filter/Simple/FilterTest.pm b/t/lib/Filter/Simple/FilterTest.pm index c49e280..fab3e27 100644 --- a/t/lib/Filter/Simple/FilterTest.pm +++ b/t/lib/Filter/Simple/FilterTest.pm @@ -1,4 +1,4 @@ -package FilterTest; +package Filter::Simple::FilterTest; use Filter::Simple; diff --git a/t/lib/Filter/Simple/ImportTest.pm b/t/lib/Filter/Simple/ImportTest.pm index 6646a36..4276a9f 100755 --- a/t/lib/Filter/Simple/ImportTest.pm +++ b/t/lib/Filter/Simple/ImportTest.pm @@ -1,4 +1,4 @@ -package ImportTest; +package Filter::Simple::ImportTest; use base 'Exporter'; @EXPORT = qw(say); -- 2.7.4