lib/Filter/Simple.pm

   1 package Filter::Simple;
   2
   3 use vars qw{ $VERSION };
   4
   5 $VERSION = '0.60';
   6
   7 use Filter::Util::Call;
   8 use Carp;
   9
  10 sub import {
  11         if (@_>1) { shift; goto &FILTER }
  12         else      { *{caller()."::FILTER"} = \&FILTER }
  13 }
  14
  15 sub FILTER (&;$) {
  16         my $caller = caller;
  17         my ($filter, $terminator) = @_;
  18         croak "Usage: use Filter::Simple sub {...}, $terminator_opt;"
  19                 unless ref $filter eq CODE;
  20         *{"${caller}::import"} = gen_filter_import($caller,$filter,$terminator);
  21         *{"${caller}::unimport"} = \*filter_unimport;
  22 }
  23
  24 sub gen_filter_import {
  25     my ($class, $filter, $terminator) = @_;
  26     return sub {
  27         my ($imported_class, @args) = @_;
  28         $terminator = qr/^\s*no\s+$imported_class\s*;\s*$/
  29                 unless defined $terminator;
  30         filter_add(
  31                 sub {
  32                         my ($status, $off);
  33                         my $count = 0;
  34                         my $data = "";
  35                         while ($status = filter_read()) {
  36                                 return $status if $status < 0;
  37                                 if ($terminator && m/$terminator/) {
  38                                         $off=1;
  39                                         last;
  40                                 }
  41                                 $data .= $_;
  42                                 $count++;
  43                                 $_ = "";
  44                         }
  45                         $_ = $data;
  46                         $filter->(@args) unless $status < 0;
  47                         $_ .= "no $imported_class;\n" if $off;
  48                         return $count;
  49                 }
  50         );
  51     }
  52 }
  53
  54 sub filter_unimport {
  55         filter_del();
  56 }
  57
  58 1;
  59
  60 __END__
  61
  62 =head1 NAME
  63
  64 Filter::Simple - Simplified source filtering
  65
  66
  67 =head1 SYNOPSIS
  68
  69  # in MyFilter.pm:
  70
  71          package MyFilter;
  72
  73          use Filter::Simple;
  74
  75          FILTER { ... };
  76
  77          # or just:
  78          #
  79          # use Filter::Simple sub { ... };
  80
  81  # in user's code:
  82
  83          use MyFilter;
  84
  85          # this code is filtered
  86
  87          no MyFilter;
  88
  89          # this code is not
  90
  91
  92 =head1 DESCRIPTION
  93
  94 =head2 The Problem
  95
  96 Source filtering is an immensely powerful feature of recent versions of Perl.
  97 It allows one to extend the language itself (e.g. the Switch module), to
  98 simplify the language (e.g. Language::Pythonesque), or to completely recast the
  99 language (e.g. Lingua::Romana::Perligata). Effectively, it allows one to use
 100 the full power of Perl as its own, recursively applied, macro language.
 101
 102 The excellent Filter::Util::Call module (by Paul Marquess) provides a
 103 usable Perl interface to source filtering, but it is often too powerful
 104 and not nearly as simple as it could be.
 105
 106 To use the module it is necessary to do the following:
 107
 108 =over 4
 109
 110 =item 1.
 111
 112 Download, build, and install the Filter::Util::Call module.
 113
 114 =item 2.
 115
 116 Set up a module that does a C<use Filter::Util::Call>.
 117
 118 =item 3.
 119
 120 Within that module, create an C<import> subroutine.
 121
 122 =item 4.
 123
 124 Within the C<import> subroutine do a call to C<filter_add>, passing
 125 it either a subroutine reference.
 126
 127 =item 5.
 128
 129 Within the subroutine reference, call C<filter_read> or C<filter_read_exact>
 130 to "prime" $_ with source code data from the source file that will
 131 C<use> your module. Check the status value returned to see if any
 132 source code was actually read in.
 133
 134 =item 6.
 135
 136 Process the contents of $_ to change the source code in the desired manner.
 137
 138 =item 7.
 139
 140 Return the status value.
 141
 142 =item 8.
 143
 144 If the act of unimporting your module (via a C<no>) should cause source
 145 code filtering to cease, create an C<unimport> subroutine, and have it call
 146 C<filter_del>. Make sure that the call to C<filter_read> or
 147 C<filter_read_exact> in step 5 will not accidentally read past the
 148 C<no>. Effectively this limits source code filters to line-by-line
 149 operation, unless the C<import> subroutine does some fancy
 150 pre-pre-parsing of the source code it's filtering.
 151
 152 =back
 153
 154 For example, here is a minimal source code filter in a module named
 155 BANG.pm. It simply converts every occurrence of the sequence C<BANG\s+BANG>
 156 to the sequence C<die 'BANG' if $BANG> in any piece of code following a
 157 C<use BANG;> statement (until the next C<no BANG;> statement, if any):
 158
 159         package BANG;
 160
 161         use Filter::Util::Call ;
 162
 163         sub import {
 164             filter_add( sub {
 165                 my $caller = caller;
 166                 my ($status, $no_seen, $data);
 167                 while ($status = filter_read()) {
 168                         if (/^\s*no\s+$caller\s*;\s*?$/) {
 169                                 $no_seen=1;
 170                                 last;
 171                         }
 172                         $data .= $_;
 173                         $_ = "";
 174                 }
 175                 $_ = $data;
 176                 s/BANG\s+BANG/die 'BANG' if \$BANG/g
 177                         unless $status < 0;
 178                 $_ .= "no $class;\n" if $no_seen;
 179                 return 1;
 180             })
 181         }
 182
 183         sub unimport {
 184             filter_del();
 185         }
 186
 187         1 ;
 188
 189 This level of sophistication puts filtering out of the reach of
 190 many programmers.
 191
 192
 193 =head2 A Solution
 194
 195 The Filter::Simple module provides a simplified interface to
 196 Filter::Util::Call; one that is sufficient for most common cases.
 197
 198 Instead of the above process, with Filter::Simple the task of setting up
 199 a source code filter is reduced to:
 200
 201 =over 4
 202
 203 =item 1.
 204
 205 Set up a module that does a C<use Filter::Simple> and then
 206 calls C<FILTER { ... }>.
 207
 208 =item 2.
 209
 210 Within the anonymous subroutine or block that is passed to
 211 C<FILTER>, process the contents of $_ to change the source code in
 212 the desired manner.
 213
 214 =back
 215
 216 In other words, the previous example, would become:
 217
 218         package BANG;
 219         use Filter::Simple;
 220
 221         FILTER {
 222             s/BANG\s+BANG/die 'BANG' if \$BANG/g;
 223         };
 224
 225         1 ;
 226
 227
 228 =head2 Disabling or changing <no> behaviour
 229
 230 By default, the installed filter only filters to a line of the form:
 231
 232         no ModuleName;
 233
 234 but this can be altered by passing a second argument to C<use Filter::Simple>.
 235
 236 That second argument may be either a C<qr>'d regular expression (which is then
 237 used to match the terminator line), or a defined false value (which indicates
 238 that no terminator line should be looked for).
 239
 240 For example, to cause the previous filter to filter only up to a line of the
 241 form:
 242
 243         GNAB esu;
 244
 245 you would write:
 246
 247         package BANG;
 248         use Filter::Simple;
 249
 250         FILTER {
 251                 s/BANG\s+BANG/die 'BANG' if \$BANG/g;
 252         }
 253         => qr/^\s*GNAB\s+esu\s*;\s*?$/;
 254
 255 and to prevent the filter's being turned off in any way:
 256
 257         package BANG;
 258         use Filter::Simple;
 259
 260         FILTER {
 261                 s/BANG\s+BANG/die 'BANG' if \$BANG/g;
 262         }
 263               => "";
 264         # or: => 0;
 265
 266
 267 =head2 All-in-one interface
 268
 269 Separating the loading of Filter::Simple:
 270
 271         use Filter::Simple;
 272
 273 from the setting up of the filtering:
 274
 275         FILTER { ... };
 276
 277 is useful because it allows other code (typically parser support code
 278 or caching variables) to be defined before the filter is invoked.
 279 However, there is often no need for such a separation.
 280
 281 In those cases, it is easier to just append the filtering subroutine and
 282 any terminator specification directly to the C<use> statement that loads
 283 Filter::Simple, like so:
 284
 285         use Filter::Simple sub {
 286                 s/BANG\s+BANG/die 'BANG' if \$BANG/g;
 287         };
 288
 289 This is exactly the same as:
 290
 291         use Filter::Simple;
 292         BEGIN {
 293                 Filter::Simple::FILTER {
 294                         s/BANG\s+BANG/die 'BANG' if \$BANG/g;
 295                 };
 296         }
 297
 298 except that the C<FILTER> subroutine is not exported by Filter::Simple.
 299
 300
 301 =head2 How it works
 302
 303 The Filter::Simple module exports into the package that calls C<FILTER>
 304 (or C<use>s it directly) -- such as package "BANG" in the above example --
 305 two automagically constructed
 306 subroutines -- C<import> and C<unimport> -- which take care of all the
 307 nasty details.
 308
 309 In addition, the generated C<import> subroutine passes its own argument
 310 list to the filtering subroutine, so the BANG.pm filter could easily
 311 be made parametric:
 312
 313         package BANG;
 314
 315         use Filter::Simple;
 316
 317         FILTER {
 318             my ($die_msg, $var_name) = @_;
 319             s/BANG\s+BANG/die '$die_msg' if \${$var_name}/g;
 320         };
 321
 322         # and in some user code:
 323
 324         use BANG "BOOM", "BAM";  # "BANG BANG" becomes: die 'BOOM' if $BAM
 325
 326
 327 The specified filtering subroutine is called every time a C<use BANG> is
 328 encountered, and passed all the source code following that call, up to
 329 either the next C<no BANG;> (or whatever terminator you've set) or the
 330 end of the source file, whichever occurs first. By default, any C<no
 331 BANG;> call must appear by itself on a separate line, or it is ignored.
 332
 333
 334 =head1 AUTHOR
 335
 336 Damian Conway (damian@conway.org)
 337
 338 =head1 COPYRIGHT
 339
 340  Copyright (c) 2000, Damian Conway. All Rights Reserved.
 341  This module is free software. It may be used, redistributed
 342 and/or modified under the terms of the Perl Artistic License
 343      (see http://www.perl.com/perl/misc/Artistic.html)