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 (If you have Perl 5.7.1 or later you already have Filter::Util::Call.)
 114
 115 =item 2.
 116
 117 Set up a module that does a C<use Filter::Util::Call>.
 118
 119 =item 3.
 120
 121 Within that module, create an C<import> subroutine.
 122
 123 =item 4.
 124
 125 Within the C<import> subroutine do a call to C<filter_add>, passing
 126 it either a subroutine reference.
 127
 128 =item 5.
 129
 130 Within the subroutine reference, call C<filter_read> or C<filter_read_exact>
 131 to "prime" $_ with source code data from the source file that will
 132 C<use> your module. Check the status value returned to see if any
 133 source code was actually read in.
 134
 135 =item 6.
 136
 137 Process the contents of $_ to change the source code in the desired manner.
 138
 139 =item 7.
 140
 141 Return the status value.
 142
 143 =item 8.
 144
 145 If the act of unimporting your module (via a C<no>) should cause source
 146 code filtering to cease, create an C<unimport> subroutine, and have it call
 147 C<filter_del>. Make sure that the call to C<filter_read> or
 148 C<filter_read_exact> in step 5 will not accidentally read past the
 149 C<no>. Effectively this limits source code filters to line-by-line
 150 operation, unless the C<import> subroutine does some fancy
 151 pre-pre-parsing of the source code it's filtering.
 152
 153 =back
 154
 155 For example, here is a minimal source code filter in a module named
 156 BANG.pm. It simply converts every occurrence of the sequence C<BANG\s+BANG>
 157 to the sequence C<die 'BANG' if $BANG> in any piece of code following a
 158 C<use BANG;> statement (until the next C<no BANG;> statement, if any):
 159
 160         package BANG;
 161
 162         use Filter::Util::Call ;
 163
 164         sub import {
 165             filter_add( sub {
 166                 my $caller = caller;
 167                 my ($status, $no_seen, $data);
 168                 while ($status = filter_read()) {
 169                         if (/^\s*no\s+$caller\s*;\s*?$/) {
 170                                 $no_seen=1;
 171                                 last;
 172                         }
 173                         $data .= $_;
 174                         $_ = "";
 175                 }
 176                 $_ = $data;
 177                 s/BANG\s+BANG/die 'BANG' if \$BANG/g
 178                         unless $status < 0;
 179                 $_ .= "no $class;\n" if $no_seen;
 180                 return 1;
 181             })
 182         }
 183
 184         sub unimport {
 185             filter_del();
 186         }
 187
 188         1 ;
 189
 190 This level of sophistication puts filtering out of the reach of
 191 many programmers.
 192
 193
 194 =head2 A Solution
 195
 196 The Filter::Simple module provides a simplified interface to
 197 Filter::Util::Call; one that is sufficient for most common cases.
 198
 199 Instead of the above process, with Filter::Simple the task of setting up
 200 a source code filter is reduced to:
 201
 202 =over 4
 203
 204 =item 1.
 205
 206 Set up a module that does a C<use Filter::Simple> and then
 207 calls C<FILTER { ... }>.
 208
 209 =item 2.
 210
 211 Within the anonymous subroutine or block that is passed to
 212 C<FILTER>, process the contents of $_ to change the source code in
 213 the desired manner.
 214
 215 =back
 216
 217 In other words, the previous example, would become:
 218
 219         package BANG;
 220         use Filter::Simple;
 221
 222         FILTER {
 223             s/BANG\s+BANG/die 'BANG' if \$BANG/g;
 224         };
 225
 226         1 ;
 227
 228
 229 =head2 Disabling or changing <no> behaviour
 230
 231 By default, the installed filter only filters to a line of the form:
 232
 233         no ModuleName;
 234
 235 but this can be altered by passing a second argument to C<use Filter::Simple>.
 236
 237 That second argument may be either a C<qr>'d regular expression (which is then
 238 used to match the terminator line), or a defined false value (which indicates
 239 that no terminator line should be looked for).
 240
 241 For example, to cause the previous filter to filter only up to a line of the
 242 form:
 243
 244         GNAB esu;
 245
 246 you would write:
 247
 248         package BANG;
 249         use Filter::Simple;
 250
 251         FILTER {
 252                 s/BANG\s+BANG/die 'BANG' if \$BANG/g;
 253         }
 254         => qr/^\s*GNAB\s+esu\s*;\s*?$/;
 255
 256 and to prevent the filter's being turned off in any way:
 257
 258         package BANG;
 259         use Filter::Simple;
 260
 261         FILTER {
 262                 s/BANG\s+BANG/die 'BANG' if \$BANG/g;
 263         }
 264               => "";
 265         # or: => 0;
 266
 267
 268 =head2 All-in-one interface
 269
 270 Separating the loading of Filter::Simple:
 271
 272         use Filter::Simple;
 273
 274 from the setting up of the filtering:
 275
 276         FILTER { ... };
 277
 278 is useful because it allows other code (typically parser support code
 279 or caching variables) to be defined before the filter is invoked.
 280 However, there is often no need for such a separation.
 281
 282 In those cases, it is easier to just append the filtering subroutine and
 283 any terminator specification directly to the C<use> statement that loads
 284 Filter::Simple, like so:
 285
 286         use Filter::Simple sub {
 287                 s/BANG\s+BANG/die 'BANG' if \$BANG/g;
 288         };
 289
 290 This is exactly the same as:
 291
 292         use Filter::Simple;
 293         BEGIN {
 294                 Filter::Simple::FILTER {
 295                         s/BANG\s+BANG/die 'BANG' if \$BANG/g;
 296                 };
 297         }
 298
 299 except that the C<FILTER> subroutine is not exported by Filter::Simple.
 300
 301
 302 =head2 How it works
 303
 304 The Filter::Simple module exports into the package that calls C<FILTER>
 305 (or C<use>s it directly) -- such as package "BANG" in the above example --
 306 two automagically constructed
 307 subroutines -- C<import> and C<unimport> -- which take care of all the
 308 nasty details.
 309
 310 In addition, the generated C<import> subroutine passes its own argument
 311 list to the filtering subroutine, so the BANG.pm filter could easily
 312 be made parametric:
 313
 314         package BANG;
 315
 316         use Filter::Simple;
 317
 318         FILTER {
 319             my ($die_msg, $var_name) = @_;
 320             s/BANG\s+BANG/die '$die_msg' if \${$var_name}/g;
 321         };
 322
 323         # and in some user code:
 324
 325         use BANG "BOOM", "BAM";  # "BANG BANG" becomes: die 'BOOM' if $BAM
 326
 327
 328 The specified filtering subroutine is called every time a C<use BANG> is
 329 encountered, and passed all the source code following that call, up to
 330 either the next C<no BANG;> (or whatever terminator you've set) or the
 331 end of the source file, whichever occurs first. By default, any C<no
 332 BANG;> call must appear by itself on a separate line, or it is ignored.
 333
 334
 335 =head1 AUTHOR
 336
 337 Damian Conway (damian@conway.org)
 338
 339 =head1 COPYRIGHT
 340
 341  Copyright (c) 2000, Damian Conway. All Rights Reserved.
 342  This module is free software. It may be used, redistributed
 343 and/or modified under the terms of the Perl Artistic License
 344      (see http://www.perl.com/perl/misc/Artistic.html)