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