Commit | Line | Data |
b38acab9 |
1 | package Filter::Simple; |
2 | |
3 | use vars qw{ $VERSION }; |
4 | |
fbe2c49e |
5 | $VERSION = '0.60'; |
b38acab9 |
6 | |
7 | use Filter::Util::Call; |
8 | use Carp; |
9 | |
10 | sub import { |
fbe2c49e |
11 | if (@_>1) { shift; goto &FILTER } |
12 | else { *{caller()."::FILTER"} = \&FILTER } |
13 | } |
14 | |
15 | sub FILTER (&;$) { |
b38acab9 |
16 | my $caller = caller; |
fbe2c49e |
17 | my ($filter, $terminator) = @_; |
18 | croak "Usage: use Filter::Simple sub {...}, $terminator_opt;" |
19 | unless ref $filter eq CODE; |
20 | *{"${caller}::import"} = gen_filter_import($caller,$filter,$terminator); |
b38acab9 |
21 | *{"${caller}::unimport"} = \*filter_unimport; |
22 | } |
23 | |
24 | sub gen_filter_import { |
fbe2c49e |
25 | my ($class, $filter, $terminator) = @_; |
b38acab9 |
26 | return sub { |
27 | my ($imported_class, @args) = @_; |
fbe2c49e |
28 | $terminator = qr/^\s*no\s+$imported_class\s*;\s*$/ |
29 | unless defined $terminator; |
b38acab9 |
30 | filter_add( |
31 | sub { |
32 | my ($status, $off); |
fbe2c49e |
33 | my $count = 0; |
b38acab9 |
34 | my $data = ""; |
35 | while ($status = filter_read()) { |
fbe2c49e |
36 | return $status if $status < 0; |
37 | if ($terminator && m/$terminator/) { |
b38acab9 |
38 | $off=1; |
39 | last; |
40 | } |
41 | $data .= $_; |
fbe2c49e |
42 | $count++; |
b38acab9 |
43 | $_ = ""; |
44 | } |
45 | $_ = $data; |
46 | $filter->(@args) unless $status < 0; |
fbe2c49e |
47 | $_ .= "no $imported_class;\n" if $off; |
48 | return $count; |
b38acab9 |
49 | } |
50 | ); |
51 | } |
52 | } |
53 | |
54 | sub filter_unimport { |
55 | filter_del(); |
56 | } |
57 | |
58 | 1; |
59 | |
60 | __END__ |
61 | |
62 | =head1 NAME |
63 | |
64 | Filter::Simple - Simplified source filtering |
65 | |
fbe2c49e |
66 | |
b38acab9 |
67 | =head1 SYNOPSIS |
68 | |
69 | # in MyFilter.pm: |
70 | |
71 | package MyFilter; |
72 | |
fbe2c49e |
73 | use Filter::Simple; |
74 | |
75 | FILTER { ... }; |
b38acab9 |
76 | |
fbe2c49e |
77 | # or just: |
78 | # |
79 | # use Filter::Simple sub { ... }; |
b38acab9 |
80 | |
81 | # in user's code: |
82 | |
83 | use MyFilter; |
84 | |
85 | # this code is filtered |
86 | |
87 | no MyFilter; |
88 | |
89 | # this code is not |
90 | |
91 | |
92 | =head1 DESCRIPTION |
93 | |
94 | =head2 The Problem |
95 | |
96 | Source filtering is an immensely powerful feature of recent versions of Perl. |
97 | It allows one to extend the language itself (e.g. the Switch module), to |
98 | simplify the language (e.g. Language::Pythonesque), or to completely recast the |
99 | language (e.g. Lingua::Romana::Perligata). Effectively, it allows one to use |
100 | the full power of Perl as its own, recursively applied, macro language. |
101 | |
102 | The excellent Filter::Util::Call module (by Paul Marquess) provides a |
103 | usable Perl interface to source filtering, but it is often too powerful |
104 | and not nearly as simple as it could be. |
105 | |
106 | To use the module it is necessary to do the following: |
107 | |
108 | =over 4 |
109 | |
110 | =item 1. |
111 | |
112 | Download, build, and install the Filter::Util::Call module. |
67438989 |
113 | (If you have Perl 5.7.1 or later you already have Filter::Util::Call.) |
b38acab9 |
114 | |
115 | =item 2. |
116 | |
117 | Set up a module that does a C<use Filter::Util::Call>. |
118 | |
119 | =item 3. |
120 | |
121 | Within that module, create an C<import> subroutine. |
122 | |
123 | =item 4. |
124 | |
125 | Within the C<import> subroutine do a call to C<filter_add>, passing |
126 | it either a subroutine reference. |
127 | |
128 | =item 5. |
129 | |
130 | Within the subroutine reference, call C<filter_read> or C<filter_read_exact> |
131 | to "prime" $_ with source code data from the source file that will |
132 | C<use> your module. Check the status value returned to see if any |
133 | source code was actually read in. |
134 | |
135 | =item 6. |
136 | |
137 | Process the contents of $_ to change the source code in the desired manner. |
138 | |
139 | =item 7. |
140 | |
141 | Return the status value. |
142 | |
143 | =item 8. |
144 | |
145 | If the act of unimporting your module (via a C<no>) should cause source |
146 | code filtering to cease, create an C<unimport> subroutine, and have it call |
147 | C<filter_del>. Make sure that the call to C<filter_read> or |
148 | C<filter_read_exact> in step 5 will not accidentally read past the |
149 | C<no>. Effectively this limits source code filters to line-by-line |
150 | operation, unless the C<import> subroutine does some fancy |
151 | pre-pre-parsing of the source code it's filtering. |
152 | |
153 | =back |
154 | |
155 | For example, here is a minimal source code filter in a module named |
156 | BANG.pm. It simply converts every occurrence of the sequence C<BANG\s+BANG> |
157 | to the sequence C<die 'BANG' if $BANG> in any piece of code following a |
158 | C<use BANG;> statement (until the next C<no BANG;> statement, if any): |
159 | |
160 | package BANG; |
fbe2c49e |
161 | |
b38acab9 |
162 | use Filter::Util::Call ; |
163 | |
164 | sub import { |
165 | filter_add( sub { |
166 | my $caller = caller; |
167 | my ($status, $no_seen, $data); |
168 | while ($status = filter_read()) { |
fbe2c49e |
169 | if (/^\s*no\s+$caller\s*;\s*?$/) { |
b38acab9 |
170 | $no_seen=1; |
171 | last; |
172 | } |
173 | $data .= $_; |
174 | $_ = ""; |
175 | } |
176 | $_ = $data; |
177 | s/BANG\s+BANG/die 'BANG' if \$BANG/g |
178 | unless $status < 0; |
179 | $_ .= "no $class;\n" if $no_seen; |
180 | return 1; |
181 | }) |
182 | } |
183 | |
184 | sub unimport { |
185 | filter_del(); |
186 | } |
187 | |
188 | 1 ; |
189 | |
7bf0340c |
190 | This level of sophistication puts filtering out of the reach of |
191 | many programmers. |
b38acab9 |
192 | |
193 | |
194 | =head2 A Solution |
195 | |
7bf0340c |
196 | The Filter::Simple module provides a simplified interface to |
b38acab9 |
197 | Filter::Util::Call; one that is sufficient for most common cases. |
198 | |
199 | Instead of the above process, with Filter::Simple the task of setting up |
200 | a source code filter is reduced to: |
201 | |
202 | =over 4 |
203 | |
204 | =item 1. |
205 | |
fbe2c49e |
206 | Set up a module that does a C<use Filter::Simple> and then |
207 | calls C<FILTER { ... }>. |
b38acab9 |
208 | |
209 | =item 2. |
210 | |
fbe2c49e |
211 | Within the anonymous subroutine or block that is passed to |
212 | C<FILTER>, process the contents of $_ to change the source code in |
213 | the desired manner. |
b38acab9 |
214 | |
215 | =back |
216 | |
217 | In other words, the previous example, would become: |
218 | |
219 | package BANG; |
fbe2c49e |
220 | use Filter::Simple; |
221 | |
222 | FILTER { |
b38acab9 |
223 | s/BANG\s+BANG/die 'BANG' if \$BANG/g; |
224 | }; |
225 | |
226 | 1 ; |
227 | |
228 | |
fbe2c49e |
229 | =head2 Disabling or changing <no> behaviour |
230 | |
231 | By default, the installed filter only filters to a line of the form: |
232 | |
233 | no ModuleName; |
234 | |
235 | but this can be altered by passing a second argument to C<use Filter::Simple>. |
236 | |
237 | That second argument may be either a C<qr>'d regular expression (which is then |
238 | used to match the terminator line), or a defined false value (which indicates |
239 | that no terminator line should be looked for). |
240 | |
241 | For example, to cause the previous filter to filter only up to a line of the |
242 | form: |
243 | |
244 | GNAB esu; |
245 | |
246 | you would write: |
247 | |
248 | package BANG; |
249 | use Filter::Simple; |
250 | |
251 | FILTER { |
252 | s/BANG\s+BANG/die 'BANG' if \$BANG/g; |
253 | } |
254 | => qr/^\s*GNAB\s+esu\s*;\s*?$/; |
255 | |
256 | and to prevent the filter's being turned off in any way: |
257 | |
258 | package BANG; |
259 | use Filter::Simple; |
260 | |
261 | FILTER { |
262 | s/BANG\s+BANG/die 'BANG' if \$BANG/g; |
263 | } |
264 | => ""; |
265 | # or: => 0; |
266 | |
267 | |
268 | =head2 All-in-one interface |
269 | |
270 | Separating the loading of Filter::Simple: |
271 | |
272 | use Filter::Simple; |
273 | |
274 | from the setting up of the filtering: |
275 | |
276 | FILTER { ... }; |
277 | |
278 | is useful because it allows other code (typically parser support code |
279 | or caching variables) to be defined before the filter is invoked. |
280 | However, there is often no need for such a separation. |
281 | |
282 | In those cases, it is easier to just append the filtering subroutine and |
283 | any terminator specification directly to the C<use> statement that loads |
284 | Filter::Simple, like so: |
285 | |
286 | use Filter::Simple sub { |
287 | s/BANG\s+BANG/die 'BANG' if \$BANG/g; |
288 | }; |
289 | |
290 | This is exactly the same as: |
291 | |
292 | use Filter::Simple; |
293 | BEGIN { |
294 | Filter::Simple::FILTER { |
295 | s/BANG\s+BANG/die 'BANG' if \$BANG/g; |
296 | }; |
297 | } |
298 | |
299 | except that the C<FILTER> subroutine is not exported by Filter::Simple. |
300 | |
301 | |
b38acab9 |
302 | =head2 How it works |
303 | |
fbe2c49e |
304 | The Filter::Simple module exports into the package that calls C<FILTER> |
305 | (or C<use>s it directly) -- such as package "BANG" in the above example -- |
306 | two automagically constructed |
b38acab9 |
307 | subroutines -- C<import> and C<unimport> -- which take care of all the |
308 | nasty details. |
309 | |
310 | In addition, the generated C<import> subroutine passes its own argument |
311 | list to the filtering subroutine, so the BANG.pm filter could easily |
312 | be made parametric: |
313 | |
314 | package BANG; |
fbe2c49e |
315 | |
316 | use Filter::Simple; |
317 | |
318 | FILTER { |
b38acab9 |
319 | my ($die_msg, $var_name) = @_; |
320 | s/BANG\s+BANG/die '$die_msg' if \${$var_name}/g; |
321 | }; |
322 | |
323 | # and in some user code: |
324 | |
fbe2c49e |
325 | use BANG "BOOM", "BAM"; # "BANG BANG" becomes: die 'BOOM' if $BAM |
b38acab9 |
326 | |
327 | |
fbe2c49e |
328 | The specified filtering subroutine is called every time a C<use BANG> is |
329 | encountered, and passed all the source code following that call, up to |
330 | either the next C<no BANG;> (or whatever terminator you've set) or the |
331 | end of the source file, whichever occurs first. By default, any C<no |
332 | BANG;> call must appear by itself on a separate line, or it is ignored. |
b38acab9 |
333 | |
334 | |
335 | =head1 AUTHOR |
336 | |
337 | Damian Conway (damian@conway.org) |
338 | |
339 | =head1 COPYRIGHT |
340 | |
341 | Copyright (c) 2000, Damian Conway. All Rights Reserved. |
fbe2c49e |
342 | This module is free software. It may be used, redistributed |
343 | and/or modified under the terms of the Perl Artistic License |
344 | (see http://www.perl.com/perl/misc/Artistic.html) |