In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/f686c54e62c95370bd11d48d8f2f735c2430982a?hp=dc6bb7ba3b9ef9b60fcf85c93613dc6eeb1b4972>
- Log ----------------------------------------------------------------- commit f686c54e62c95370bd11d48d8f2f735c2430982a Author: Chris 'BinGOs' Williams <[email protected]> Date: Wed Dec 17 21:01:29 2014 +0000 Update Filter::Util::Call to CPAN version 1.51 [DELTA] 1.50 2014-06-04 rurban ---- * Do not re-bless already blessed filter_add arguments into the callers package. Fixes RT #54452 * t/z_pod-coverage.t: omit empty Filter::decrypt (also fixes RT #84405) * Fix Perl Compiler detection in Filter::decrypt 1.51 2014-12-09 rurban ---- * Minor -Wall -Wextra cleanups by jhi and me. Fixes RT #100742 * Updated Copyright years * Document and warn about its limitations ----------------------------------------------------------------------- Summary of changes: MANIFEST | 1 + Porting/Maintainers.pl | 2 +- cpan/Filter-Util-Call/Call.pm | 18 ++++++--- cpan/Filter-Util-Call/Call.xs | 13 ++++--- cpan/Filter-Util-Call/t/rt_54452-rebless.t | 62 ++++++++++++++++++++++++++++++ pod/perlfilter.pod | 22 +++++++++++ 6 files changed, 106 insertions(+), 12 deletions(-) create mode 100644 cpan/Filter-Util-Call/t/rt_54452-rebless.t diff --git a/MANIFEST b/MANIFEST index 7ae1710..844b7ae 100644 --- a/MANIFEST +++ b/MANIFEST @@ -1101,6 +1101,7 @@ cpan/Filter-Util-Call/Call.pm Filter::Util::Call extension module cpan/Filter-Util-Call/Call.xs Filter::Util::Call extension external subroutines cpan/Filter-Util-Call/filter-util.pl See if Filter::Util::Call works cpan/Filter-Util-Call/t/call.t See if Filter::Util::Call works +cpan/Filter-Util-Call/t/rt_54452-rebless.t cpan/Getopt-Long/lib/Getopt/Long.pm Fetch command options (GetOptions) cpan/Getopt-Long/t/gol-basic.t See if Getopt::Long works cpan/Getopt-Long/t/gol-linkage.t See if Getopt::Long works diff --git a/Porting/Maintainers.pl b/Porting/Maintainers.pl index b64e56b..8f4e45c 100755 --- a/Porting/Maintainers.pl +++ b/Porting/Maintainers.pl @@ -538,7 +538,7 @@ use File::Glob qw(:case); }, 'Filter::Util::Call' => { - 'DISTRIBUTION' => 'RURBAN/Filter-1.49.tar.gz', + 'DISTRIBUTION' => 'RURBAN/Filter-1.51.tar.gz', 'FILES' => q[cpan/Filter-Util-Call pod/perlfilter.pod ], diff --git a/cpan/Filter-Util-Call/Call.pm b/cpan/Filter-Util-Call/Call.pm index fb379b0..d6a09a1 100644 --- a/cpan/Filter-Util-Call/Call.pm +++ b/cpan/Filter-Util-Call/Call.pm @@ -18,7 +18,7 @@ use vars qw($VERSION @ISA @EXPORT) ; @ISA = qw(Exporter DynaLoader); @EXPORT = qw( filter_add filter_del filter_read filter_read_exact) ; -$VERSION = "1.49" ; +$VERSION = "1.51" ; sub filter_read_exact($) { @@ -48,9 +48,9 @@ sub filter_add($) my $coderef = (ref $obj eq 'CODE') ; # If the parameter isn't already a reference, make it one. - $obj = \$obj unless ref $obj ; - - $obj = bless ($obj, (caller)[0]) unless $coderef ; + if (!$coderef and !ref $obj) { + $obj = bless (\$obj, (caller)[0]); + } # finish off the installation of the filter in C. Filter::Util::Call::real_import($obj, (caller)[0], $coderef) ; @@ -193,7 +193,7 @@ If a CODE reference is used then a I<closure filter> will be assumed. If a CODE reference is not used, a I<method filter> will be assumed. In a I<method filter>, the reference can be used to store context information. The reference will be I<blessed> into the package by -C<filter_add>. +C<filter_add>, unless the reference was already blessed. See the filters at the end of this documents for examples of using context information using both I<method filters> and I<closure @@ -498,5 +498,13 @@ Paul Marquess 26th January 1996 +=head1 LICENSE + +Copyright (c) 1995-2011 Paul Marquess. All rights reserved. +Copyright (c) 2011-2014 Reini Urban. All rights reserved. + +This program is free software; you can redistribute it and/or +modify it under the same terms as Perl itself. + =cut diff --git a/cpan/Filter-Util-Call/Call.xs b/cpan/Filter-Util-Call/Call.xs index 22163eb..48407ab 100644 --- a/cpan/Filter-Util-Call/Call.xs +++ b/cpan/Filter-Util-Call/Call.xs @@ -2,10 +2,11 @@ * Filename : Call.xs * * Author : Paul Marquess - * Date : 2013-03-29 09:04:42 rurban - * Version : 1.49 + * Date : 2014-12-09 02:48:44 rurban + * Version : 1.51 * * Copyright (c) 1995-2011 Paul Marquess. All rights reserved. + * Copyright (c) 2011-2014 Reini Urban. All rights reserved. * This program is free software; you can redistribute it and/or * modify it under the same terms as Perl itself. * @@ -60,7 +61,7 @@ filter_call(pTHX_ int idx, SV *buf_sv, int maxlen) if (fdebug) warn("**** In filter_call - maxlen = %d, out len buf = %" IVdf " idx = %d my_sv = %" IVdf " [%s]\n", - maxlen, SvCUR(buf_sv), idx, SvCUR(my_sv), SvPVX(my_sv) ) ; + maxlen, (IV)SvCUR(buf_sv), idx, (IV)SvCUR(my_sv), SvPVX(my_sv) ) ; while (1) { @@ -97,7 +98,7 @@ filter_call(pTHX_ int idx, SV *buf_sv, int maxlen) SvCUR_set(my_sv, n) ; if (fdebug) warn("recycle %d - leaving %d, returning %" IVdf " [%s]", - idx, n, SvCUR(buf_sv), SvPVX(buf_sv)) ; + idx, n, (IV)SvCUR(buf_sv), SvPVX(buf_sv)) ; return SvCUR(buf_sv); } @@ -153,7 +154,7 @@ filter_call(pTHX_ int idx, SV *buf_sv, int maxlen) if (fdebug) warn("status = %d, length op buf = %" IVdf " [%s]\n", - n, SvCUR(DEFSV), SvPVX(DEFSV) ) ; + n, (IV)SvCUR(DEFSV), SvPVX(DEFSV) ) ; if (SvCUR(DEFSV)) sv_setpvn(my_sv, SvPVX(DEFSV), SvCUR(DEFSV)) ; @@ -172,7 +173,7 @@ filter_call(pTHX_ int idx, SV *buf_sv, int maxlen) if (fdebug) warn ("filter_read %d returned %d , returning %" IVdf "\n", idx, n, - (SvCUR(buf_sv)>0) ? SvCUR(buf_sv) : (STRLEN)n); + (SvCUR(buf_sv)>0) ? SvCUR(buf_sv) : (IV)n); /* PERL_MODULE(my_sv) ; */ /* PERL_OBJECT(my_sv) ; */ diff --git a/cpan/Filter-Util-Call/t/rt_54452-rebless.t b/cpan/Filter-Util-Call/t/rt_54452-rebless.t new file mode 100644 index 0000000..b6f7aa0 --- /dev/null +++ b/cpan/Filter-Util-Call/t/rt_54452-rebless.t @@ -0,0 +1,62 @@ +# RT #54452 check that filter_add does not rebless an already blessed +# given object into the callers class. + +if ($] < 5.004_55) { + print "1..0\n"; + exit 0; +} + +use strict; +use warnings; + +require "./filter-util.pl" ; + +use vars qw( $Inc $Perl) ; + +my $file = "bless.test" ; +my $module = "Foo"; +my $bless1 = "bless1" ; + +writeFile("t/Foo.pm", <<'EOM') ; +package Foo; +use strict; +use warnings; +our @ISA = ('Foo::Base'); + +package Foo::Base; +use Filter::Util::Call; +sub import { + my ($class) = @_; + my $self = bless {}, $class; + print "before ", ref $self, "\n"; + filter_add ($self); + print "after ", ref $self, "\n"; +} +sub filter { + my ($self) = @_; + print "filter ", ref $self, "\n"; + return 0; +} + +1; +EOM + +my $fil1 = <<EOM; +use lib 't'; +use Foo; +print "this is filtered out\n"; +EOM + +writeFile($file, $fil1); + +my $a = `$Perl $Inc $file 2>&1` ; +print "1..2\n" ; + +ok(1, ($? >> 8) == 0) ; +chomp $a; +ok(2, $a eq "before Foo +after Foo +filter Foo", "RT \#54452 " . $a); + +unlink $file or die "Cannot remove $file: $!\n" ; +unlink "t/Foo.pm" or die "Cannot remove t/Foo.pm: $!\n" ; diff --git a/pod/perlfilter.pod b/pod/perlfilter.pod index 2706188..21df352 100644 --- a/pod/perlfilter.pod +++ b/pod/perlfilter.pod @@ -550,6 +550,28 @@ useful features from the C preprocessor and any other macro processors you know. The tricky bit will be choosing how much knowledge of Perl's syntax you want your filter to have. +=head1 LIMITATIONS + +Source filters only work on the string level, thus are highly limited +in its ability to change source code on the fly. It cannot detect +comments, quoted strings, heredocs, it is no replacement for a real +parser. +The only stable usage for source filters are encryption, compression, +or the byteloader, to translate binary code back to source code. + +See for example the limitations in Switch, which uses source filters, +and thus is does not work inside a string eval, the presence of +regexes with embedded newlines that are specified with raw /.../ +delimiters and don't have a modifier //x are indistinguishable from +code chunks beginning with the division operator /. As a workaround +you must use m/.../ or m?...? for such patterns. Also, the presence of +regexes specified with raw ?...? delimiters may cause mysterious +errors. The workaround is to use m?...? instead. See +http://search.cpan.org/perldoc?Switch#LIMITATIONS + +Currently internal buffer lengths are limited to 32-bit only. + + =head1 THINGS TO LOOK OUT FOR =over 5 -- Perl5 Master Repository
