This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
069482a702dc75ad95f6d30e6006e1e3eee57139
[perl5.git] / dist / Filter-Simple / lib / Filter / Simple.pm
1 package Filter::Simple;
2
3 use Text::Balanced ':ALL';
4
5 use vars qw{ $VERSION @EXPORT };
6
7 $VERSION = '0.92';
8
9 use Filter::Util::Call;
10 use Carp;
11
12 @EXPORT = qw( FILTER FILTER_ONLY );
13
14
15 sub import {
16     if (@_>1) { shift; goto &FILTER }
17     else      { *{caller()."::$_"} = \&$_ foreach @EXPORT }
18 }
19
20 sub fail {
21     croak "FILTER_ONLY: ", @_;
22 }
23
24 my $exql = sub {
25     my @bits = extract_quotelike $_[0], qr//;
26     return unless $bits[0];
27     return \@bits;
28 };
29
30 my $ncws = qr/\s+/;
31 my $comment = qr/(?<![\$\@%])#.*/;
32 my $ws = qr/(?:$ncws|$comment)+/;
33 my $id = qr/\b(?!([ysm]|q[rqxw]?|tr)\b)\w+/;
34 my $EOP = qr/\n\n|\Z/;
35 my $CUT = qr/\n=cut.*$EOP/;
36 my $pod_or_DATA = qr/
37               ^=(?:head[1-4]|item) .*? $CUT
38             | ^=pod .*? $CUT
39             | ^=for .*? $CUT
40             | ^=begin .*? $CUT
41             | ^__(DATA|END)__\r?\n.*
42             /smx;
43 my $variable = qr{
44         [\$*\@%]\s*
45             \{\s*(?!::)(?:\d+|[][&`'#+*./|,";%=~:?!\@<>()-]|\^[A-Z]?)\}
46       | (?:\$#?|[*\@\%]|\\&)\$*\s*
47                (?:  \{\s*(?:\^(?=[A-Z_]))?(?:\w|::|'\w)*\s*\}
48                   |      (?:\^(?=[A-Z_]))?(?:\w|::|'\w)*
49                   | (?=\{)  # ${ block }
50                )
51         )
52       | \$\s*(?!::)(?:\d+|[][&`'#+*./|,";%=~:?!\@<>()-]|\^[A-Z]?)
53    }x;
54
55 my %extractor_for = (
56     quotelike  => [ $ws,  $variable, $id, { MATCH  => \&extract_quotelike } ],
57     regex      => [ $ws,  $pod_or_DATA, $id, $exql           ],
58     string     => [ $ws,  $pod_or_DATA, $id, $exql           ],
59     code       => [ $ws, { DONT_MATCH => $pod_or_DATA }, $variable,
60                     $id, { DONT_MATCH => \&extract_quotelike }   ],
61     code_no_comments
62                => [ { DONT_MATCH => $comment },
63                     $ncws, { DONT_MATCH => $pod_or_DATA }, $variable,
64                     $id, { DONT_MATCH => \&extract_quotelike }   ],
65     executable => [ $ws, { DONT_MATCH => $pod_or_DATA }      ],
66     executable_no_comments
67                => [ { DONT_MATCH => $comment },
68                     $ncws, { DONT_MATCH => $pod_or_DATA }      ],
69     all        => [        { MATCH  => qr/(?s:.*)/         } ],
70 );
71
72 my %selector_for = (
73     all   => sub { my ($t)=@_; sub{ $_=$$_; $t->(@_); $_} },
74     executable=> sub { my ($t)=@_; sub{ref() ? $_=$$_ : $t->(@_); $_} }, 
75     quotelike => sub { my ($t)=@_; sub{ref() && do{$_=$$_; $t->(@_)}; $_} },
76     regex     => sub { my ($t)=@_;
77                sub{ref() or return $_;
78                    my ($ql,undef,$pre,$op,$ld,$pat) = @$_;
79                    return $_->[0] unless $op =~ /^(qr|m|s)/
80                          || !$op && ($ld eq '/' || $ld eq '?');
81                    $_ = $pat;
82                    $t->(@_);
83                    $ql =~ s/^(\s*\Q$op\E\s*\Q$ld\E)\Q$pat\E/$1$_/;
84                    return "$pre$ql";
85                   };
86             },
87     string     => sub { my ($t)=@_;
88                sub{ref() or return $_;
89                    local *args = \@_;
90                    my ($pre,$op,$ld1,$str1,$rd1,$ld2,$str2,$rd2,$flg) = @{$_}[2..10];
91                    return $_->[0] if $op =~ /^(qr|m)/
92                          || !$op && ($ld1 eq '/' || $ld1 eq '?');
93                    if (!$op || $op eq 'tr' || $op eq 'y') {
94                        local *_ = \$str1;
95                        $t->(@args);
96                    }
97                    if ($op =~ /^(tr|y|s)/) {
98                        local *_ = \$str2;
99                        $t->(@args);
100                    }
101                    my $result = "$pre$op$ld1$str1$rd1";
102                    $result .= $ld2 if $ld1 =~ m/[[({<]/; #])}>
103                    $result .= "$str2$rd2$flg";
104                    return $result;
105                   };
106               },
107 );
108
109
110 sub gen_std_filter_for {
111     my ($type, $transform) = @_;
112     return sub {
113         my $instr;
114         local @components;
115                 for (extract_multiple($_,$extractor_for{$type})) {
116             if (ref())     { push @components, $_; $instr=0 }
117             elsif ($instr) { $components[-1] .= $_ }
118             else           { push @components, $_; $instr=1 }
119         }
120         if ($type =~ /^code/) {
121             my $count = 0;
122             no warnings 'deprecated';
123             local $placeholder = qr/\Q$;\E(\C{4})\Q$;\E/;
124             my $extractor =      qr/\Q$;\E(\C{4})\Q$;\E/;
125             $_ = join "",
126                   map { ref $_ ? $;.pack('N',$count++).$; : $_ }
127                       @components;
128             @components = grep { ref $_ } @components;
129             $transform->(@_);
130             s/$extractor/${$components[unpack('N',$1)]}/g;
131         }
132         else {
133             my $selector = $selector_for{$type}->($transform);
134             $_ = join "", map $selector->(@_), @components;
135         }
136     }
137 };
138
139 sub FILTER (&;$) {
140     my $caller = caller;
141     my ($filter, $terminator) = @_;
142     no warnings 'redefine';
143     *{"${caller}::import"} = gen_filter_import($caller,$filter,$terminator);
144     *{"${caller}::unimport"} = gen_filter_unimport($caller);
145 }
146
147 sub FILTER_ONLY {
148     my $caller = caller;
149     while (@_ > 1) {
150         my ($what, $how) = splice(@_, 0, 2);
151         fail "Unknown selector: $what"
152             unless exists $extractor_for{$what};
153         fail "Filter for $what is not a subroutine reference"
154             unless ref $how eq 'CODE';
155         push @transforms, gen_std_filter_for($what,$how);
156     }
157     my $terminator = shift;
158
159     my $multitransform = sub {
160         foreach my $transform ( @transforms ) {
161             $transform->(@_);
162         }
163     };
164     no warnings 'redefine';
165     *{"${caller}::import"} =
166         gen_filter_import($caller,$multitransform,$terminator);
167     *{"${caller}::unimport"} = gen_filter_unimport($caller);
168 }
169
170 my $ows    = qr/(?:[ \t]+|#[^\n]*)*/;
171
172 sub gen_filter_import {
173     my ($class, $filter, $terminator) = @_;
174     my %terminator;
175     my $prev_import = *{$class."::import"}{CODE};
176     return sub {
177         my ($imported_class, @args) = @_;
178         my $def_terminator =
179             qr/^(?:\s*no\s+$imported_class\s*;$ows|__(?:END|DATA)__)\r?$/;
180         if (!defined $terminator) {
181             $terminator{terminator} = $def_terminator;
182         }
183         elsif (!ref $terminator || ref $terminator eq 'Regexp') {
184             $terminator{terminator} = $terminator;
185         }
186         elsif (ref $terminator ne 'HASH') {
187             croak "Terminator must be specified as scalar or hash ref"
188         }
189         elsif (!exists $terminator->{terminator}) {
190             $terminator{terminator} = $def_terminator;
191         }
192         filter_add(
193             sub {
194                 my ($status, $lastline);
195                 my $count = 0;
196                 my $data = "";
197                 while ($status = filter_read()) {
198                     return $status if $status < 0;
199                     if ($terminator{terminator} &&
200                         m/$terminator{terminator}/) {
201                         $lastline = $_;
202                         last;
203                     }
204                     $data .= $_;
205                     $count++;
206                     $_ = "";
207                 }
208                 return $count if not $count;
209                 $_ = $data;
210                 $filter->($imported_class, @args) unless $status < 0;
211                 if (defined $lastline) {
212                     if (defined $terminator{becomes}) {
213                         $_ .= $terminator{becomes};
214                     }
215                     elsif ($lastline =~ $def_terminator) {
216                         $_ .= $lastline;
217                     }
218                 }
219                 return $count;
220             }
221         );
222         if ($prev_import) {
223             goto &$prev_import;
224         }
225         elsif ($class->isa('Exporter')) {
226             $class->export_to_level(1,@_);
227         }
228     }
229 }
230
231 sub gen_filter_unimport {
232     my ($class) = @_;
233     return sub {
234         filter_del();
235         goto &$prev_unimport if $prev_unimport;
236     }
237 }
238
239 1;
240
241 __END__
242
243 =head1 NAME
244
245 Filter::Simple - Simplified source filtering
246
247 =head1 SYNOPSIS
248
249  # in MyFilter.pm:
250
251      package MyFilter;
252
253      use Filter::Simple;
254
255      FILTER { ... };
256
257      # or just:
258      #
259      # use Filter::Simple sub { ... };
260
261  # in user's code:
262
263      use MyFilter;
264
265      # this code is filtered
266
267      no MyFilter;
268
269      # this code is not
270
271
272 =head1 DESCRIPTION
273
274 =head2 The Problem
275
276 Source filtering is an immensely powerful feature of recent versions of Perl.
277 It allows one to extend the language itself (e.g. the Switch module), to 
278 simplify the language (e.g. Language::Pythonesque), or to completely recast the
279 language (e.g. Lingua::Romana::Perligata). Effectively, it allows one to use
280 the full power of Perl as its own, recursively applied, macro language.
281
282 The excellent Filter::Util::Call module (by Paul Marquess) provides a
283 usable Perl interface to source filtering, but it is often too powerful
284 and not nearly as simple as it could be.
285
286 To use the module it is necessary to do the following:
287
288 =over 4
289
290 =item 1.
291
292 Download, build, and install the Filter::Util::Call module.
293 (If you have Perl 5.7.1 or later, this is already done for you.)
294
295 =item 2.
296
297 Set up a module that does a C<use Filter::Util::Call>.
298
299 =item 3.
300
301 Within that module, create an C<import> subroutine.
302
303 =item 4.
304
305 Within the C<import> subroutine do a call to C<filter_add>, passing
306 it either a subroutine reference.
307
308 =item 5.
309
310 Within the subroutine reference, call C<filter_read> or C<filter_read_exact>
311 to "prime" $_ with source code data from the source file that will
312 C<use> your module. Check the status value returned to see if any
313 source code was actually read in.
314
315 =item 6.
316
317 Process the contents of $_ to change the source code in the desired manner.
318
319 =item 7.
320
321 Return the status value.
322
323 =item 8.
324
325 If the act of unimporting your module (via a C<no>) should cause source
326 code filtering to cease, create an C<unimport> subroutine, and have it call
327 C<filter_del>. Make sure that the call to C<filter_read> or
328 C<filter_read_exact> in step 5 will not accidentally read past the
329 C<no>. Effectively this limits source code filters to line-by-line
330 operation, unless the C<import> subroutine does some fancy
331 pre-pre-parsing of the source code it's filtering.
332
333 =back
334
335 For example, here is a minimal source code filter in a module named
336 BANG.pm. It simply converts every occurrence of the sequence C<BANG\s+BANG>
337 to the sequence C<die 'BANG' if $BANG> in any piece of code following a
338 C<use BANG;> statement (until the next C<no BANG;> statement, if any):
339
340     package BANG;
341
342     use Filter::Util::Call ;
343
344     sub import {
345         filter_add( sub {
346         my $caller = caller;
347         my ($status, $no_seen, $data);
348         while ($status = filter_read()) {
349             if (/^\s*no\s+$caller\s*;\s*?$/) {
350                 $no_seen=1;
351                 last;
352             }
353             $data .= $_;
354             $_ = "";
355         }
356         $_ = $data;
357         s/BANG\s+BANG/die 'BANG' if \$BANG/g
358             unless $status < 0;
359         $_ .= "no $class;\n" if $no_seen;
360         return 1;
361         })
362     }
363
364     sub unimport {
365         filter_del();
366     }
367
368     1 ;
369
370 This level of sophistication puts filtering out of the reach of
371 many programmers.
372
373
374 =head2 A Solution
375
376 The Filter::Simple module provides a simplified interface to
377 Filter::Util::Call; one that is sufficient for most common cases.
378
379 Instead of the above process, with Filter::Simple the task of setting up
380 a source code filter is reduced to:
381
382 =over 4
383
384 =item 1.
385
386 Download and install the Filter::Simple module.
387 (If you have Perl 5.7.1 or later, this is already done for you.)
388
389 =item 2.
390
391 Set up a module that does a C<use Filter::Simple> and then
392 calls C<FILTER { ... }>.
393
394 =item 3.
395
396 Within the anonymous subroutine or block that is passed to
397 C<FILTER>, process the contents of $_ to change the source code in
398 the desired manner.
399
400 =back
401
402 In other words, the previous example, would become:
403
404     package BANG;
405     use Filter::Simple;
406
407     FILTER {
408         s/BANG\s+BANG/die 'BANG' if \$BANG/g;
409     };
410
411     1 ;
412
413 Note that the source code is passed as a single string, so any regex that
414 uses C<^> or C<$> to detect line boundaries will need the C</m> flag.
415
416 =head2 Disabling or changing <no> behaviour
417
418 By default, the installed filter only filters up to a line consisting of one of
419 the three standard source "terminators":
420
421     no ModuleName;  # optional comment
422
423 or:
424
425     __END__
426
427 or:
428
429     __DATA__
430
431 but this can be altered by passing a second argument to C<use Filter::Simple>
432 or C<FILTER> (just remember: there's I<no> comma after the initial block when
433 you use C<FILTER>).
434
435 That second argument may be either a C<qr>'d regular expression (which is then
436 used to match the terminator line), or a defined false value (which indicates
437 that no terminator line should be looked for), or a reference to a hash
438 (in which case the terminator is the value associated with the key
439 C<'terminator'>.
440
441 For example, to cause the previous filter to filter only up to a line of the
442 form:
443
444     GNAB esu;
445
446 you would write:
447
448     package BANG;
449     use Filter::Simple;
450
451     FILTER {
452         s/BANG\s+BANG/die 'BANG' if \$BANG/g;
453     }
454     qr/^\s*GNAB\s+esu\s*;\s*?$/;
455
456 or:
457
458     FILTER {
459         s/BANG\s+BANG/die 'BANG' if \$BANG/g;
460     }
461     { terminator => qr/^\s*GNAB\s+esu\s*;\s*?$/ };
462
463 and to prevent the filter's being turned off in any way:
464
465     package BANG;
466     use Filter::Simple;
467
468     FILTER {
469         s/BANG\s+BANG/die 'BANG' if \$BANG/g;
470     }
471     "";    # or: 0
472
473 or:
474
475     FILTER {
476         s/BANG\s+BANG/die 'BANG' if \$BANG/g;
477     }
478     { terminator => "" };
479
480 B<Note that, no matter what you set the terminator pattern to,
481 the actual terminator itself I<must> be contained on a single source line.>
482
483
484 =head2 All-in-one interface
485
486 Separating the loading of Filter::Simple:
487
488     use Filter::Simple;
489
490 from the setting up of the filtering:
491
492     FILTER { ... };
493
494 is useful because it allows other code (typically parser support code
495 or caching variables) to be defined before the filter is invoked.
496 However, there is often no need for such a separation.
497
498 In those cases, it is easier to just append the filtering subroutine and
499 any terminator specification directly to the C<use> statement that loads
500 Filter::Simple, like so:
501
502     use Filter::Simple sub {
503         s/BANG\s+BANG/die 'BANG' if \$BANG/g;
504     };
505
506 This is exactly the same as:
507
508     use Filter::Simple;
509     BEGIN {
510         Filter::Simple::FILTER {
511             s/BANG\s+BANG/die 'BANG' if \$BANG/g;
512         };
513     }
514
515 except that the C<FILTER> subroutine is not exported by Filter::Simple.
516
517
518 =head2 Filtering only specific components of source code
519
520 One of the problems with a filter like:
521
522     use Filter::Simple;
523
524     FILTER { s/BANG\s+BANG/die 'BANG' if \$BANG/g };
525
526 is that it indiscriminately applies the specified transformation to
527 the entire text of your source program. So something like:
528
529     warn 'BANG BANG, YOU'RE DEAD';
530     BANG BANG;
531
532 will become:
533
534     warn 'die 'BANG' if $BANG, YOU'RE DEAD';
535     die 'BANG' if $BANG;
536
537 It is very common when filtering source to only want to apply the filter
538 to the non-character-string parts of the code, or alternatively to I<only>
539 the character strings.
540
541 Filter::Simple supports this type of filtering by automatically
542 exporting the C<FILTER_ONLY> subroutine.
543
544 C<FILTER_ONLY> takes a sequence of specifiers that install separate
545 (and possibly multiple) filters that act on only parts of the source code.
546 For example:
547
548     use Filter::Simple;
549
550     FILTER_ONLY
551         code      => sub { s/BANG\s+BANG/die 'BANG' if \$BANG/g },
552         quotelike => sub { s/BANG\s+BANG/CHITTY CHITTY/g };
553
554 The C<"code"> subroutine will only be used to filter parts of the source
555 code that are not quotelikes, POD, or C<__DATA__>. The C<quotelike>
556 subroutine only filters Perl quotelikes (including here documents).
557
558 The full list of alternatives is:
559
560 =over
561
562 =item C<"code">
563
564 Filters only those sections of the source code that are not quotelikes, POD, or
565 C<__DATA__>.
566
567 =item C<"code_no_comments">
568
569 Filters only those sections of the source code that are not quotelikes, POD,
570 comments, or C<__DATA__>.
571
572 =item C<"executable">
573
574 Filters only those sections of the source code that are not POD or C<__DATA__>.
575
576 =item C<"executable_no_comments">
577
578 Filters only those sections of the source code that are not POD, comments, or C<__DATA__>.
579
580 =item C<"quotelike">
581
582 Filters only Perl quotelikes (as interpreted by
583 C<&Text::Balanced::extract_quotelike>).
584
585 =item C<"string">
586
587 Filters only the string literal parts of a Perl quotelike (i.e. the 
588 contents of a string literal, either half of a C<tr///>, the second
589 half of an C<s///>).
590
591 =item C<"regex">
592
593 Filters only the pattern literal parts of a Perl quotelike (i.e. the 
594 contents of a C<qr//> or an C<m//>, the first half of an C<s///>).
595
596 =item C<"all">
597
598 Filters everything. Identical in effect to C<FILTER>.
599
600 =back
601
602 Except for C<< FILTER_ONLY code => sub {...} >>, each of
603 the component filters is called repeatedly, once for each component
604 found in the source code.
605
606 Note that you can also apply two or more of the same type of filter in
607 a single C<FILTER_ONLY>. For example, here's a simple 
608 macro-preprocessor that is only applied within regexes,
609 with a final debugging pass that prints the resulting source code:
610
611     use Regexp::Common;
612     FILTER_ONLY
613         regex => sub { s/!\[/[^/g },
614         regex => sub { s/%d/$RE{num}{int}/g },
615         regex => sub { s/%f/$RE{num}{real}/g },
616         all   => sub { print if $::DEBUG };
617
618
619
620 =head2 Filtering only the code parts of source code
621
622 Most source code ceases to be grammatically correct when it is broken up
623 into the pieces between string literals and regexes. So the C<'code'>
624 and C<'code_no_comments'> component filter behave slightly differently
625 from the other partial filters described in the previous section.
626
627 Rather than calling the specified processor on each individual piece of
628 code (i.e. on the bits between quotelikes), the C<'code...'> partial
629 filters operate on the entire source code, but with the quotelike bits
630 (and, in the case of C<'code_no_comments'>, the comments) "blanked out".
631
632 That is, a C<'code...'> filter I<replaces> each quoted string, quotelike,
633 regex, POD, and __DATA__ section with a placeholder. The
634 delimiters of this placeholder are the contents of the C<$;> variable
635 at the time the filter is applied (normally C<"\034">). The remaining
636 four bytes are a unique identifier for the component being replaced.
637
638 This approach makes it comparatively easy to write code preprocessors
639 without worrying about the form or contents of strings, regexes, etc.
640
641 For convenience, during a C<'code...'> filtering operation, Filter::Simple
642 provides a package variable (C<$Filter::Simple::placeholder>) that
643 contains a pre-compiled regex that matches any placeholder...and
644 captures the identifier within the placeholder. Placeholders can be
645 moved and re-ordered within the source code as needed.
646
647 In addition, a second package variable (C<@Filter::Simple::components>)
648 contains a list of the various pieces of C<$_>, as they were originally split
649 up to allow placeholders to be inserted.
650
651 Once the filtering has been applied, the original strings, regexes, POD,
652 etc. are re-inserted into the code, by replacing each placeholder with
653 the corresponding original component (from C<@components>). Note that
654 this means that the C<@components> variable must be treated with extreme
655 care within the filter. The C<@components> array stores the "back-
656 translations" of each placeholder inserted into C<$_>, as well as the
657 interstitial source code between placeholders. If the placeholder
658 backtranslations are altered in C<@components>, they will be similarly
659 changed when the placeholders are removed from C<$_> after the filter
660 is complete.
661
662 For example, the following filter detects concatenated pairs of
663 strings/quotelikes and reverses the order in which they are
664 concatenated:
665
666     package DemoRevCat;
667     use Filter::Simple;
668
669     FILTER_ONLY code => sub {
670         my $ph = $Filter::Simple::placeholder;
671         s{ ($ph) \s* [.] \s* ($ph) }{ $2.$1 }gx
672     };
673
674 Thus, the following code:
675
676     use DemoRevCat;
677
678     my $str = "abc" . q(def);
679
680     print "$str\n";
681
682 would become:
683
684     my $str = q(def)."abc";
685
686     print "$str\n";
687
688 and hence print:
689
690     defabc
691
692
693 =head2 Using Filter::Simple with an explicit C<import> subroutine
694
695 Filter::Simple generates a special C<import> subroutine for
696 your module (see L<"How it works">) which would normally replace any
697 C<import> subroutine you might have explicitly declared.
698
699 However, Filter::Simple is smart enough to notice your existing
700 C<import> and Do The Right Thing with it.
701 That is, if you explicitly define an C<import> subroutine in a package
702 that's using Filter::Simple, that C<import> subroutine will still
703 be invoked immediately after any filter you install.
704
705 The only thing you have to remember is that the C<import> subroutine
706 I<must> be declared I<before> the filter is installed. If you use C<FILTER>
707 to install the filter:
708
709     package Filter::TurnItUpTo11;
710
711     use Filter::Simple;
712
713     FILTER { s/(\w+)/\U$1/ };
714
715 that will almost never be a problem, but if you install a filtering
716 subroutine by passing it directly to the C<use Filter::Simple>
717 statement:
718
719     package Filter::TurnItUpTo11;
720
721     use Filter::Simple sub{ s/(\w+)/\U$1/ };
722
723 then you must make sure that your C<import> subroutine appears before
724 that C<use> statement.
725
726
727 =head2 Using Filter::Simple and Exporter together
728
729 Likewise, Filter::Simple is also smart enough
730 to Do The Right Thing if you use Exporter:
731
732     package Switch;
733     use base Exporter;
734     use Filter::Simple;
735
736     @EXPORT    = qw(switch case);
737     @EXPORT_OK = qw(given  when);
738
739     FILTER { $_ = magic_Perl_filter($_) }
740
741 Immediately after the filter has been applied to the source,
742 Filter::Simple will pass control to Exporter, so it can do its magic too.
743
744 Of course, here too, Filter::Simple has to know you're using Exporter
745 before it applies the filter. That's almost never a problem, but if you're
746 nervous about it, you can guarantee that things will work correctly by
747 ensuring that your C<use base Exporter> always precedes your
748 C<use Filter::Simple>.
749
750
751 =head2 How it works
752
753 The Filter::Simple module exports into the package that calls C<FILTER>
754 (or C<use>s it directly) -- such as package "BANG" in the above example --
755 two automagically constructed
756 subroutines -- C<import> and C<unimport> -- which take care of all the
757 nasty details.
758
759 In addition, the generated C<import> subroutine passes its own argument
760 list to the filtering subroutine, so the BANG.pm filter could easily 
761 be made parametric:
762
763     package BANG;
764
765     use Filter::Simple;
766
767     FILTER {
768         my ($die_msg, $var_name) = @_;
769         s/BANG\s+BANG/die '$die_msg' if \${$var_name}/g;
770     };
771
772     # and in some user code:
773
774     use BANG "BOOM", "BAM";  # "BANG BANG" becomes: die 'BOOM' if $BAM
775
776
777 The specified filtering subroutine is called every time a C<use BANG> is
778 encountered, and passed all the source code following that call, up to
779 either the next C<no BANG;> (or whatever terminator you've set) or the
780 end of the source file, whichever occurs first. By default, any C<no
781 BANG;> call must appear by itself on a separate line, or it is ignored.
782
783
784 =head1 AUTHOR
785
786 Damian Conway
787
788 =head1 CONTACT
789
790 Filter::Simple is now maintained by the Perl5-Porters.
791 Please submit bug via the C<perlbug> tool that comes with your perl.
792 For usage instructions, read C<perldoc perlbug> or possibly C<man perlbug>.
793 For mostly anything else, please contact E<lt>perl5-porters@perl.orgE<gt>.
794
795 Maintainer of the CPAN release is Steffen Mueller E<lt>smueller@cpan.orgE<gt>.
796 Contact him with technical difficulties with respect to the packaging of the
797 CPAN module.
798
799 Praise of the module, flowers, and presents still go to the author,
800 Damian Conway E<lt>damian@conway.orgE<gt>.
801
802 =head1 COPYRIGHT AND LICENSE
803
804     Copyright (c) 2000-2014, Damian Conway. All Rights Reserved.
805     This module is free software. It may be used, redistributed
806     and/or modified under the same terms as Perl itself.