This is an automated email from the git hooks/post-receive script. fsfs pushed a commit to annotated tag release/0.10-TRIAL in repository libhtml-scrubber-perl.
commit 4ef3e1980e05b6fcb97b0cae3498fa6588b6ec53 Author: Ruslan Zakirov <[email protected]> Date: Sun Sep 22 15:16:02 2013 +0400 make it possible to process attributes with callabacks --- Changes | 2 ++ lib/HTML/Scrubber.pm | 15 ++++++++++++++- t/08_cb_attrs.t | 28 ++++++++++++++++++++++++++++ 3 files changed, 44 insertions(+), 1 deletion(-) diff --git a/Changes b/Changes index fc8cc2e..e2445cd 100644 --- a/Changes +++ b/Changes @@ -4,6 +4,8 @@ Revision history for Perl extension HTML::Scrubber. - RT3008 Changed examples to be XSS free - RT19063, RT25477 fixed handling of self closing tags, for example '<hr />' + - callbacks in rules to check or adjust attributes with + custom code (RT15747) 0.09 2011-04-01 16:35:50 Europe/London - Basic conversion to Dist::Zilla/git diff --git a/lib/HTML/Scrubber.pm b/lib/HTML/Scrubber.pm index e02a3c9..2d67ca1 100644 --- a/lib/HTML/Scrubber.pm +++ b/lib/HTML/Scrubber.pm @@ -230,10 +230,19 @@ sub deny { alt => 1, # alt attribute allowed '*' => 0, # deny all other attributes }, + a => { + href => sub { ... }, # check or adjust with a callback + }, b => 1, ... ); +Updates set of attribute rules. Each rule can be 1/0, regular expression +or a callback. Values longer than 1 char are treated as regexps. Callback +is called with the following arguments: this object, tag name, attribute +name and attribute value, should return empty list to drop attribute, +C<undef> to keep it without value or a new scalar value. + =cut sub rules{ @@ -369,7 +378,11 @@ sub _validate { for my $k( keys %$a ) { my $check = exists $r->{$k}? $r->{$k} : exists $r->{'*'}? $r->{'*'} : next; - if( ref $check || length($check) > 1 ) { + if( ref $check eq 'CODE' ) { + my @v = $check->( $s, $t, $k, $a->{$k}, $a, \%f ); + next unless @v; + $f{$k} = shift @v; + } elsif( ref $check || length($check) > 1 ) { $f{$k} = $a->{$k} if $a->{$k} =~ m{$check}; } elsif( $check ) { $f{$k} = $a->{$k}; diff --git a/t/08_cb_attrs.t b/t/08_cb_attrs.t new file mode 100644 index 0000000..f7545da --- /dev/null +++ b/t/08_cb_attrs.t @@ -0,0 +1,28 @@ +use strict; +use warnings; +use Test::More; + +use_ok('HTML::Scrubber'); +use HTML::Scrubber; + +my $scrubber = HTML::Scrubber->new; +$scrubber->default(1); + +my $cb = sub { + my ($self, $tag, $attr, $avalue) = @_; + my %h = ( + drop => [], + bool => [undef], + empty => [''], + foo => ['bar'], + ); + return @{ $h{ $avalue } }; +}; + +$scrubber->rules( p => { a => $cb } ); +is($scrubber->scrub('<p a="drop">'), '<p>', "correct result"); +is($scrubber->scrub('<p a="bool">'), '<p a>', "correct result"); +is($scrubber->scrub('<p a="empty">'), '<p a="">', "correct result"); +is($scrubber->scrub('<p a="foo">'), '<p a="bar">', "correct result"); + +done_testing; -- Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/libhtml-scrubber-perl.git _______________________________________________ Pkg-perl-cvs-commits mailing list [email protected] http://lists.alioth.debian.org/cgi-bin/mailman/listinfo/pkg-perl-cvs-commits
