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