[libhtml-scrubber-perl] 01/01: Imported from HTML-Scrubber-0.07.tar.gz.
Florian Schlichting
fsfs at moszumanska.debian.org
Sat Nov 11 13:46:00 UTC 2017
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. <podmaster at cpan.org>
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
More information about the Pkg-perl-cvs-commits
mailing list