[14489] | 1 |
|
---|
| 2 | # Call.pm
|
---|
| 3 | #
|
---|
| 4 | # Copyright (c) 1995-2001 Paul Marquess. All rights reserved.
|
---|
| 5 | #
|
---|
| 6 | # This program is free software; you can redistribute it and/or
|
---|
| 7 | # modify it under the same terms as Perl itself.
|
---|
| 8 |
|
---|
| 9 | package Filter::Util::Call ;
|
---|
| 10 |
|
---|
| 11 | require 5.002 ;
|
---|
| 12 | require DynaLoader;
|
---|
| 13 | require Exporter;
|
---|
| 14 | use Carp ;
|
---|
| 15 | use strict;
|
---|
| 16 | use warnings;
|
---|
| 17 | use vars qw($VERSION @ISA @EXPORT) ;
|
---|
| 18 |
|
---|
| 19 | @ISA = qw(Exporter DynaLoader);
|
---|
| 20 | @EXPORT = qw( filter_add filter_del filter_read filter_read_exact) ;
|
---|
| 21 | $VERSION = "1.0601" ;
|
---|
| 22 |
|
---|
| 23 | sub filter_read_exact($)
|
---|
| 24 | {
|
---|
| 25 | my ($size) = @_ ;
|
---|
| 26 | my ($left) = $size ;
|
---|
| 27 | my ($status) ;
|
---|
| 28 |
|
---|
| 29 | croak ("filter_read_exact: size parameter must be > 0")
|
---|
| 30 | unless $size > 0 ;
|
---|
| 31 |
|
---|
| 32 | # try to read a block which is exactly $size bytes long
|
---|
| 33 | while ($left and ($status = filter_read($left)) > 0) {
|
---|
| 34 | $left = $size - length $_ ;
|
---|
| 35 | }
|
---|
| 36 |
|
---|
| 37 | # EOF with pending data is a special case
|
---|
| 38 | return 1 if $status == 0 and length $_ ;
|
---|
| 39 |
|
---|
| 40 | return $status ;
|
---|
| 41 | }
|
---|
| 42 |
|
---|
| 43 | sub filter_add($)
|
---|
| 44 | {
|
---|
| 45 | my($obj) = @_ ;
|
---|
| 46 |
|
---|
| 47 | # Did we get a code reference?
|
---|
| 48 | my $coderef = (ref $obj eq 'CODE') ;
|
---|
| 49 |
|
---|
| 50 | # If the parameter isn't already a reference, make it one.
|
---|
| 51 | $obj = \$obj unless ref $obj ;
|
---|
| 52 |
|
---|
| 53 | $obj = bless ($obj, (caller)[0]) unless $coderef ;
|
---|
| 54 |
|
---|
| 55 | # finish off the installation of the filter in C.
|
---|
| 56 | Filter::Util::Call::real_import($obj, (caller)[0], $coderef) ;
|
---|
| 57 | }
|
---|
| 58 |
|
---|
| 59 | bootstrap Filter::Util::Call ;
|
---|
| 60 |
|
---|
| 61 | 1;
|
---|
| 62 | __END__
|
---|
| 63 |
|
---|
| 64 | =head1 NAME
|
---|
| 65 |
|
---|
| 66 | Filter::Util::Call - Perl Source Filter Utility Module
|
---|
| 67 |
|
---|
| 68 | =head1 SYNOPSIS
|
---|
| 69 |
|
---|
| 70 | use Filter::Util::Call ;
|
---|
| 71 |
|
---|
| 72 | =head1 DESCRIPTION
|
---|
| 73 |
|
---|
| 74 | This module provides you with the framework to write I<Source Filters>
|
---|
| 75 | in Perl.
|
---|
| 76 |
|
---|
| 77 | An alternate interface to Filter::Util::Call is now available. See
|
---|
| 78 | L<Filter::Simple> for more details.
|
---|
| 79 |
|
---|
| 80 | A I<Perl Source Filter> is implemented as a Perl module. The structure
|
---|
| 81 | of the module can take one of two broadly similar formats. To
|
---|
| 82 | distinguish between them, the first will be referred to as I<method
|
---|
| 83 | filter> and the second as I<closure filter>.
|
---|
| 84 |
|
---|
| 85 | Here is a skeleton for the I<method filter>:
|
---|
| 86 |
|
---|
| 87 | package MyFilter ;
|
---|
| 88 |
|
---|
| 89 | use Filter::Util::Call ;
|
---|
| 90 |
|
---|
| 91 | sub import
|
---|
| 92 | {
|
---|
| 93 | my($type, @arguments) = @_ ;
|
---|
| 94 | filter_add([]) ;
|
---|
| 95 | }
|
---|
| 96 |
|
---|
| 97 | sub filter
|
---|
| 98 | {
|
---|
| 99 | my($self) = @_ ;
|
---|
| 100 | my($status) ;
|
---|
| 101 |
|
---|
| 102 | $status = filter_read() ;
|
---|
| 103 | $status ;
|
---|
| 104 | }
|
---|
| 105 |
|
---|
| 106 | 1 ;
|
---|
| 107 |
|
---|
| 108 | and this is the equivalent skeleton for the I<closure filter>:
|
---|
| 109 |
|
---|
| 110 | package MyFilter ;
|
---|
| 111 |
|
---|
| 112 | use Filter::Util::Call ;
|
---|
| 113 |
|
---|
| 114 | sub import
|
---|
| 115 | {
|
---|
| 116 | my($type, @arguments) = @_ ;
|
---|
| 117 |
|
---|
| 118 | filter_add(
|
---|
| 119 | sub
|
---|
| 120 | {
|
---|
| 121 | my($status) ;
|
---|
| 122 | $status = filter_read() ;
|
---|
| 123 | $status ;
|
---|
| 124 | } )
|
---|
| 125 | }
|
---|
| 126 |
|
---|
| 127 | 1 ;
|
---|
| 128 |
|
---|
| 129 | To make use of either of the two filter modules above, place the line
|
---|
| 130 | below in a Perl source file.
|
---|
| 131 |
|
---|
| 132 | use MyFilter;
|
---|
| 133 |
|
---|
| 134 | In fact, the skeleton modules shown above are fully functional I<Source
|
---|
| 135 | Filters>, albeit fairly useless ones. All they does is filter the
|
---|
| 136 | source stream without modifying it at all.
|
---|
| 137 |
|
---|
| 138 | As you can see both modules have a broadly similar structure. They both
|
---|
| 139 | make use of the C<Filter::Util::Call> module and both have an C<import>
|
---|
| 140 | method. The difference between them is that the I<method filter>
|
---|
| 141 | requires a I<filter> method, whereas the I<closure filter> gets the
|
---|
| 142 | equivalent of a I<filter> method with the anonymous sub passed to
|
---|
| 143 | I<filter_add>.
|
---|
| 144 |
|
---|
| 145 | To make proper use of the I<closure filter> shown above you need to
|
---|
| 146 | have a good understanding of the concept of a I<closure>. See
|
---|
| 147 | L<perlref> for more details on the mechanics of I<closures>.
|
---|
| 148 |
|
---|
| 149 | =head2 B<use Filter::Util::Call>
|
---|
| 150 |
|
---|
| 151 | The following functions are exported by C<Filter::Util::Call>:
|
---|
| 152 |
|
---|
| 153 | filter_add()
|
---|
| 154 | filter_read()
|
---|
| 155 | filter_read_exact()
|
---|
| 156 | filter_del()
|
---|
| 157 |
|
---|
| 158 | =head2 B<import()>
|
---|
| 159 |
|
---|
| 160 | The C<import> method is used to create an instance of the filter. It is
|
---|
| 161 | called indirectly by Perl when it encounters the C<use MyFilter> line
|
---|
| 162 | in a source file (See L<perlfunc/import> for more details on
|
---|
| 163 | C<import>).
|
---|
| 164 |
|
---|
| 165 | It will always have at least one parameter automatically passed by Perl
|
---|
| 166 | - this corresponds to the name of the package. In the example above it
|
---|
| 167 | will be C<"MyFilter">.
|
---|
| 168 |
|
---|
| 169 | Apart from the first parameter, import can accept an optional list of
|
---|
| 170 | parameters. These can be used to pass parameters to the filter. For
|
---|
| 171 | example:
|
---|
| 172 |
|
---|
| 173 | use MyFilter qw(a b c) ;
|
---|
| 174 |
|
---|
| 175 | will result in the C<@_> array having the following values:
|
---|
| 176 |
|
---|
| 177 | @_ [0] => "MyFilter"
|
---|
| 178 | @_ [1] => "a"
|
---|
| 179 | @_ [2] => "b"
|
---|
| 180 | @_ [3] => "c"
|
---|
| 181 |
|
---|
| 182 | Before terminating, the C<import> function must explicitly install the
|
---|
| 183 | filter by calling C<filter_add>.
|
---|
| 184 |
|
---|
| 185 | B<filter_add()>
|
---|
| 186 |
|
---|
| 187 | The function, C<filter_add>, actually installs the filter. It takes one
|
---|
| 188 | parameter which should be a reference. The kind of reference used will
|
---|
| 189 | dictate which of the two filter types will be used.
|
---|
| 190 |
|
---|
| 191 | If a CODE reference is used then a I<closure filter> will be assumed.
|
---|
| 192 |
|
---|
| 193 | If a CODE reference is not used, a I<method filter> will be assumed.
|
---|
| 194 | In a I<method filter>, the reference can be used to store context
|
---|
| 195 | information. The reference will be I<blessed> into the package by
|
---|
| 196 | C<filter_add>.
|
---|
| 197 |
|
---|
| 198 | See the filters at the end of this documents for examples of using
|
---|
| 199 | context information using both I<method filters> and I<closure
|
---|
| 200 | filters>.
|
---|
| 201 |
|
---|
| 202 | =head2 B<filter() and anonymous sub>
|
---|
| 203 |
|
---|
| 204 | Both the C<filter> method used with a I<method filter> and the
|
---|
| 205 | anonymous sub used with a I<closure filter> is where the main
|
---|
| 206 | processing for the filter is done.
|
---|
| 207 |
|
---|
| 208 | The big difference between the two types of filter is that the I<method
|
---|
| 209 | filter> uses the object passed to the method to store any context data,
|
---|
| 210 | whereas the I<closure filter> uses the lexical variables that are
|
---|
| 211 | maintained by the closure.
|
---|
| 212 |
|
---|
| 213 | Note that the single parameter passed to the I<method filter>,
|
---|
| 214 | C<$self>, is the same reference that was passed to C<filter_add>
|
---|
| 215 | blessed into the filter's package. See the example filters later on for
|
---|
| 216 | details of using C<$self>.
|
---|
| 217 |
|
---|
| 218 | Here is a list of the common features of the anonymous sub and the
|
---|
| 219 | C<filter()> method.
|
---|
| 220 |
|
---|
| 221 | =over 5
|
---|
| 222 |
|
---|
| 223 | =item B<$_>
|
---|
| 224 |
|
---|
| 225 | Although C<$_> doesn't actually appear explicitly in the sample filters
|
---|
| 226 | above, it is implicitly used in a number of places.
|
---|
| 227 |
|
---|
| 228 | Firstly, when either C<filter> or the anonymous sub are called, a local
|
---|
| 229 | copy of C<$_> will automatically be created. It will always contain the
|
---|
| 230 | empty string at this point.
|
---|
| 231 |
|
---|
| 232 | Next, both C<filter_read> and C<filter_read_exact> will append any
|
---|
| 233 | source data that is read to the end of C<$_>.
|
---|
| 234 |
|
---|
| 235 | Finally, when C<filter> or the anonymous sub are finished processing,
|
---|
| 236 | they are expected to return the filtered source using C<$_>.
|
---|
| 237 |
|
---|
| 238 | This implicit use of C<$_> greatly simplifies the filter.
|
---|
| 239 |
|
---|
| 240 | =item B<$status>
|
---|
| 241 |
|
---|
| 242 | The status value that is returned by the user's C<filter> method or
|
---|
| 243 | anonymous sub and the C<filter_read> and C<read_exact> functions take
|
---|
| 244 | the same set of values, namely:
|
---|
| 245 |
|
---|
| 246 | < 0 Error
|
---|
| 247 | = 0 EOF
|
---|
| 248 | > 0 OK
|
---|
| 249 |
|
---|
| 250 | =item B<filter_read> and B<filter_read_exact>
|
---|
| 251 |
|
---|
| 252 | These functions are used by the filter to obtain either a line or block
|
---|
| 253 | from the next filter in the chain or the actual source file if there
|
---|
| 254 | aren't any other filters.
|
---|
| 255 |
|
---|
| 256 | The function C<filter_read> takes two forms:
|
---|
| 257 |
|
---|
| 258 | $status = filter_read() ;
|
---|
| 259 | $status = filter_read($size) ;
|
---|
| 260 |
|
---|
| 261 | The first form is used to request a I<line>, the second requests a
|
---|
| 262 | I<block>.
|
---|
| 263 |
|
---|
| 264 | In line mode, C<filter_read> will append the next source line to the
|
---|
| 265 | end of the C<$_> scalar.
|
---|
| 266 |
|
---|
| 267 | In block mode, C<filter_read> will append a block of data which is <=
|
---|
| 268 | C<$size> to the end of the C<$_> scalar. It is important to emphasise
|
---|
| 269 | the that C<filter_read> will not necessarily read a block which is
|
---|
| 270 | I<precisely> C<$size> bytes.
|
---|
| 271 |
|
---|
| 272 | If you need to be able to read a block which has an exact size, you can
|
---|
| 273 | use the function C<filter_read_exact>. It works identically to
|
---|
| 274 | C<filter_read> in block mode, except it will try to read a block which
|
---|
| 275 | is exactly C<$size> bytes in length. The only circumstances when it
|
---|
| 276 | will not return a block which is C<$size> bytes long is on EOF or
|
---|
| 277 | error.
|
---|
| 278 |
|
---|
| 279 | It is I<very> important to check the value of C<$status> after I<every>
|
---|
| 280 | call to C<filter_read> or C<filter_read_exact>.
|
---|
| 281 |
|
---|
| 282 | =item B<filter_del>
|
---|
| 283 |
|
---|
| 284 | The function, C<filter_del>, is used to disable the current filter. It
|
---|
| 285 | does not affect the running of the filter. All it does is tell Perl not
|
---|
| 286 | to call filter any more.
|
---|
| 287 |
|
---|
| 288 | See L<Example 4: Using filter_del> for details.
|
---|
| 289 |
|
---|
| 290 | =back
|
---|
| 291 |
|
---|
| 292 | =head1 EXAMPLES
|
---|
| 293 |
|
---|
| 294 | Here are a few examples which illustrate the key concepts - as such
|
---|
| 295 | most of them are of little practical use.
|
---|
| 296 |
|
---|
| 297 | The C<examples> sub-directory has copies of all these filters
|
---|
| 298 | implemented both as I<method filters> and as I<closure filters>.
|
---|
| 299 |
|
---|
| 300 | =head2 Example 1: A simple filter.
|
---|
| 301 |
|
---|
| 302 | Below is a I<method filter> which is hard-wired to replace all
|
---|
| 303 | occurrences of the string C<"Joe"> to C<"Jim">. Not particularly
|
---|
| 304 | Useful, but it is the first example and I wanted to keep it simple.
|
---|
| 305 |
|
---|
| 306 | package Joe2Jim ;
|
---|
| 307 |
|
---|
| 308 | use Filter::Util::Call ;
|
---|
| 309 |
|
---|
| 310 | sub import
|
---|
| 311 | {
|
---|
| 312 | my($type) = @_ ;
|
---|
| 313 |
|
---|
| 314 | filter_add(bless []) ;
|
---|
| 315 | }
|
---|
| 316 |
|
---|
| 317 | sub filter
|
---|
| 318 | {
|
---|
| 319 | my($self) = @_ ;
|
---|
| 320 | my($status) ;
|
---|
| 321 |
|
---|
| 322 | s/Joe/Jim/g
|
---|
| 323 | if ($status = filter_read()) > 0 ;
|
---|
| 324 | $status ;
|
---|
| 325 | }
|
---|
| 326 |
|
---|
| 327 | 1 ;
|
---|
| 328 |
|
---|
| 329 | Here is an example of using the filter:
|
---|
| 330 |
|
---|
| 331 | use Joe2Jim ;
|
---|
| 332 | print "Where is Joe?\n" ;
|
---|
| 333 |
|
---|
| 334 | And this is what the script above will print:
|
---|
| 335 |
|
---|
| 336 | Where is Jim?
|
---|
| 337 |
|
---|
| 338 | =head2 Example 2: Using the context
|
---|
| 339 |
|
---|
| 340 | The previous example was not particularly useful. To make it more
|
---|
| 341 | general purpose we will make use of the context data and allow any
|
---|
| 342 | arbitrary I<from> and I<to> strings to be used. This time we will use a
|
---|
| 343 | I<closure filter>. To reflect its enhanced role, the filter is called
|
---|
| 344 | C<Subst>.
|
---|
| 345 |
|
---|
| 346 | package Subst ;
|
---|
| 347 |
|
---|
| 348 | use Filter::Util::Call ;
|
---|
| 349 | use Carp ;
|
---|
| 350 |
|
---|
| 351 | sub import
|
---|
| 352 | {
|
---|
| 353 | croak("usage: use Subst qw(from to)")
|
---|
| 354 | unless @_ == 3 ;
|
---|
| 355 | my ($self, $from, $to) = @_ ;
|
---|
| 356 | filter_add(
|
---|
| 357 | sub
|
---|
| 358 | {
|
---|
| 359 | my ($status) ;
|
---|
| 360 | s/$from/$to/
|
---|
| 361 | if ($status = filter_read()) > 0 ;
|
---|
| 362 | $status ;
|
---|
| 363 | })
|
---|
| 364 | }
|
---|
| 365 | 1 ;
|
---|
| 366 |
|
---|
| 367 | and is used like this:
|
---|
| 368 |
|
---|
| 369 | use Subst qw(Joe Jim) ;
|
---|
| 370 | print "Where is Joe?\n" ;
|
---|
| 371 |
|
---|
| 372 |
|
---|
| 373 | =head2 Example 3: Using the context within the filter
|
---|
| 374 |
|
---|
| 375 | Here is a filter which a variation of the C<Joe2Jim> filter. As well as
|
---|
| 376 | substituting all occurrences of C<"Joe"> to C<"Jim"> it keeps a count
|
---|
| 377 | of the number of substitutions made in the context object.
|
---|
| 378 |
|
---|
| 379 | Once EOF is detected (C<$status> is zero) the filter will insert an
|
---|
| 380 | extra line into the source stream. When this extra line is executed it
|
---|
| 381 | will print a count of the number of substitutions actually made.
|
---|
| 382 | Note that C<$status> is set to C<1> in this case.
|
---|
| 383 |
|
---|
| 384 | package Count ;
|
---|
| 385 |
|
---|
| 386 | use Filter::Util::Call ;
|
---|
| 387 |
|
---|
| 388 | sub filter
|
---|
| 389 | {
|
---|
| 390 | my ($self) = @_ ;
|
---|
| 391 | my ($status) ;
|
---|
| 392 |
|
---|
| 393 | if (($status = filter_read()) > 0 ) {
|
---|
| 394 | s/Joe/Jim/g ;
|
---|
| 395 | ++ $$self ;
|
---|
| 396 | }
|
---|
| 397 | elsif ($$self >= 0) { # EOF
|
---|
| 398 | $_ = "print q[Made ${$self} substitutions\n]" ;
|
---|
| 399 | $status = 1 ;
|
---|
| 400 | $$self = -1 ;
|
---|
| 401 | }
|
---|
| 402 |
|
---|
| 403 | $status ;
|
---|
| 404 | }
|
---|
| 405 |
|
---|
| 406 | sub import
|
---|
| 407 | {
|
---|
| 408 | my ($self) = @_ ;
|
---|
| 409 | my ($count) = 0 ;
|
---|
| 410 | filter_add(\$count) ;
|
---|
| 411 | }
|
---|
| 412 |
|
---|
| 413 | 1 ;
|
---|
| 414 |
|
---|
| 415 | Here is a script which uses it:
|
---|
| 416 |
|
---|
| 417 | use Count ;
|
---|
| 418 | print "Hello Joe\n" ;
|
---|
| 419 | print "Where is Joe\n" ;
|
---|
| 420 |
|
---|
| 421 | Outputs:
|
---|
| 422 |
|
---|
| 423 | Hello Jim
|
---|
| 424 | Where is Jim
|
---|
| 425 | Made 2 substitutions
|
---|
| 426 |
|
---|
| 427 | =head2 Example 4: Using filter_del
|
---|
| 428 |
|
---|
| 429 | Another variation on a theme. This time we will modify the C<Subst>
|
---|
| 430 | filter to allow a starting and stopping pattern to be specified as well
|
---|
| 431 | as the I<from> and I<to> patterns. If you know the I<vi> editor, it is
|
---|
| 432 | the equivalent of this command:
|
---|
| 433 |
|
---|
| 434 | :/start/,/stop/s/from/to/
|
---|
| 435 |
|
---|
| 436 | When used as a filter we want to invoke it like this:
|
---|
| 437 |
|
---|
| 438 | use NewSubst qw(start stop from to) ;
|
---|
| 439 |
|
---|
| 440 | Here is the module.
|
---|
| 441 |
|
---|
| 442 | package NewSubst ;
|
---|
| 443 |
|
---|
| 444 | use Filter::Util::Call ;
|
---|
| 445 | use Carp ;
|
---|
| 446 |
|
---|
| 447 | sub import
|
---|
| 448 | {
|
---|
| 449 | my ($self, $start, $stop, $from, $to) = @_ ;
|
---|
| 450 | my ($found) = 0 ;
|
---|
| 451 | croak("usage: use Subst qw(start stop from to)")
|
---|
| 452 | unless @_ == 5 ;
|
---|
| 453 |
|
---|
| 454 | filter_add(
|
---|
| 455 | sub
|
---|
| 456 | {
|
---|
| 457 | my ($status) ;
|
---|
| 458 |
|
---|
| 459 | if (($status = filter_read()) > 0) {
|
---|
| 460 |
|
---|
| 461 | $found = 1
|
---|
| 462 | if $found == 0 and /$start/ ;
|
---|
| 463 |
|
---|
| 464 | if ($found) {
|
---|
| 465 | s/$from/$to/ ;
|
---|
| 466 | filter_del() if /$stop/ ;
|
---|
| 467 | }
|
---|
| 468 |
|
---|
| 469 | }
|
---|
| 470 | $status ;
|
---|
| 471 | } )
|
---|
| 472 |
|
---|
| 473 | }
|
---|
| 474 |
|
---|
| 475 | 1 ;
|
---|
| 476 |
|
---|
| 477 | =head1 Filter::Simple
|
---|
| 478 |
|
---|
| 479 | If you intend using the Filter::Call functionality, I would strongly
|
---|
| 480 | recommend that you check out Damian Conway's excellent Filter::Simple
|
---|
| 481 | module. Damian's module provides a much cleaner interface than
|
---|
| 482 | Filter::Util::Call. Although it doesn't allow the fine control that
|
---|
| 483 | Filter::Util::Call does, it should be adequate for the majority of
|
---|
| 484 | applications. It's available at
|
---|
| 485 |
|
---|
| 486 | http://www.cpan.org/modules/by-author/Damian_Conway/Filter-Simple.tar.gz
|
---|
| 487 | http://www.csse.monash.edu.au/~damian/CPAN/Filter-Simple.tar.gz
|
---|
| 488 |
|
---|
| 489 | =head1 AUTHOR
|
---|
| 490 |
|
---|
| 491 | Paul Marquess
|
---|
| 492 |
|
---|
| 493 | =head1 DATE
|
---|
| 494 |
|
---|
| 495 | 26th January 1996
|
---|
| 496 |
|
---|
| 497 | =cut
|
---|
| 498 |
|
---|