"Fossies" - the Fresh Open Source Software Archive

Member "install-tl-20200916/tlpkg/tlperl/lib/Filter/Util/Call.pm" (7 Mar 2020, 14019 Bytes) of package /windows/misc/install-tl.zip:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Perl source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file.

    1 # Call.pm
    2 #
    3 # Copyright (c) 1995-2011 Paul Marquess. All rights reserved.
    4 # Copyright (c) 2011-2014 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  
   10 package Filter::Util::Call ;
   11 
   12 require 5.006 ; # our
   13 require Exporter;
   14 
   15 use XSLoader ();
   16 use strict;
   17 use warnings;
   18 
   19 our @ISA = qw(Exporter);
   20 our @EXPORT = qw( filter_add filter_del filter_read filter_read_exact) ;
   21 our $VERSION = "1.59" ;
   22 our $XS_VERSION = $VERSION;
   23 $VERSION = eval $VERSION;
   24 
   25 sub 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 
   47 sub 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 
   63 XSLoader::load('Filter::Util::Call');
   64 
   65 1;
   66 __END__
   67 
   68 =head1 NAME
   69 
   70 Filter::Util::Call - Perl Source Filter Utility Module
   71 
   72 =head1 SYNOPSIS
   73 
   74     use Filter::Util::Call ;
   75 
   76 =head1 DESCRIPTION
   77 
   78 This module provides you with the framework to write I<Source Filters>
   79 in Perl. 
   80 
   81 An alternate interface to Filter::Util::Call is now available. See
   82 L<Filter::Simple> for more details.
   83 
   84 A I<Perl Source Filter> is implemented as a Perl module. The structure
   85 of the module can take one of two broadly similar formats. To
   86 distinguish between them, the first will be referred to as I<method
   87 filter> and the second as I<closure filter>.
   88 
   89 Here 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 
  112 and 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 
  133 To make use of either of the two filter modules above, place the line
  134 below in a Perl source file.
  135 
  136     use MyFilter; 
  137 
  138 In fact, the skeleton modules shown above are fully functional I<Source
  139 Filters>, albeit fairly useless ones. All they does is filter the
  140 source stream without modifying it at all.
  141 
  142 As you can see both modules have a broadly similar structure. They both
  143 make use of the C<Filter::Util::Call> module and both have an C<import>
  144 method. The difference between them is that the I<method filter>
  145 requires a I<filter> method, whereas the I<closure filter> gets the
  146 equivalent of a I<filter> method with the anonymous sub passed to
  147 I<filter_add>.
  148 
  149 To make proper use of the I<closure filter> shown above you need to
  150 have a good understanding of the concept of a I<closure>. See
  151 L<perlref> for more details on the mechanics of I<closures>.
  152 
  153 =head2 B<use Filter::Util::Call>
  154 
  155 The 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 
  164 The C<import> method is used to create an instance of the filter. It is
  165 called indirectly by Perl when it encounters the C<use MyFilter> line
  166 in a source file (See L<perlfunc/import> for more details on
  167 C<import>).
  168 
  169 It 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
  171 will be C<"MyFilter">.
  172 
  173 Apart from the first parameter, import can accept an optional list of
  174 parameters. These can be used to pass parameters to the filter. For
  175 example:
  176 
  177     use MyFilter qw(a b c) ;
  178 
  179 will result in the C<@_> array having the following values:
  180 
  181     @_ [0] => "MyFilter"
  182     @_ [1] => "a"
  183     @_ [2] => "b"
  184     @_ [3] => "c"
  185 
  186 Before terminating, the C<import> function must explicitly install the
  187 filter by calling C<filter_add>.
  188 
  189 =head2 B<filter_add()>
  190 
  191 The function, C<filter_add>, actually installs the filter. It takes one
  192 parameter which should be a reference. The kind of reference used will
  193 dictate which of the two filter types will be used.
  194 
  195 If a CODE reference is used then a I<closure filter> will be assumed.
  196 
  197 If a CODE reference is not used, a I<method filter> will be assumed.
  198 In a I<method filter>, the reference can be used to store context
  199 information. The reference will be I<blessed> into the package by
  200 C<filter_add>, unless the reference was already blessed.
  201 
  202 See the filters at the end of this documents for examples of using
  203 context information using both I<method filters> and I<closure
  204 filters>.
  205 
  206 =head2 B<filter() and anonymous sub>
  207 
  208 Both the C<filter> method used with a I<method filter> and the
  209 anonymous sub used with a I<closure filter> is where the main
  210 processing for the filter is done.
  211 
  212 The big difference between the two types of filter is that the I<method
  213 filter> uses the object passed to the method to store any context data,
  214 whereas the I<closure filter> uses the lexical variables that are
  215 maintained by the closure.
  216 
  217 Note that the single parameter passed to the I<method filter>,
  218 C<$self>, is the same reference that was passed to C<filter_add>
  219 blessed into the filter's package. See the example filters later on for
  220 details of using C<$self>.
  221 
  222 Here is a list of the common features of the anonymous sub and the
  223 C<filter()> method.
  224 
  225 =over 5
  226 
  227 =item B<$_>
  228 
  229 Although C<$_> doesn't actually appear explicitly in the sample filters
  230 above, it is implicitly used in a number of places.
  231 
  232 Firstly, when either C<filter> or the anonymous sub are called, a local
  233 copy of C<$_> will automatically be created. It will always contain the
  234 empty string at this point.
  235 
  236 Next, both C<filter_read> and C<filter_read_exact> will append any
  237 source data that is read to the end of C<$_>.
  238 
  239 Finally, when C<filter> or the anonymous sub are finished processing,
  240 they are expected to return the filtered source using C<$_>.
  241 
  242 This implicit use of C<$_> greatly simplifies the filter.
  243 
  244 =item B<$status>
  245 
  246 The status value that is returned by the user's C<filter> method or
  247 anonymous sub and the C<filter_read> and C<read_exact> functions take
  248 the 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 
  256 These functions are used by the filter to obtain either a line or block
  257 from the next filter in the chain or the actual source file if there
  258 aren't any other filters.
  259 
  260 The function C<filter_read> takes two forms:
  261 
  262     $status = filter_read() ;
  263     $status = filter_read($size) ;
  264 
  265 The first form is used to request a I<line>, the second requests a
  266 I<block>.
  267 
  268 In line mode, C<filter_read> will append the next source line to the
  269 end of the C<$_> scalar.
  270 
  271 In block mode, C<filter_read> will append a block of data which is <=
  272 C<$size> to the end of the C<$_> scalar. It is important to emphasise
  273 the that C<filter_read> will not necessarily read a block which is
  274 I<precisely> C<$size> bytes.
  275 
  276 If you need to be able to read a block which has an exact size, you can
  277 use the function C<filter_read_exact>. It works identically to
  278 C<filter_read> in block mode, except it will try to read a block which
  279 is exactly C<$size> bytes in length. The only circumstances when it
  280 will not return a block which is C<$size> bytes long is on EOF or
  281 error.
  282 
  283 It is I<very> important to check the value of C<$status> after I<every>
  284 call to C<filter_read> or C<filter_read_exact>.
  285 
  286 =item B<filter_del>
  287 
  288 The function, C<filter_del>, is used to disable the current filter. It
  289 does not affect the running of the filter. All it does is tell Perl not
  290 to call filter any more.
  291 
  292 See L<Example 4: Using filter_del> for details.
  293 
  294 =item I<real_import>
  295 
  296 Internal function which adds the filter, based on the L<filter_add>
  297 argument type.
  298 
  299 =item I<unimport()>
  300 
  301 May be used to disable a filter, but is rarely needed. See L<filter_del>.
  302 
  303 =back
  304 
  305 =head1 LIMITATIONS
  306 
  307 See L<perlfilter/LIMITATIONS> for an overview of the general problems
  308 filtering code in a textual line-level only.
  309 
  310 =over
  311 
  312 =item __DATA__ is ignored
  313 
  314 The content from the __DATA__ block is not filtered.
  315 This is a serious limitation, e.g. for the L<Switch> module.
  316 See L<http://search.cpan.org/perldoc?Switch#LIMITATIONS> for more.
  317 
  318 =item Max. codesize limited to 32-bit
  319 
  320 Currently internal buffer lengths are limited to 32-bit only.
  321 
  322 =back
  323 
  324 =head1 EXAMPLES
  325 
  326 Here are a few examples which illustrate the key concepts - as such
  327 most of them are of little practical use.
  328 
  329 The C<examples> sub-directory has copies of all these filters
  330 implemented both as I<method filters> and as I<closure filters>.
  331 
  332 =head2 Example 1: A simple filter.
  333 
  334 Below is a I<method filter> which is hard-wired to replace all
  335 occurrences of the string C<"Joe"> to C<"Jim">. Not particularly
  336 Useful, 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 
  361 Here is an example of using the filter:
  362 
  363     use Joe2Jim ;
  364     print "Where is Joe?\n" ;
  365 
  366 And this is what the script above will print:
  367 
  368     Where is Jim?
  369 
  370 =head2 Example 2: Using the context
  371 
  372 The previous example was not particularly useful. To make it more
  373 general purpose we will make use of the context data and allow any
  374 arbitrary I<from> and I<to> strings to be used. This time we will use a
  375 I<closure filter>. To reflect its enhanced role, the filter is called
  376 C<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 
  399 and 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 
  407 Here is a filter which a variation of the C<Joe2Jim> filter. As well as
  408 substituting all occurrences of C<"Joe"> to C<"Jim"> it keeps a count
  409 of the number of substitutions made in the context object.
  410 
  411 Once EOF is detected (C<$status> is zero) the filter will insert an
  412 extra line into the source stream. When this extra line is executed it
  413 will print a count of the number of substitutions actually made.
  414 Note 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 
  447 Here is a script which uses it:
  448 
  449     use Count ;
  450     print "Hello Joe\n" ;
  451     print "Where is Joe\n" ;
  452 
  453 Outputs:
  454 
  455     Hello Jim
  456     Where is Jim
  457     Made 2 substitutions
  458 
  459 =head2 Example 4: Using filter_del
  460 
  461 Another variation on a theme. This time we will modify the C<Subst>
  462 filter to allow a starting and stopping pattern to be specified as well
  463 as the I<from> and I<to> patterns. If you know the I<vi> editor, it is
  464 the equivalent of this command:
  465 
  466     :/start/,/stop/s/from/to/
  467 
  468 When used as a filter we want to invoke it like this:
  469 
  470     use NewSubst qw(start stop from to) ;
  471 
  472 Here 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 
  511 If you intend using the Filter::Call functionality, I would strongly
  512 recommend that you check out Damian Conway's excellent Filter::Simple
  513 module. Damian's module provides a much cleaner interface than
  514 Filter::Util::Call. Although it doesn't allow the fine control that
  515 Filter::Util::Call does, it should be adequate for the majority of
  516 applications. It's available at
  517 
  518    http://search.cpan.org/dist/Filter-Simple/
  519 
  520 =head1 AUTHOR
  521 
  522 Paul Marquess 
  523 
  524 =head1 DATE
  525 
  526 26th January 1996
  527 
  528 =head1 LICENSE
  529 
  530 Copyright (c) 1995-2011 Paul Marquess. All rights reserved.
  531 Copyright (c) 2011-2014 Reini Urban. All rights reserved.
  532 Copyright (c) 2014-2017 cPanel Inc. All rights reserved.
  533 
  534 This program is free software; you can redistribute it and/or
  535 modify it under the same terms as Perl itself.
  536 
  537 =cut
  538