This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Update Filter::Util::Call to CPAN version 1.51
authorChris 'BinGOs' Williams <chris@bingosnet.co.uk>
Wed, 17 Dec 2014 21:01:29 +0000 (21:01 +0000)
committerChris 'BinGOs' Williams <chris@bingosnet.co.uk>
Wed, 17 Dec 2014 21:03:24 +0000 (21:03 +0000)
  [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

MANIFEST
Porting/Maintainers.pl
cpan/Filter-Util-Call/Call.pm
cpan/Filter-Util-Call/Call.xs
cpan/Filter-Util-Call/t/rt_54452-rebless.t [new file with mode: 0644]
pod/perlfilter.pod

index 7ae1710..844b7ae 100644 (file)
--- 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
index b64e56b..8f4e45c 100755 (executable)
@@ -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
                 ],
index fb379b0..d6a09a1 100644 (file)
@@ -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
 
index 22163eb..48407ab 100644 (file)
@@ -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 (file)
index 0000000..b6f7aa0
--- /dev/null
@@ -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" ;
index 2706188..21df352 100644 (file)
@@ -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