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