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