Commit | Line | Data |
---|---|---|
b38acab9 JH |
1 | package Filter::Simple; |
2 | ||
3 | use vars qw{ $VERSION }; | |
4 | ||
55a1c97c | 5 | $VERSION = '0.61'; |
b38acab9 JH |
6 | |
7 | use Filter::Util::Call; | |
8 | use Carp; | |
9 | ||
10 | sub import { | |
fbe2c49e JH |
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 JH |
19 | *{"${caller}::unimport"} = \*filter_unimport; |
20 | } | |
21 | ||
22 | sub gen_filter_import { | |
fbe2c49e | 23 | my ($class, $filter, $terminator) = @_; |
b38acab9 JH |
24 | return sub { |
25 | my ($imported_class, @args) = @_; | |
fbe2c49e JH |
26 | $terminator = qr/^\s*no\s+$imported_class\s*;\s*$/ |
27 | unless defined $terminator; | |
b38acab9 JH |
28 | filter_add( |
29 | sub { | |
30 | my ($status, $off); | |
fbe2c49e | 31 | my $count = 0; |
b38acab9 JH |
32 | my $data = ""; |
33 | while ($status = filter_read()) { | |
fbe2c49e JH |
34 | return $status if $status < 0; |
35 | if ($terminator && m/$terminator/) { | |
b38acab9 JH |
36 | $off=1; |
37 | last; | |
38 | } | |
39 | $data .= $_; | |
fbe2c49e | 40 | $count++; |
b38acab9 JH |
41 | $_ = ""; |
42 | } | |
43 | $_ = $data; | |
44 | $filter->(@args) unless $status < 0; | |
fbe2c49e JH |
45 | $_ .= "no $imported_class;\n" if $off; |
46 | return $count; | |
b38acab9 JH |
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 JH |
65 | =head1 SYNOPSIS |
66 | ||
67 | # in MyFilter.pm: | |
68 | ||
69 | package MyFilter; | |
70 | ||
fbe2c49e JH |
71 | use Filter::Simple; |
72 | ||
73 | FILTER { ... }; | |
b38acab9 | 74 | |
fbe2c49e JH |
75 | # or just: |
76 | # | |
77 | # use Filter::Simple sub { ... }; | |
b38acab9 JH |
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 JH |
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 JH |
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 JH |
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 JH |
188 | This level of sophistication puts filtering out of the reach of |
189 | many programmers. | |
b38acab9 JH |
190 | |
191 | ||
192 | =head2 A Solution | |
193 | ||
7bf0340c | 194 | The Filter::Simple module provides a simplified interface to |
b38acab9 JH |
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 JH |
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 JH |
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 JH |
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 JH |
217 | |
218 | =back | |
219 | ||
220 | In other words, the previous example, would become: | |
221 | ||
222 | package BANG; | |
fbe2c49e JH |
223 | use Filter::Simple; |
224 | ||
225 | FILTER { | |
b38acab9 JH |
226 | s/BANG\s+BANG/die 'BANG' if \$BANG/g; |
227 | }; | |
228 | ||
229 | 1 ; | |
230 | ||
231 | ||
fbe2c49e JH |
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 JH |
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 JH |
334 | =head2 How it works |
335 | ||
fbe2c49e JH |
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 JH |
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 JH |
347 | |
348 | use Filter::Simple; | |
349 | ||
350 | FILTER { | |
b38acab9 JH |
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 JH |
358 | |
359 | ||
fbe2c49e JH |
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 JH |
365 | |
366 | ||
367 | =head1 AUTHOR | |
368 | ||
369 | Damian Conway (damian@conway.org) | |
370 | ||
371 | =head1 COPYRIGHT | |
372 | ||
55a1c97c JH |
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. |