| Subject: | Feature request: coderef rules |
In some cases, regexps became too complicated, especially when there are 2 or more conditions to check against and when some complex is code needed to take correct decision. Since (?{ code }) pattern is still considered highly experimental, I propose to allow supplying subroutine reference as a value of a rule, eg :
$p->rules(
img => {
src => sub { $_[0] !~ /domain1/ && $_[0] !~ /\(=/ },
'*' => 0, # deny all other attributes
},
b => 1,
...
);
Proposed patch is attached
Sincerely,
Aleksandr Guidrevitch
Only in .: blib
Only in .: Makefile
Only in .: pm_to_blib
diff -r -u /home/ag/.cpan/sources/authors/id/P/PO/PODMASTER/HTML-Scrubber-0.08/Scrubber.pm ./Scrubber.pm
--- /home/ag/.cpan/sources/authors/id/P/PO/PODMASTER/HTML-Scrubber-0.08/Scrubber.pm 2004-04-02 01:15:47.000000000 +0300
+++ ./Scrubber.pm 2005-11-13 14:18:13.000000000 +0200
@@ -367,8 +367,11 @@
for my $k( keys %$a ) {
if( exists $r->{$k} ) {
- if( ref $r->{$k} || length($r->{$k}) > 1 ) {
+ if( ref $r->{$k} eq 'Regexp'
+ || ( !ref $r->{$k} && length($r->{$k}) > 1 )) {
$f{$k} = $a->{$k} if $a->{$k} =~ m{$r->{$k}};
+ } elsif( ref $r->{$k} eq 'CODE' ) {
+ $f{$k} = $a->{$k} if $r->{$k}->($a->{$k});
} elsif( $r->{$k} ) {
$f{$k} = $a->{$k};
}
diff -r -u /home/ag/.cpan/sources/authors/id/P/PO/PODMASTER/HTML-Scrubber-0.08/t/02_basic.t ./t/02_basic.t
--- /home/ag/.cpan/sources/authors/id/P/PO/PODMASTER/HTML-Scrubber-0.08/t/02_basic.t 2003-10-29 21:59:08.000000000 +0200
+++ ./t/02_basic.t 2005-11-13 14:36:18.000000000 +0200
@@ -6,7 +6,7 @@
# change 'tests => 1' to 'tests => last_test_to_print';
use Test;
-BEGIN { plan tests => 77 };
+BEGIN { plan tests => 90 };
use HTML::Scrubber;
ok(1); # If we made it this far, we're ok. # test 1
@@ -149,3 +149,21 @@
ok( $scrubber =~ /\Q"\E/ ); # test 75
ok( $scrubber =~ /\#/ ); # test 76
ok( $scrubber =~ /bold </ ); # test 77
+
+$scrubber = HTML::Scrubber->new( default => [ 1 => { href => sub { !(index ($_[0], '#') + 1) }, '*' => 1 } ] );
+
+ok( $scrubber ); # test 78
+ok( $scrubber->default() ); # test 79
+ok( ! $scrubber->comment() ); # test 80
+ok( ! $scrubber->process() ); # test 81
+ok( ! $scrubber->comment(1) ); # test 82
+$scrubber = $scrubber->scrub($html);
+
+ok( $scrubber ); # test 83
+ok( $scrubber =~ /[><]/ ); # test 84
+ok( $scrubber !~ /href/i ); # test 85
+ok( $scrubber =~ /Align/i ); # test 86
+ok( $scrubber =~ /\Q<!--\E/ ); # test 87
+ok( $scrubber !~ /\Q"\E/ ); # test 88
+ok( $scrubber !~ /\#/ ); # test 89
+ok( $scrubber =~ /bold </ ); # test 90