diff --git a/Changes b/Changes new file mode 100644 index 0000000..d7b8e3c --- /dev/null +++ b/Changes @@ -0,0 +1,158 @@ +Revision history for Perl extension Filter::Simple + +0.01 Tue Sep 19 20:18:44 2000 + - original version; created by h2xs 1.18 + +0.01 Tue Sep 26 09:30:14 2000 + + - Changed module name to Filter::Simple + + +0.60 Wed May 2 07:38:18 2001 + + - Fixed POD nit (thanks Dean) + + - Added optional second argument to import to allow + terminator to be changed (thanks Brad) + + - Fixed bug when empty filtered text was appended to (thanks Brad) + + - Added FILTER as the normal mechanism for specifying filters + + +0.61 Mon Sep 3 08:25:21 2001 + + - Added a real test suite (thanks Jarkko) + + - Changed licence to facilitate inclusion in + core distribution + + - Added documentation for using F::S and Exporter together + + +0.70 Wed Nov 14 23:36:18 2001 + + - 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 + + +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 + + +0.78 Fri May 17 09:38:56 2002 + + - Re-corified test modules in line with Jarkko's new scheme + + - Various POD nits unknitted (thanks Autrijus) + + - Added the missing DotsForArrows.pm demo file (thanks Autrijus) + + - Added support for Perl 5.005 + + - 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 + + +0.83 Sat Oct 18 18:51:51 CET 2008 + + - Updated contact details: Maintained by the Perl5-Porters. + - Some tiny distribution fixes. + + +0.84 Tue Jan 6 12:58:12 CET 2009 + + - Explicit dependency on Text::Balanced 1.97 because that fixed + a problem with HERE-docs. (RT #27326) + +0.85 Sun Sep 5 16:03:00 CET 2010 + + - Port changes from core: Remove unnecessary PERL_CORE check + from tests. + +0.86 + - Never released to CPAN (only part of the perl core 5.14.0) + +0.87 Fri May 20 20:00:00 CET 2011 + + - Port changes from core: Whitespace fix that is significant for + POD correctness. + +0.88 Mon Dec 19 18:26:00 CET 2011 + + - [perl #92436] Make Filter::Simple match variables better + (Father Chrysostomos) + + - [perl #92436] Filter::Simple can’t find end of POD + (Father Chrysostomos) + +0.91 Fri Mar 7 08:30:00 CET 2014 + + - Various small documentation fixes. + + - Swap out base.pm use for parent.pm. + +0.94 Thu Aug 3 18:00:00 CET 2017 + + - Remove use of deprecated \C regex feature. + + - Filter::Simple was erroneously signalling eof if it encountered a + ‘no MyFilter’ right after ‘use’: + use MyFilter; + no MyFilter; + In this case it should simply not filter anything. + + diff --git a/MANIFEST b/MANIFEST new file mode 100644 index 0000000..5f348a4 --- /dev/null +++ b/MANIFEST @@ -0,0 +1,40 @@ +Changes +demo/demo.pl +demo/Demo1.pm +demo/demo2.pl +demo/Demo2a.pm +demo/Demo2b.pm +demo/demo_data.pl +demo/Demo_Data.pm +demo/demo_dots.pl +demo/demo_exporter.pl +demo/Demo_Exporter.pm +demo/demo_importer.pl +demo/Demo_Importer.pm +demo/demo_regex_macro.pl +demo/Demo_REM.pm +demo/demo_revcat.pl +demo/demo_swear.pl +demo/demo_unpod.pl +demo/DemoData.pm +demo/DemoRevCat.pm +demo/DemoSwear.pm +demo/DemoUnPod.pm +demo/DotsForArrows.pm +lib/Filter/Simple.pm +Makefile.PL +MANIFEST This list of files +README +t/code_no_comments.t +t/data.t +t/export.t +t/filter.t +t/filter_only.t +t/import.t +t/lib/Filter/Simple/CodeNoComments.pm +t/lib/Filter/Simple/ExportTest.pm +t/lib/Filter/Simple/FilterOnlyTest.pm +t/lib/Filter/Simple/FilterTest.pm +t/lib/Filter/Simple/ImportTest.pm +META.yml Module YAML meta-data (added by MakeMaker) +META.json Module JSON meta-data (added by MakeMaker) diff --git a/META.json b/META.json new file mode 100644 index 0000000..9b861b8 --- /dev/null +++ b/META.json @@ -0,0 +1,42 @@ +{ + "abstract" : "Simplified source filtering", + "author" : [ + "Damian Conway" + ], + "dynamic_config" : 1, + "generated_by" : "ExtUtils::MakeMaker version 7.04, CPAN::Meta::Converter version 2.120351", + "license" : [ + "perl_5" + ], + "meta-spec" : { + "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", + "version" : "2" + }, + "name" : "Filter-Simple", + "no_index" : { + "directory" : [ + "t", + "inc" + ] + }, + "prereqs" : { + "build" : { + "requires" : { + "ExtUtils::MakeMaker" : "0" + } + }, + "configure" : { + "requires" : { + "ExtUtils::MakeMaker" : "0" + } + }, + "runtime" : { + "requires" : { + "Filter::Util::Call" : "0", + "Text::Balanced" : "1.97" + } + } + }, + "release_status" : "stable", + "version" : "0.94" +} diff --git a/META.yml b/META.yml new file mode 100644 index 0000000..a5eaad8 --- /dev/null +++ b/META.yml @@ -0,0 +1,23 @@ +--- +abstract: 'Simplified source filtering' +author: + - 'Damian Conway' +build_requires: + ExtUtils::MakeMaker: 0 +configure_requires: + ExtUtils::MakeMaker: 0 +dynamic_config: 1 +generated_by: 'ExtUtils::MakeMaker version 7.04, CPAN::Meta::Converter version 2.120351' +license: perl +meta-spec: + url: http://module-build.sourceforge.net/META-spec-v1.4.html + version: 1.4 +name: Filter-Simple +no_index: + directory: + - t + - inc +requires: + Filter::Util::Call: 0 + Text::Balanced: 1.97 +version: 0.94 diff --git a/Makefile.PL b/Makefile.PL new file mode 100644 index 0000000..f011321 --- /dev/null +++ b/Makefile.PL @@ -0,0 +1,16 @@ +use strict; +use ExtUtils::MakeMaker; +WriteMakefile( + NAME => 'Filter::Simple', + VERSION_FROM => 'lib/Filter/Simple.pm', + INSTALLDIRS => 'perl', + 'LICENSE' => 'perl', + 'INSTALLDIRS' => 'perl', + ($] >= 5.005 ? + (ABSTRACT_FROM => 'lib/Filter/Simple.pm', + 'AUTHOR' => 'Damian Conway') : ()), + PREREQ_PM => { + 'Text::Balanced' => '1.97', + 'Filter::Util::Call' => 0 + }, +); diff --git a/README b/README new file mode 100644 index 0000000..cd166ae --- /dev/null +++ b/README @@ -0,0 +1,500 @@ +NAME + Filter::Simple - Simplified source filtering + +SYNOPSIS + # in MyFilter.pm: + + package MyFilter; + + use Filter::Simple; + + FILTER { ... }; + + # or just: + # + # use Filter::Simple sub { ... }; + + # in user's code: + + use MyFilter; + + # this code is filtered + + no MyFilter; + + # this code is not + +DESCRIPTION + The Problem + Source filtering is an immensely powerful feature of recent versions of + Perl. It allows one to extend the language itself (e.g. the Switch + module), to simplify the language (e.g. Language::Pythonesque), or to + completely recast the language (e.g. Lingua::Romana::Perligata). + Effectively, it allows one to use the full power of Perl as its own, + recursively applied, macro language. + + The excellent Filter::Util::Call module (by Paul Marquess) provides a + usable Perl interface to source filtering, but it is often too powerful + and not nearly as simple as it could be. + + To use the module it is necessary to do the following: + + 1. Download, build, and install the Filter::Util::Call module. (If you + have Perl 5.7.1 or later, this is already done for you.) + + 2. Set up a module that does a "use Filter::Util::Call". + + 3. Within that module, create an "import" subroutine. + + 4. Within the "import" subroutine do a call to "filter_add", passing it + either a subroutine reference. + + 5. Within the subroutine reference, call "filter_read" or + "filter_read_exact" to "prime" $_ with source code data from the + source file that will "use" your module. Check the status value + returned to see if any source code was actually read in. + + 6. Process the contents of $_ to change the source code in the desired + manner. + + 7. Return the status value. + + 8. If the act of unimporting your module (via a "no") should cause + source code filtering to cease, create an "unimport" subroutine, and + have it call "filter_del". Make sure that the call to "filter_read" + or "filter_read_exact" in step 5 will not accidentally read past the + "no". Effectively this limits source code filters to line-by-line + operation, unless the "import" subroutine does some fancy + pre-pre-parsing of the source code it's filtering. + + For example, here is a minimal source code filter in a module named + BANG.pm. It simply converts every occurrence of the sequence + "BANG\s+BANG" to the sequence "die 'BANG' if $BANG" in any piece of code + following a "use BANG;" statement (until the next "no BANG;" statement, + if any): + + 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; + }) + } + + sub unimport { + filter_del(); + } + + 1 ; + + This level of sophistication puts filtering out of the reach of many + programmers. + + A Solution + The Filter::Simple module provides a simplified interface to + Filter::Util::Call; one that is sufficient for most common cases. + + Instead of the above process, with Filter::Simple the task of setting up + a source code filter is reduced to: + + 1. Download and install the Filter::Simple module. (If you have Perl + 5.7.1 or later, this is already done for you.) + + 2. Set up a module that does a "use Filter::Simple" and then calls + "FILTER { ... }". + + 3. Within the anonymous subroutine or block that is passed to "FILTER", + process the contents of $_ to change the source code in 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; + }; + + 1 ; + + Note that the source code is passed as a single string, so any regex + that uses "^" or "$" to detect line boundaries will need the "/m" flag. + + Disabling or changing behaviour + By default, the installed filter only filters up to a line consisting of + one of the three standard source "terminators": + + no ModuleName; # optional comment + + or: + + __END__ + + or: + + __DATA__ + + but this can be altered by passing a second argument to "use + Filter::Simple" or "FILTER" (just remember: there's *no* comma after the + initial block when you use "FILTER"). + + That second argument may be either a "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), or a reference + to a hash (in which case the terminator is the value associated with the + key 'terminator'. + + 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*?$/; + + or: + + 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 + + or: + + FILTER { + s/BANG\s+BANG/die 'BANG' if \$BANG/g; + } + { terminator => "" }; + + Note that, no matter what you set the terminator pattern to, the actual + terminator itself *must* be contained on a single source line. + + 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 "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 "FILTER" subroutine is not exported by Filter::Simple. + + Filtering only specific components of source code + One of the problems with a filter like: + + use Filter::Simple; + + 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; + + will become: + + 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 + *only* the character strings. + + Filter::Simple supports this type of filtering by automatically + exporting the "FILTER_ONLY" subroutine. + + "FILTER_ONLY" 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; + + FILTER_ONLY + code => sub { s/BANG\s+BANG/die 'BANG' if \$BANG/g }, + quotelike => sub { s/BANG\s+BANG/CHITTY CHITTY/g }; + + The "code" subroutine will only be used to filter parts of the source + code that are not quotelikes, POD, or "__DATA__". The "quotelike" + subroutine only filters Perl quotelikes (including here documents). + + The full list of alternatives is: + + "code" + Filters only those sections of the source code that are not + quotelikes, POD, or "__DATA__". + + "code_no_comments" + Filters only those sections of the source code that are not + quotelikes, POD, comments, or "__DATA__". + + "executable" + Filters only those sections of the source code that are not POD or + "__DATA__". + + "executable_no_comments" + Filters only those sections of the source code that are not POD, + comments, or "__DATA__". + + "quotelike" + Filters only Perl quotelikes (as interpreted by + &Text::Balanced::extract_quotelike). + + "string" + Filters only the string literal parts of a Perl quotelike (i.e. the + contents of a string literal, either half of a "tr///", the second + half of an "s///"). + + "regex" + Filters only the pattern literal parts of a Perl quotelike (i.e. the + contents of a "qr//" or an "m//", the first half of an "s///"). + + "all" + Filters everything. Identical in effect to "FILTER". + + Except for "FILTER_ONLY code => sub {...}", each of the component + filters is called repeatedly, once for each component found in the + source code. + + Note that you can also apply two or more of the same type of filter in a + single "FILTER_ONLY". 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 }; + + Filtering only the code parts of 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 'code' and + '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 'code...' partial + filters operate on the entire source code, but with the quotelike bits + (and, in the case of 'code_no_comments', the comments) "blanked out". + + That is, a 'code...' filter *replaces* each quoted string, quotelike, + regex, POD, and __DATA__ section with a placeholder. The delimiters of + this placeholder are the contents of the $; variable at the time the + filter is applied (normally "\034"). The remaining 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 'code...' filtering operation, Filter::Simple + provides a package variable ($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. + + In addition, a second package variable (@Filter::Simple::components) + contains a list of the various pieces of $_, 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 @components). Note that this + means that the @components variable must be treated with extreme care + within the filter. The @components array stores the "back- translations" + of each placeholder inserted into $_, as well as the interstitial source + code between placeholders. If the placeholder backtranslations are + altered in @components, they will be similarly changed when the + placeholders are removed from $_ after the filter is complete. + + For example, the following filter detects concatenated pairs of + strings/quotelikes and reverses the order in which they are + concatenated: + + package DemoRevCat; + use Filter::Simple; + + FILTER_ONLY code => sub { + my $ph = $Filter::Simple::placeholder; + s{ ($ph) \s* [.] \s* ($ph) }{ $2.$1 }gx + }; + + Thus, the following code: + + use DemoRevCat; + + my $str = "abc" . q(def); + + print "$str\n"; + + would become: + + my $str = q(def)."abc"; + + print "$str\n"; + + and hence print: + + defabc + + Using Filter::Simple with an explicit "import" subroutine + Filter::Simple generates a special "import" subroutine for your module + (see "How it works") which would normally replace any "import" + subroutine you might have explicitly declared. + + However, Filter::Simple is smart enough to notice your existing "import" + and Do The Right Thing with it. That is, if you explicitly define an + "import" subroutine in a package that's using Filter::Simple, that + "import" subroutine will still be invoked immediately after any filter + you install. + + The only thing you have to remember is that the "import" subroutine + *must* be declared *before* the filter is installed. If you use "FILTER" + to install the filter: + + package Filter::TurnItUpTo11; + + 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 "use Filter::Simple" statement: + + package Filter::TurnItUpTo11; + + use Filter::Simple sub{ s/(\w+)/\U$1/ }; + + then you must make sure that your "import" subroutine appears before + that "use" statement. + + 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 "use base Exporter" always precedes your + "use Filter::Simple". + + How it works + The Filter::Simple module exports into the package that calls "FILTER" + (or "use"s it directly) -- such as package "BANG" in the above example + -- two automagically constructed subroutines -- "import" and "unimport" + -- which take care of all the nasty details. + + In addition, the generated "import" subroutine passes its own argument + list to the filtering subroutine, so the BANG.pm filter could easily be + made parametric: + + package BANG; + + 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 + + The specified filtering subroutine is called every time a "use BANG" is + encountered, and passed all the source code following that call, up to + either the next "no BANG;" (or whatever terminator you've set) or the + end of the source file, whichever occurs first. By default, any "no + BANG;" call must appear by itself on a separate line, or it is ignored. + +AUTHOR + Damian Conway + +CONTACT + Filter::Simple is now maintained by the Perl5-Porters. Please submit bug + via the "perlbug" tool that comes with your perl. For usage + instructions, read "perldoc perlbug" or possibly "man perlbug". For + mostly anything else, please contact . + + Maintainer of the CPAN release is Steffen Mueller . + Contact him with technical difficulties with respect to the packaging of + the CPAN module. + + Praise of the module, flowers, and presents still go to the author, + Damian Conway . + +COPYRIGHT AND LICENSE + Copyright (c) 2000-2014, 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. + diff --git a/demo/Demo1.pm b/demo/Demo1.pm new file mode 100644 index 0000000..2c904bf --- /dev/null +++ b/demo/Demo1.pm @@ -0,0 +1,11 @@ +package Demo1; +$VERSION = '0.01'; + +use Filter::Simple sub { + my $class = shift; + while (my ($from, $to) = splice @_, 0, 2) { + s/$from/$to/g; + } +}; + +1; diff --git a/demo/Demo2a.pm b/demo/Demo2a.pm new file mode 100644 index 0000000..0c34a38 --- /dev/null +++ b/demo/Demo2a.pm @@ -0,0 +1,8 @@ +package Demo2a; +$VERSION = '0.01'; + +use Filter::Simple sub { + s/(\$[a-z])/\U$1/g; +}; + +1; diff --git a/demo/Demo2b.pm b/demo/Demo2b.pm new file mode 100644 index 0000000..1492eee --- /dev/null +++ b/demo/Demo2b.pm @@ -0,0 +1,9 @@ +package Demo2b; +$VERSION = '0.01'; + +use Filter::Simple sub { + print "[$_]\n"; + s/(\$[a-z])/\L$1/g; +}; + +1; diff --git a/demo/DemoData.pm b/demo/DemoData.pm new file mode 100644 index 0000000..1a06d84 --- /dev/null +++ b/demo/DemoData.pm @@ -0,0 +1,8 @@ +package DemoData; +$VERSION = '0.01'; + +use Filter::Simple; + +FILTER_ONLY + data => sub { s/(^|[ \t]+)(\S)/\u$2/gm }, + all => sub { print } diff --git a/demo/DemoRevCat.pm b/demo/DemoRevCat.pm new file mode 100644 index 0000000..b260c47 --- /dev/null +++ b/demo/DemoRevCat.pm @@ -0,0 +1,10 @@ +package DemoRevCat; +$VERSION = '0.01'; + +use Filter::Simple; + +FILTER_ONLY + code => sub { + my $ph = $Filter::Simple::placeholder; + s/($ph)\s*[.]\s*($ph)/$2.$1/g + }, diff --git a/demo/DemoSwear.pm b/demo/DemoSwear.pm new file mode 100644 index 0000000..8d12d53 --- /dev/null +++ b/demo/DemoSwear.pm @@ -0,0 +1,12 @@ +package DemoSwear; +$VERSION = '0.01'; +use Regexp::Common; + +use Filter::Simple; + +FILTER_ONLY + all => sub { print "-------\n$_" }, + string => sub { s/$RE{profanity}/darn/g }, + all => sub { print "-------\n$_" }, + code => sub { s/$RE{profanity}|[@%#&*]{3,}([-]\S+)?//g }, + all => sub { print "-------\n$_" }, diff --git a/demo/DemoUnPod.pm b/demo/DemoUnPod.pm new file mode 100644 index 0000000..6c4dd72 --- /dev/null +++ b/demo/DemoUnPod.pm @@ -0,0 +1,8 @@ +package DemoUnPod; +$VERSION = '0.01'; + +use Filter::Simple; + +FILTER_ONLY + executable => sub { s/x/X/g }, + executable => sub { print } diff --git a/demo/Demo_Data.pm b/demo/Demo_Data.pm new file mode 100644 index 0000000..fe9315b --- /dev/null +++ b/demo/Demo_Data.pm @@ -0,0 +1,6 @@ +package Demo_Data; +$VERSION = '0.01'; + +use Filter::Simple; + +FILTER { s/say/print/g; } diff --git a/demo/Demo_Exporter.pm b/demo/Demo_Exporter.pm new file mode 100644 index 0000000..030746e --- /dev/null +++ b/demo/Demo_Exporter.pm @@ -0,0 +1,15 @@ +package Demo_Exporter; +$VERSION = '0.01'; + +use Filter::Simple; +use base Exporter; + +@EXPORT = qw(foo); # symbols to export by default +@EXPORT_OK = qw(bar); # symbols to export on request + +sub foo { print "foo\n" } +sub bar { print "bar\n" } + +FILTER { + s/dye/die/g; +} diff --git a/demo/Demo_Importer.pm b/demo/Demo_Importer.pm new file mode 100644 index 0000000..0433433 --- /dev/null +++ b/demo/Demo_Importer.pm @@ -0,0 +1,14 @@ +package Demo_Importer; +$VERSION = '0.01'; + +use Filter::Simple; + +sub import { + use Data::Dumper 'Dumper'; + print Dumper [ caller 0 ]; + print Dumper [ @_ ]; +} + +FILTER { + s/dye/die/g; +} diff --git a/demo/Demo_REM.pm b/demo/Demo_REM.pm new file mode 100644 index 0000000..5d31ac1 --- /dev/null +++ b/demo/Demo_REM.pm @@ -0,0 +1,13 @@ +package Demo_REM; +$VERSION = '0.01'; + +use Filter::Simple; +use Regexp::Common; +FILTER_ONLY + regex => sub { print "1a: $_\n"; s/\!\[/[^/g; print "1b: $_\n" }, + all => sub { print "1c: $_\n" }, + + regex => sub { print "2a: $_\n"; s/%d/$RE{num}{int}/g; print "2b: $_\n" }, + all => sub { print "2c: $_\n" }, + regex => sub { print "3a: $_\n"; s/%f/$RE{num}{real}/g; print "3b: $_\n" }, + all => sub { print "3c: $_\n" }; diff --git a/demo/DotsForArrows.pm b/demo/DotsForArrows.pm new file mode 100644 index 0000000..b6dc813 --- /dev/null +++ b/demo/DotsForArrows.pm @@ -0,0 +1,3 @@ +package DotsForArrows; +use Filter::Simple; +FILTER { s/\b\.(?=[a-z_\$({[])/->/gi }; diff --git a/demo/demo.pl b/demo/demo.pl new file mode 100644 index 0000000..d9e2dff --- /dev/null +++ b/demo/demo.pl @@ -0,0 +1,8 @@ +use Demo1 qr/bill/i => "William", is => 'was' ; + +sub bill { print "My name is Bill\n"; "explicitly named" } + +bill(); +&bill; + +print "Thanks, Bill, your bill is @{[bill()]}\n"; diff --git a/demo/demo2.pl b/demo/demo2.pl new file mode 100644 index 0000000..46fbf6d --- /dev/null +++ b/demo/demo2.pl @@ -0,0 +1,30 @@ +no warnings; + +use Demo2b; + +$x = 1; + +use Demo2a x => 1; + +$y = 2; + +print $x * $y, "\n"; + + +no Demo2a; + + +$x *= 2; + +print $x * $y, "\n"; + +no Demo2b; + +$x = 1; +$y = 2; + +print $x * $y, "\n"; + +$x *= 2; + +print $x * $y, "\n"; diff --git a/demo/demo_data.pl b/demo/demo_data.pl new file mode 100644 index 0000000..8b30bc0 --- /dev/null +++ b/demo/demo_data.pl @@ -0,0 +1,11 @@ +use Demo_Data; + +say "yes:\n", ; + +print "say\n"; + +__DATA__ +a +b +c +d diff --git a/demo/demo_dots.pl b/demo/demo_dots.pl new file mode 100644 index 0000000..ec8eb05 --- /dev/null +++ b/demo/demo_dots.pl @@ -0,0 +1,22 @@ +use DotsForArrows; + +package MyClass; + +sub new { bless [$_[1], 1..10], $_[0] } +sub next { my ($self) = @_; return "next is: " . shift(@$self) . "\n" } + +package main; + +my ($str1, $str2) = ("a", "z"); +my $obj = MyClass.new($str1 . $str2); + +print $obj.next() for 1..10; + +print $obj.[0] . "\n"; + +my $next = 'next'; +print $obj.$next; + +#etc. + + diff --git a/demo/demo_exporter.pl b/demo/demo_exporter.pl new file mode 100644 index 0000000..7dec366 --- /dev/null +++ b/demo/demo_exporter.pl @@ -0,0 +1,4 @@ +use Demo_Exporter 'bar'; + +bar; +dye "tee"; diff --git a/demo/demo_importer.pl b/demo/demo_importer.pl new file mode 100644 index 0000000..6732986 --- /dev/null +++ b/demo/demo_importer.pl @@ -0,0 +1,3 @@ +use Demo_Importer qw(some args for import); + +dye "tee"; diff --git a/demo/demo_regex_macro.pl b/demo/demo_regex_macro.pl new file mode 100644 index 0000000..c41239c --- /dev/null +++ b/demo/demo_regex_macro.pl @@ -0,0 +1,15 @@ +use Demo_REM; + +=head1 A demo + + print if /^(%d|![a])/; + +=cut + +while (<>) { + print if /^(%d|![a])/; +} + +__DATA__ + + print if /^(%d|![a])/; diff --git a/demo/demo_revcat.pl b/demo/demo_revcat.pl new file mode 100644 index 0000000..f9b1523 --- /dev/null +++ b/demo/demo_revcat.pl @@ -0,0 +1,7 @@ +use DemoRevCat; + +my $str = "abc" . q:def:; + +print "$str\n"; + + diff --git a/demo/demo_swear.pl b/demo/demo_swear.pl new file mode 100644 index 0000000..3cc90f6 --- /dev/null +++ b/demo/demo_swear.pl @@ -0,0 +1,91 @@ +use DemoSwear; + +# WARNING: THIS DEMO CONTAINS AND PRODUCES OFFENSIVE LANGUAGE... + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +my $this = qr/a merde string/; +print #*@%-ing "that merde: $this\n"; +print #*@%-ing <1) { shift; goto &FILTER } + else { *{caller()."::$_"} = \&$_ foreach @EXPORT } +} + +sub fail { + croak "FILTER_ONLY: ", @_; +} + +my $exql = sub { + my @bits = extract_quotelike $_[0], qr//; + return unless $bits[0]; + return \@bits; +}; + +my $ncws = qr/\s+/; +my $comment = qr/(?()-]|\^[A-Z]?)\} + | (?:\$#?|[*\@\%]|\\&)\$*\s* + (?: \{\s*(?:\^(?=[A-Z_]))?(?:\w|::|'\w)*\s*\} + | (?:\^(?=[A-Z_]))?(?:\w|::|'\w)* + | (?=\{) # ${ block } + ) + ) + | \$\s*(?!::)(?:\d+|[][&`'#+*./|,";%=~:?!\@<>()-]|\^[A-Z]?) + }x; + +my %extractor_for = ( + quotelike => [ $ws, $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 }, $variable, + $id, { DONT_MATCH => \&extract_quotelike } ], + code_no_comments + => [ { DONT_MATCH => $comment }, + $ncws, { DONT_MATCH => $pod_or_DATA }, $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; + }; + }, +); + + +sub gen_std_filter_for { + 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(.{4})\Q$;\E/s; + my $extractor = qr/\Q$;\E(.{4})\Q$;\E/s; + $_ = 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 $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)__)\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 = $_; + $count++; + 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) = @_; + return sub { + filter_del(); + goto &$prev_unimport if $prev_unimport; + } +} + +1; + +__END__ + +=head1 NAME + +Filter::Simple - Simplified source filtering + +=head1 SYNOPSIS + + # in MyFilter.pm: + + package MyFilter; + + use Filter::Simple; + + FILTER { ... }; + + # or just: + # + # use Filter::Simple sub { ... }; + + # in user's code: + + use MyFilter; + + # this code is filtered + + no MyFilter; + + # this code is not + + +=head1 DESCRIPTION + +=head2 The Problem + +Source filtering is an immensely powerful feature of recent versions of Perl. +It allows one to extend the language itself (e.g. the Switch module), to +simplify the language (e.g. Language::Pythonesque), or to completely recast the +language (e.g. Lingua::Romana::Perligata). Effectively, it allows one to use +the full power of Perl as its own, recursively applied, macro language. + +The excellent Filter::Util::Call module (by Paul Marquess) provides a +usable Perl interface to source filtering, but it is often too powerful +and not nearly as simple as it could be. + +To use the module it is necessary to do the following: + +=over 4 + +=item 1. + +Download, build, and install the Filter::Util::Call module. +(If you have Perl 5.7.1 or later, this is already done for you.) + +=item 2. + +Set up a module that does a C. + +=item 3. + +Within that module, create an C subroutine. + +=item 4. + +Within the C subroutine do a call to C, passing +it either a subroutine reference. + +=item 5. + +Within the subroutine reference, call C or C +to "prime" $_ with source code data from the source file that will +C your module. Check the status value returned to see if any +source code was actually read in. + +=item 6. + +Process the contents of $_ to change the source code in the desired manner. + +=item 7. + +Return the status value. + +=item 8. + +If the act of unimporting your module (via a C) should cause source +code filtering to cease, create an C subroutine, and have it call +C. Make sure that the call to C or +C in step 5 will not accidentally read past the +C. Effectively this limits source code filters to line-by-line +operation, unless the C subroutine does some fancy +pre-pre-parsing of the source code it's filtering. + +=back + +For example, here is a minimal source code filter in a module named +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; + + 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(); + } + + 1 ; + +This level of sophistication puts filtering out of the reach of +many programmers. + + +=head2 A Solution + +The Filter::Simple module provides a simplified interface to +Filter::Util::Call; one that is sufficient for most common cases. + +Instead of the above process, with Filter::Simple the task of setting up +a source code filter is reduced to: + +=over 4 + +=item 1. + +Download and install the Filter::Simple module. +(If you have Perl 5.7.1 or later, this is already done for you.) + +=item 2. + +Set up a module that does a C and then +calls C. + +=item 3. + +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; + + FILTER { + s/BANG\s+BANG/die 'BANG' if \$BANG/g; + }; + + 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. + +=head2 Disabling or changing behaviour + +By default, the installed filter only filters up to a line consisting of one of +the three standard source "terminators": + + no ModuleName; # optional comment + +or: + + __END__ + +or: + + __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 +you use 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), or a reference to a hash +(in which case the terminator is the value associated with the key +C<'terminator'>. + +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*?$/; + +or: + + 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 + +or: + + FILTER { + s/BANG\s+BANG/die 'BANG' if \$BANG/g; + } + { terminator => "" }; + +B be contained on a single source line.> + + +=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 Filtering only specific components of source code + +One of the problems with a filter like: + + use Filter::Simple; + + 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; + +will become: + + 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 +the character strings. + +Filter::Simple supports this type of filtering by automatically +exporting the C subroutine. + +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; + + 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 +subroutine only filters Perl quotelikes (including here documents). + +The full list of alternatives is: + +=over + +=item C<"code"> + +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 +C<&Text::Balanced::extract_quotelike>). + +=item C<"string"> + +Filters only the string literal parts of a Perl quotelike (i.e. the +contents of a string literal, either half of a C, the second +half of an C). + +=item C<"regex"> + +Filters only the pattern literal parts of a Perl quotelike (i.e. the +contents of a C or an C, the first half of an C). + +=item C<"all"> + +Filters everything. Identical in effect to C. + +=back + +Except for C<< FILTER_ONLY code => sub {...} >>, each of +the component filters is called repeatedly, once for each component +found in the source code. + +Note that you can also apply two or more of the same type of filter in +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 }; + + + +=head2 Filtering only the code parts of 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'> +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 +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, +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 +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...and +captures the identifier within the placeholder. Placeholders can be +moved and re-ordered within the source code as needed. + +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 concatenated pairs of +strings/quotelikes and reverses the order in which they are +concatenated: + + package DemoRevCat; + use Filter::Simple; + + FILTER_ONLY code => sub { + my $ph = $Filter::Simple::placeholder; + s{ ($ph) \s* [.] \s* ($ph) }{ $2.$1 }gx + }; + +Thus, the following code: + + use DemoRevCat; + + my $str = "abc" . q(def); + + print "$str\n"; + +would become: + + my $str = q(def)."abc"; + + print "$str\n"; + +and hence print: + + defabc + + +=head2 Using Filter::Simple with an explicit C subroutine + +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. + +However, Filter::Simple is smart enough to notice your existing +C and Do The Right Thing with it. +That is, if you explicitly 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 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; + + 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: + + package Filter::TurnItUpTo11; + + use Filter::Simple sub{ s/(\w+)/\U$1/ }; + +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 + +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. + +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; + + 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 + + +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 + +Damian Conway + +=head1 CONTACT + +Filter::Simple is now maintained by the Perl5-Porters. +Please submit bug via the C tool that comes with your perl. +For usage instructions, read C or possibly C. +For mostly anything else, please contact Eperl5-porters@perl.orgE. + +Maintainer of the CPAN release is Steffen Mueller Esmueller@cpan.orgE. +Contact him with technical difficulties with respect to the packaging of the +CPAN module. + +Praise of the module, flowers, and presents still go to the author, +Damian Conway Edamian@conway.orgE. + +=head1 COPYRIGHT AND LICENSE + + Copyright (c) 2000-2014, 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. diff --git a/t/code_no_comments.t b/t/code_no_comments.t new file mode 100644 index 0000000..444e787 --- /dev/null +++ b/t/code_no_comments.t @@ -0,0 +1,15 @@ +BEGIN { + unshift @INC, 't/lib/'; +} + +use Filter::Simple::CodeNoComments qr/ok/ => 'not ok'; + +print "1..1\n"; + + +# Perl bug #92436 (the second bug in the ticket) + +sub method { $_[1] } +my $obj = bless[]; + +print $obj->method("ok 1\n"); diff --git a/t/data.t b/t/data.t new file mode 100644 index 0000000..0e67569 --- /dev/null +++ b/t/data.t @@ -0,0 +1,16 @@ +BEGIN { + unshift @INC, 't/lib/'; +} + +use Filter::Simple::FilterOnlyTest qr/ok/ => "not ok", "bad" => "ok"; +print "1..6\n"; + +print "bad 1\n"; +print "bad 2\n"; +print "bad 3\n"; +print ; + +__DATA__ +ok 4 +ok 5 +ok 6 diff --git a/t/export.t b/t/export.t new file mode 100644 index 0000000..0f4d9b1 --- /dev/null +++ b/t/export.t @@ -0,0 +1,8 @@ +BEGIN { + unshift @INC, 't/lib/'; +} +BEGIN { print "1..1\n" } + +use Filter::Simple::ExportTest 'ok'; + +notok 1; diff --git a/t/filter.t b/t/filter.t new file mode 100644 index 0000000..bf35977 --- /dev/null +++ b/t/filter.t @@ -0,0 +1,24 @@ +BEGIN { + unshift @INC, 't/lib/'; +} + +use Filter::Simple::FilterTest qr/not ok/ => "ok", fail => "ok"; + +print "1..6\n"; + +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 Filter::Simple::FilterTest; + +print "not " unless "not ok" =~ /^not /; +print "ok 6\n"; + diff --git a/t/filter_only.t b/t/filter_only.t new file mode 100644 index 0000000..57f1086 --- /dev/null +++ b/t/filter_only.t @@ -0,0 +1,43 @@ +BEGIN { + unshift @INC, 't/lib/'; +} + +use Filter::Simple::FilterOnlyTest qr/not ok/ => "ok", + "bad" => "ok", fail => "die"; +print "1..9\n"; + +sub fail { print "ok ", $_[0], "\n" } +sub ok { print "ok ", $_[0], "\n" } + +print "not ok 1\n"; +print "bad 2\n"; + +fail(3); +&fail(4); + +print "not " unless "whatnot okapi" eq "whatokapi"; +print "ok 5\n"; + +ok 7 unless not ok 6; + +=begin scrumbly + +=end scrumbly + +shromple + +=cut + +=for us + +shromple again + +=cut + +no Filter::Simple::FilterOnlyTest; # THE FUN STOPS HERE + +print "not " unless "not ok" =~ /^not /; +print "ok 8\n"; + +print "not " unless "bad" =~ /bad/; +print "ok 9\n"; diff --git a/t/import.t b/t/import.t new file mode 100644 index 0000000..e5c6070 --- /dev/null +++ b/t/import.t @@ -0,0 +1,9 @@ +BEGIN { + unshift @INC, 't/lib'; +} + +BEGIN { print "1..4\n" } + +use Filter::Simple::ImportTest (1..3); + +say "not ok 4\n"; diff --git a/t/lib/Filter/Simple/CodeNoComments.pm b/t/lib/Filter/Simple/CodeNoComments.pm new file mode 100644 index 0000000..168271f --- /dev/null +++ b/t/lib/Filter/Simple/CodeNoComments.pm @@ -0,0 +1,13 @@ +package Filter::Simple::CodeNoComments; + +use Filter::Simple; + +FILTER_ONLY + code_no_comments => sub { + shift; + while (my($pat, $str) = splice @_, 0, 2) { + s/$pat/$str/g; + } + }; + +1; diff --git a/t/lib/Filter/Simple/ExportTest.pm b/t/lib/Filter/Simple/ExportTest.pm new file mode 100644 index 0000000..e394188 --- /dev/null +++ b/t/lib/Filter/Simple/ExportTest.pm @@ -0,0 +1,12 @@ +package Filter::Simple::ExportTest; + +use Filter::Simple; +use parent qw(Exporter); + +@EXPORT_OK = qw(ok); + +FILTER { s/not// }; + +sub ok { print "ok @_\n" } + +1; diff --git a/t/lib/Filter/Simple/FilterOnlyTest.pm b/t/lib/Filter/Simple/FilterOnlyTest.pm new file mode 100644 index 0000000..e692f8b --- /dev/null +++ b/t/lib/Filter/Simple/FilterOnlyTest.pm @@ -0,0 +1,14 @@ +package Filter::Simple::FilterOnlyTest; + +use Filter::Simple; + +FILTER_ONLY + string => sub { + my $class = shift; + while (my($pat, $str) = splice @_, 0, 2) { + s/$pat/$str/g; + } + }, + code_no_comments => sub { + $_ =~ /shromple/ and die "We wants no shromples!"; + }; diff --git a/t/lib/Filter/Simple/FilterTest.pm b/t/lib/Filter/Simple/FilterTest.pm new file mode 100644 index 0000000..fab3e27 --- /dev/null +++ b/t/lib/Filter/Simple/FilterTest.pm @@ -0,0 +1,12 @@ +package Filter::Simple::FilterTest; + +use Filter::Simple; + +FILTER { + my $class = shift; + while (my($pat, $str) = splice @_, 0, 2) { + s/$pat/$str/g; + } +}; + +1; diff --git a/t/lib/Filter/Simple/ImportTest.pm b/t/lib/Filter/Simple/ImportTest.pm new file mode 100644 index 0000000..695e5e8 --- /dev/null +++ b/t/lib/Filter/Simple/ImportTest.pm @@ -0,0 +1,19 @@ +package Filter::Simple::ImportTest; + +use parent qw(Exporter); +@EXPORT = qw(say); + +sub say { print @_ } + +use Filter::Simple; + +sub import { + my $class = shift; + print "ok $_\n" foreach @_; + __PACKAGE__->export_to_level(1,$class); +} + +FILTER { s/not // }; + + +1;