This is an automated email from the git hooks/post-receive script. fsfs pushed a commit to annotated tag HTML-Scrubber-0.07 in repository libhtml-scrubber-perl.
commit 7e3616a5162d0c609b504b3ec02f45f3c6a93fea Author: D. H. <[email protected]> Date: Thu Mar 18 14:37:42 2004 +0000 Imported from HTML-Scrubber-0.07.tar.gz. --- Changes | 5 ++++ LICENSE | 0 MANIFEST | 1 + MANIFEST.SKIP | 0 META.yml | 4 +-- Makefile.PL | 6 +++++ README | 0 Scrubber.pm | 61 +++++++++++++++++++++++------------------- t/01_use.t | 0 t/02_basic.t | 0 t/03_more.t | 0 t/04_style_script.t | 0 t/05_pi_comment.t | 0 t/06_scrub_file.t | 0 t/07_booleans.t | 77 +++++++++++++++++++++++++++++++++++++++++++++++++++++ 15 files changed, 124 insertions(+), 30 deletions(-) diff --git a/Changes b/Changes old mode 100755 new mode 100644 index 6e87c9a..34d6091 --- a/Changes +++ b/Changes @@ -1,5 +1,10 @@ Revision history for Perl extension HTML::Scrubber. +0.07 Thu Mar 18 06:21:38 2004 + - allow for boolean attributes (thanks b10m) + - which is why now attribute order is followed (attrseq) + repeated elements get squashed (see 07_booleans.t for details). + 0.06 Sun Nov 2 01:26:42 2003 - fixed more typos - added t\06_scrub_file.t (that part was broken, now fixed) diff --git a/LICENSE b/LICENSE old mode 100755 new mode 100644 diff --git a/MANIFEST b/MANIFEST old mode 100755 new mode 100644 index 07f07a1..beda636 --- a/MANIFEST +++ b/MANIFEST @@ -11,4 +11,5 @@ t/03_more.t t/04_style_script.t t/05_pi_comment.t t/06_scrub_file.t +t/07_booleans.t META.yml Module meta-data (added by MakeMaker) diff --git a/MANIFEST.SKIP b/MANIFEST.SKIP old mode 100755 new mode 100644 diff --git a/META.yml b/META.yml old mode 100755 new mode 100644 index 1bcefcb..87dcbf5 --- a/META.yml +++ b/META.yml @@ -1,7 +1,7 @@ # http://module-build.sourceforge.net/META-spec.html #XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX# name: HTML-Scrubber -version: 0.06 +version: 0.07 version_from: Scrubber.pm installdirs: site requires: @@ -10,4 +10,4 @@ requires: Test::More: 0 distribution_type: module -generated_by: ExtUtils::MakeMaker version 6.17 +generated_by: ExtUtils::MakeMaker version 6.21 diff --git a/Makefile.PL b/Makefile.PL old mode 100755 new mode 100644 index 155f2be..2ea6e49 --- a/Makefile.PL +++ b/Makefile.PL @@ -14,3 +14,9 @@ WriteMakefile( (ABSTRACT_FROM => 'Scrubber.pm', # retrieve abstract from module AUTHOR => 'D. H. aka PodMaster') : ()), ); + +__END__ +perl Makefile.PL && nmake realclean && cls && perl Makefile.PL && nmake disttest +nmake dist TAR=ptar +chmod 7777 *.gz +perl -le" `cpan-upload $_` for( (sort glob q,*.gz,)[-1]) " diff --git a/README b/README old mode 100755 new mode 100644 diff --git a/Scrubber.pm b/Scrubber.pm old mode 100755 new mode 100644 index b32e347..10c689c --- a/Scrubber.pm +++ b/Scrubber.pm @@ -62,12 +62,12 @@ use HTML::Entities; use vars qw[ $VERSION @_scrub @_scrub_fh ]; use strict; -$VERSION = '0.06'; +$VERSION = '0.07'; # my my my my, these here to prevent foolishness like # http://perlmonks.org/index.pl?node_id=251127#Stealing+Lexicals -(@_scrub )= ( \&_scrub, "self, event, tagname, attr, text"); -(@_scrub_fh )= ( \&_scrub_fh, "self, event, tagname, attr, text"); +(@_scrub )= ( \&_scrub, "self, event, tagname, attr, attrseq, text"); +(@_scrub_fh )= ( \&_scrub_fh, "self, event, tagname, attr, attrseq, text"); sub new { my $package = shift; @@ -78,6 +78,7 @@ sub new { strict_comment => 0, unbroken_text => 1, case_sensitive => 0, + boolean_attribute_value => undef, ); my $self = { @@ -358,7 +359,7 @@ Takes tag, rule('_' || $tag), attrref. =cut sub _validate { - my($s, $t, $r, $a) = @_; + my($s, $t, $r, $a, $as) = @_; return "<$t>" unless %$a; $r = $s->{_rules}->{$r}; @@ -376,13 +377,18 @@ sub _validate { } } - return "<$t $r>" - if $r = join ' ', - map { - qq[$_="] - .encode_entities($f{$_}) - .q["] - } keys %f; + if( %f ){ + my %seen; + return "<$t $r>" + if $r = join ' ', + map { + defined $f{$_} + ? qq[$_="].encode_entities($f{$_}).q["] + : $_; # boolean attribute (TODO?) + } grep { + exists $f{$_} and !$seen{$_}++; + } @$as; + } return "<$t>"; } @@ -393,7 +399,7 @@ I<default> handler, does the scrubbing if we're scrubbing out to a file. =cut sub _scrub_fh { - my( $p, $e, $t, $a, $text ) = @_; + my( $p, $e, $t, $a, $as, $text ) = @_; my $s = $p->{"\0_s"} ; if ( $e eq 'start' ) @@ -404,20 +410,20 @@ sub _scrub_fh { { print {$s->{_out}} - $s->_validate($t, $t, $a); + $s->_validate($t, $t, $a, $as); } elsif( $s->{_rules}->{$t} ) # validate using default attribute rule { print {$s->{_out}} - $s->_validate($t, '_', $a); + $s->_validate($t, '_', $a, $as); } } elsif( $s->{_rules}->{'*'} ) # default allow tags { print {$s->{_out}} - $s->_validate($t, '_', $a); + $s->_validate($t, '_', $a, $as); } } elsif ( $e eq 'end' ) @@ -467,7 +473,7 @@ I<default> handler, does the scrubbing if we're returning a giant string. =cut sub _scrub { - my( $p, $e, $t, $a, $text ) = @_; + my( $p, $e, $t, $a, $as, $text ) = @_; my $s = $p->{"\0_s"} ; if ( $e eq 'start' ) @@ -476,16 +482,16 @@ sub _scrub { { if( ref $s->{_rules}->{$t} ) # is it complicated?(not simple;) { - $s->{_r} .= $s->_validate($t, $t, $a); + $s->{_r} .= $s->_validate($t, $t, $a, $as); } elsif( $s->{_rules}->{$t} ) # validate using default attribute rule { - $s->{_r} .= $s->_validate($t, '_', $a); + $s->{_r} .= $s->_validate($t, '_', $a, $as); } } elsif( $s->{_rules}->{'*'} ) # default allow tags { - $s->{_r} .= $s->_validate($t, '_', $a); + $s->{_r} .= $s->_validate($t, '_', $a, $as); } } elsif ( $e eq 'end' ) @@ -731,21 +737,20 @@ If you have Test::Inline (and you've installed HTML::Scrubber), try L<HTML::Parser>, L<Test::Inline>, L<HTML::Sanitizer>. -=head1 AUTHOR - -D.H aka PodMaster +=head1 BUGS/SUGGESTIONS/ETC +Please use +https://rt.cpan.org/NoAuth/Bugs.html?Dist=HTML-Scrubber +to report I<bugs>/additions/etc +or send mail to <bug-HTML-Scrubber#rt.cpan.org>. -Please use http://rt.cpan.org/ to report bugs. +=head1 AUTHOR -Just go to -http://rt.cpan.org/NoAuth/Bugs.html?Dist=HTML-Scrubber -to see a bug list and/or repot new ones. +D. H. (PodMaster) =head1 LICENSE -Copyright (c) 2003 by D.H. aka PodMaster. -All rights reserved. +Copyright (c) 2003-2004 by D.H. (PodMaster). All rights reserved. This module is free software; you can redistribute it and/or modify it under diff --git a/t/01_use.t b/t/01_use.t old mode 100755 new mode 100644 diff --git a/t/02_basic.t b/t/02_basic.t old mode 100755 new mode 100644 diff --git a/t/03_more.t b/t/03_more.t old mode 100755 new mode 100644 diff --git a/t/04_style_script.t b/t/04_style_script.t old mode 100755 new mode 100644 diff --git a/t/05_pi_comment.t b/t/05_pi_comment.t old mode 100755 new mode 100644 diff --git a/t/06_scrub_file.t b/t/06_scrub_file.t old mode 100755 new mode 100644 diff --git a/t/07_booleans.t b/t/07_booleans.t new file mode 100644 index 0000000..eef23af --- /dev/null +++ b/t/07_booleans.t @@ -0,0 +1,77 @@ +# 07_booleans.t + +use strict; +use File::Spec; +use Test::More tests => 10; +BEGIN { $^W = 1 } + +use_ok( 'HTML::Scrubber' ); + +use HTML::Scrubber; +my @allow = qw[ br hr b a option button th ]; +my $scrubber = HTML::Scrubber->new(); +$scrubber->allow( @allow ); +$scrubber->default( + undef, # don't change + { # default attribute rules + '/' => 1, # '/' ia boolean (stand-alone) attribute + 'pie' => 1, + 'selected' => 1, + 'disabled' => 1, + 'nowrap' => 1, + } +); + +ok( $scrubber, "got scrubber"); + +test( +q~<br> hi <br /> <a href= >~, +q~<br> hi <br /> <a>~, +"br /"); + + +test( +q~<option selected> flicka <a href=>~, +q~<option selected> flicka <a>~, +"selected"); + +test( +q~<button name="flicka" Disabled > the flicker </button>~, +q~<button disabled> the flicker </button>~, +"disabled"); + + +test( +q~<button disabled > dd </button>~, +q~<button disabled> dd </button>~, +"dd"); + + +test( +q~<a disabled pie=6> | </a>~, +q~<a disabled pie="6"> | </a>~, +"pie"); + + +test( +q~<a selected disabled selected pie pie pie disabled /> | </a>~, +q~<a selected disabled pie /> | </a>~, +"selected pie"); + +test( +q~<br pie pie=4>~, +q~<br pie="4">~, +'repeated mixed'); + +test( q~<th nowrap=nowrap>~, +q~<th nowrap="nowrap">~, +"th nowrap=nowrap"); + + + + +sub test { + my ($in, $out, $name) = @_; + is( $scrubber->scrub($in), $out, $name ); +} + -- 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
