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