lib/Filter/Simple.pm

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