[libhtml-scrubber-perl] 25/28: Apply tidy settings to whole repository
Florian Schlichting
fsfs at moszumanska.debian.org
Sat Nov 11 13:46:10 UTC 2017
This is an automated email from the git hooks/post-receive script.
fsfs pushed a commit to annotated tag release/0.12-TRIAL
in repository libhtml-scrubber-perl.
commit 7a0ae2aa9d076aa311666f8ec64d22690ac437fa
Author: Nigel Metheringham <nigelm at cpan.org>
Date: Sat Mar 14 18:06:49 2015 +0000
Apply tidy settings to whole repository
Apologies to anyone who has their patches screwed up by this - send them to me vanilla and I will happily fix them up. However by default I use a standard set of perltidy settings across my perl work - maybe just OCD but it helps me.
The settings for perltidy etc are included in the repo. For tidyall have a look at L<Code::TidyAll>
---
lib/HTML/Scrubber.pm | 364 ++++++++++++++++++++++-------------------------
t/01_use.t | 4 +-
t/03_more.t | 21 ++-
t/04_style_script.t | 23 ++-
t/05_pi_comment.t | 23 ++-
t/06_scrub_file.t | 2 +-
t/07_booleans.t | 66 +++------
t/08_cb_attrs.t | 12 +-
t/09_memory_cycle.t | 2 +-
t/rt19063_xhtml.t | 6 +-
t/rt25477_self_closing.t | 2 +-
11 files changed, 236 insertions(+), 289 deletions(-)
diff --git a/lib/HTML/Scrubber.pm b/lib/HTML/Scrubber.pm
index 210acce..14f908d 100644
--- a/lib/HTML/Scrubber.pm
+++ b/lib/HTML/Scrubber.pm
@@ -36,20 +36,20 @@ package HTML::Scrubber;
=head1 DESCRIPTION
-If you want to "scrub" or "sanitize" html input in a reliable and
-flexible fashion, then this module is for you.
+If you want to "scrub" or "sanitize" html input in a reliable and flexible
+fashion, then this module is for you.
I wasn't satisfied with HTML::Sanitizer because it is based on
-HTML::TreeBuilder, so I thought I'd write something similar that
-works directly with HTML::Parser.
+HTML::TreeBuilder, so I thought I'd write something similar that works directly
+with HTML::Parser.
=head1 METHODS
-First a note on documentation: just study the L<EXAMPLE|"EXAMPLE"> below.
-It's all the documentation you could need
+First a note on documentation: just study the L<EXAMPLE|"EXAMPLE"> below. It's
+all the documentation you could need
-Also, be sure to read all the comments as well as
-L<How does it work?|"How does it work?">.
+Also, be sure to read all the comments as well as L<How does it work?|"How does
+it work?">.
If you're new to perl, good luck to you.
@@ -61,55 +61,54 @@ use HTML::Parser 3.47 ();
use HTML::Entities;
use Scalar::Util ('weaken');
-our( @_scrub, @_scrub_fh );
+our ( @_scrub, @_scrub_fh );
# VERSION
# AUTHORITY
# 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, attrseq, text");
-(@_scrub_fh )= ( \&_scrub_fh, "self, event, tagname, attr, attrseq, text");
+(@_scrub) = ( \&_scrub, "self, event, tagname, attr, attrseq, text" );
+(@_scrub_fh) = ( \&_scrub_fh, "self, event, tagname, attr, attrseq, text" );
sub new {
my $package = shift;
- my $p = HTML::Parser->new(
- api_version => 3,
- default_h => \@_scrub,
- marked_sections => 0,
- strict_comment => 0,
- unbroken_text => 1,
- case_sensitive => 0,
+ my $p = HTML::Parser->new(
+ api_version => 3,
+ default_h => \@_scrub,
+ marked_sections => 0,
+ strict_comment => 0,
+ unbroken_text => 1,
+ case_sensitive => 0,
boolean_attribute_value => undef,
- empty_element_tags => 1,
+ empty_element_tags => 1,
);
my $self = {
- _p => $p,
- _rules => {
- '*' => 0,
- },
- _comment => 0,
- _process => 0,
- _r => "",
+ _p => $p,
+ _rules => { '*' => 0, },
+ _comment => 0,
+ _process => 0,
+ _r => "",
_optimize => 1,
- _script => 0,
- _style => 0,
+ _script => 0,
+ _style => 0,
};
$p->{"\0_s"} = bless $self, $package;
- weaken($p->{"\0_s"});
+ weaken( $p->{"\0_s"} );
return $self unless @_;
- my(%args)= @_;
+ my (%args) = @_;
- for my $f( qw[ default allow deny rules process comment ] ) {
+ for my $f (qw[ default allow deny rules process comment ]) {
next unless exists $args{$f};
- if( ref $args{$f} ) {
- $self->$f( @{ $args{$f} } ) ;
- } else {
- $self->$f( $args{$f} ) ;
+ if ( ref $args{$f} ) {
+ $self->$f( @{ $args{$f} } );
+ }
+ else {
+ $self->$f( $args{$f} );
}
}
@@ -124,9 +123,8 @@ sub new {
=cut
sub comment {
- return
- $_[0]->{_comment}
- if @_ == 1;
+ return $_[0]->{_comment}
+ if @_ == 1;
$_[0]->{_comment} = $_[1];
return;
}
@@ -138,33 +136,28 @@ sub comment {
=cut
-
sub process {
- return
- $_[0]->{_process}
- if @_ == 1;
+ return $_[0]->{_process}
+ if @_ == 1;
$_[0]->{_process} = $_[1];
return;
}
-
=head2 script
warn "script tags (and everything in between) are supressed"
if $p->script; # off by default
$p->script( 0 || 1 );
-B<**> Please note that this is implemented
-using HTML::Parser's ignore_elements function,
-so if C<script> is set to true,
-all script tags encountered will be validated like all other tags.
+B<**> Please note that this is implemented using HTML::Parser's ignore_elements
+function, so if C<script> is set to true, all script tags encountered will be
+validated like all other tags.
=cut
sub script {
- return
- $_[0]->{_script}
- if @_ == 1;
+ return $_[0]->{_script}
+ if @_ == 1;
$_[0]->{_script} = $_[1];
return;
}
@@ -175,17 +168,15 @@ sub script {
if $p->style; # off by default
$p->style( 0 || 1 );
-B<**> Please note that this is implemented
-using HTML::Parser's ignore_elements function,
-so if C<style> is set to true,
-all style tags encountered will be validated like all other tags.
+B<**> Please note that this is implemented using HTML::Parser's ignore_elements
+function, so if C<style> is set to true, all style tags encountered will be
+validated like all other tags.
=cut
sub style {
- return
- $_[0]->{_style}
- if @_ == 1;
+ return $_[0]->{_style}
+ if @_ == 1;
$_[0]->{_style} = $_[1];
return;
}
@@ -198,15 +189,14 @@ sub style {
sub allow {
my $self = shift;
- for my $k(@_){
- $self->{_rules}{lc $k}=1;
+ for my $k (@_) {
+ $self->{_rules}{ lc $k } = 1;
}
- $self->{_optimize} = 1; # each time a rule changes, reoptimize when parse
+ $self->{_optimize} = 1; # each time a rule changes, reoptimize when parse
return;
}
-
=head2 deny
$p->deny(qw[ t a g s ]);
@@ -216,11 +206,11 @@ sub allow {
sub deny {
my $self = shift;
- for my $k(@_){
- $self->{_rules}{lc $k} = 0;
+ for my $k (@_) {
+ $self->{_rules}{ lc $k } = 0;
}
- $self->{_optimize} = 1; # each time a rule changes, reoptimize when parse
+ $self->{_optimize} = 1; # each time a rule changes, reoptimize when parse
return;
}
@@ -240,22 +230,22 @@ sub deny {
...
);
-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.
+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{
+sub rules {
my $self = shift;
- my(%rules)= @_;
- for my $k(keys %rules) {
- $self->{_rules}{lc $k} = $rules{$k};
+ my (%rules) = @_;
+ for my $k ( keys %rules ) {
+ $self->{_rules}{ lc $k } = $rules{$k};
}
- $self->{_optimize} = 1; # each time a rule changes, reoptimize when parse
+ $self->{_optimize} = 1; # each time a rule changes, reoptimize when parse
return;
}
@@ -274,13 +264,12 @@ sub rules{
=cut
sub default {
- return
- $_[0]->{_rules}{'*'}
- if @_ == 1;
+ return $_[0]->{_rules}{'*'}
+ if @_ == 1;
$_[0]->{_rules}{'*'} = $_[1] if defined $_[1];
$_[0]->{_rules}{'_'} = $_[2] if defined $_[2] and ref $_[2];
- $_[0]->{_optimize} = 1; # each time a rule changes, reoptimize when parse
+ $_[0]->{_optimize} = 1; # each time a rule changes, reoptimize when parse
return;
}
@@ -297,15 +286,16 @@ sub default {
=cut
sub scrub_file {
- if(@_ > 2){
- return unless defined $_[0]->_out($_[2]);
- } else {
+ if ( @_ > 2 ) {
+ return unless defined $_[0]->_out( $_[2] );
+ }
+ else {
$_[0]->{_p}->handler( default => @_scrub );
}
- $_[0]->_optimize() ;#if $_[0]->{_optimize};
+ $_[0]->_optimize(); #if $_[0]->{_optimize};
- $_[0]->{_p}->parse_file($_[1]);
+ $_[0]->{_p}->parse_file( $_[1] );
return delete $_[0]->{_r} unless exists $_[0]->{_out};
print { $_[0]->{_out} } $_[0]->{_r} if length $_[0]->{_r};
@@ -325,15 +315,16 @@ sub scrub_file {
=cut
sub scrub {
- if(@_ > 2){
- return unless defined $_[0]->_out($_[2]);
- } else {
+ if ( @_ > 2 ) {
+ return unless defined $_[0]->_out( $_[2] );
+ }
+ else {
$_[0]->{_p}->handler( default => @_scrub );
}
- $_[0]->_optimize();# if $_[0]->{_optimize};
+ $_[0]->_optimize(); # if $_[0]->{_optimize};
- $_[0]->{_p}->parse($_[1]) if defined($_[1]);
+ $_[0]->{_p}->parse( $_[1] ) if defined( $_[1] );
$_[0]->{_p}->eof();
return delete $_[0]->{_r} unless exists $_[0]->{_out};
@@ -341,7 +332,6 @@ sub scrub {
return 1;
}
-
=for comment _out
$scrubber->_out(*STDOUT) if fileno STDOUT;
$scrubber->_out('foo.html') or die "eeek $!";
@@ -349,13 +339,14 @@ sub scrub {
=cut
sub _out {
- my($self, $o ) = @_;
+ my ( $self, $o ) = @_;
- unless( ref $o and ref \$o ne 'GLOB') {
+ unless ( ref $o and ref \$o ne 'GLOB' ) {
open my $F, '>', $o or return;
binmode $F;
$self->{_out} = $F;
- } else {
+ }
+ else {
$self->{_out} = $o;
}
@@ -364,7 +355,6 @@ sub _out {
return 1;
}
-
=for comment _validate
Uses $self->{_rules} to do attribute validation.
Takes tag, rule('_' || $tag), attrref.
@@ -372,37 +362,36 @@ Takes tag, rule('_' || $tag), attrref.
=cut
sub _validate {
- my($s, $t, $r, $a, $as) = @_;
+ my ( $s, $t, $r, $a, $as ) = @_;
return "<$t>" unless %$a;
$r = $s->{_rules}->{$r};
my %f;
- for my $k( keys %$a ) {
- my $check = exists $r->{$k}? $r->{$k} : exists $r->{'*'}? $r->{'*'} : next;
+ for my $k ( keys %$a ) {
+ my $check = exists $r->{$k} ? $r->{$k} : exists $r->{'*'} ? $r->{'*'} : next;
- if( ref $check eq 'CODE' ) {
+ 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 ) {
+ }
+ elsif ( ref $check || length($check) > 1 ) {
$f{$k} = $a->{$k} if $a->{$k} =~ m{$check};
- } elsif( $check ) {
+ }
+ elsif ($check) {
$f{$k} = $a->{$k};
}
}
- if( %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;
+ if $r = join ' ', map {
+ defined $f{$_}
+ ? qq[$_="] . encode_entities( $f{$_} ) . q["]
+ : $_; # boolean attribute (TODO?)
+ } grep { exists $f{$_} and !$seen{$_}++; } @$as;
}
return "<$t>";
@@ -410,9 +399,8 @@ sub _validate {
=for comment _scrub_str
-I<default> handler, used by both _scrub and _scrub_fh
-Moved all the common code (basically all of it) into a single routine for
-ease of maintenance
+I<default> handler, used by both _scrub and _scrub_fh Moved all the common code
+(basically all of it) into a single routine for ease of maintenance
=cut
@@ -447,10 +435,11 @@ sub _scrub_str {
elsif ( $s->{_rules}->{'*'} ) {
$place = 1;
}
- if ( $place ) {
+ if ($place) {
if ( length $text ) {
$outstr .= "</$t>";
- } else {
+ }
+ else {
substr $s->{_r}, -1, 0, ' /';
}
}
@@ -476,21 +465,21 @@ sub _scrub_str {
=for comment _scrub_fh
-I<default> handler, does the scrubbing if we're scrubbing out to a file.
-Now calls _scrub_str and pushes that out to a file.
+I<default> handler, does the scrubbing if we're scrubbing out to a file. Now
+calls _scrub_str and pushes that out to a file.
=cut
sub _scrub_fh {
- my $self = $_[0]->{"\0_s"};
+ my $self = $_[0]->{"\0_s"};
print { $self->{_out} } $self->{'_r'} if length $self->{_r};
$self->{'_r'} = _scrub_str(@_);
}
=for comment _scrub
-I<default> handler, does the scrubbing if we're returning a giant string.
-Now calls _scrub_str and appends that to the output string.
+I<default> handler, does the scrubbing if we're returning a giant string. Now
+calls _scrub_str and appends that to the output string.
=cut
@@ -500,51 +489,44 @@ sub _scrub {
}
sub _optimize {
- my($self) = @_;
+ my ($self) = @_;
- my( @ignore_elements ) = grep { not $self->{"_$_"} } qw(script style);
- $self->{_p}->ignore_elements(@ignore_elements); # if @ is empty, we reset ;)
+ my (@ignore_elements) = grep { not $self->{"_$_"} } qw(script style);
+ $self->{_p}->ignore_elements(@ignore_elements); # if @ is empty, we reset ;)
return unless $self->{_optimize};
-#sub allow
-# return unless $self->{_optimize}; # till I figure it out (huh)
- if( $self->{_rules}{'*'} ){ # default allow
- $self->{_p}->report_tags(); # so clear it
- } else {
+ #sub allow
+ # return unless $self->{_optimize}; # till I figure it out (huh)
- my(@reports) =
- grep { # report only tags we want
- $self->{_rules}{$_}
- } keys %{
- $self->{_rules}
- };
+ if ( $self->{_rules}{'*'} ) { # default allow
+ $self->{_p}->report_tags(); # so clear it
+ }
+ else {
- $self->{_p}->report_tags( # default deny, so optimize
+ my (@reports) =
+ grep { # report only tags we want
+ $self->{_rules}{$_}
+ } keys %{ $self->{_rules} };
+
+ $self->{_p}->report_tags( # default deny, so optimize
@reports
) if @reports;
}
-# sub deny
-# return unless $self->{_optimize}; # till I figure it out (huh)
- my(@ignores)=
- grep {
- not $self->{_rules}{$_}
- } grep {
- $_ ne '*'
- } keys %{
- $self->{_rules}
- };
-
- $self->{_p}->ignore_tags( # always ignore stuff we don't want
+ # sub deny
+ # return unless $self->{_optimize}; # till I figure it out (huh)
+ my (@ignores) =
+ grep { not $self->{_rules}{$_} } grep { $_ ne '*' } keys %{ $self->{_rules} };
+
+ $self->{_p}->ignore_tags( # always ignore stuff we don't want
@ignores
) if @ignores;
- $self->{_optimize}=0;
+ $self->{_optimize} = 0;
return;
}
-
1;
#print sprintf q[ '%-12s => %s,], "$_'", $h{$_} for sort keys %h;# perl!
@@ -554,14 +536,13 @@ sub _optimize {
=head1 How does it work?
-When a tag is encountered, HTML::Scrubber
-allows/denies the tag using the explicit rule if one exists.
+When a tag is encountered, HTML::Scrubber allows/denies the tag using the
+explicit rule if one exists.
If no explicit rule exists, Scrubber applies the default rule.
-If an explicit rule exists,
-but it's a simple rule(1),
-the default attribute rule is applied.
+If an explicit rule exists, but it's a simple rule(1), the default attribute
+rule is applied.
=head2 EXAMPLE
@@ -575,24 +556,25 @@ the default attribute rule is applied.
my @rules = (
script => 0,
- img => {
- src => qr{^(?!http://)}i, # only relative image links allowed
- alt => 1, # alt attribute allowed
- '*' => 0, # deny all other attributes
+ img => {
+ src => qr{^(?!http://)}i, # only relative image links allowed
+ alt => 1, # alt attribute allowed
+ '*' => 0, # deny all other attributes
},
);
my @default = (
- 0 => # default rule, deny all tags
- {
- '*' => 1, # default rule, allow all attributes
- 'href' => qr{^(?:http|https|ftp)://}i,
- 'src' => qr{^(?:http|https|ftp)://}i,
- # If your perl doesn't have qr
- # just use a string with length greater than 1
+ 0 => # default rule, deny all tags
+ {
+ '*' => 1, # default rule, allow all attributes
+ 'href' => qr{^(?:http|https|ftp)://}i,
+ 'src' => qr{^(?:http|https|ftp)://}i,
+
+ # If your perl doesn't have qr
+ # just use a string with length greater than 1
'cite' => '(?i-xsm:^(?:http|https|ftp):)',
'language' => 0,
- 'name' => 1, # could be sneaky, but hey ;)
+ 'name' => 1, # could be sneaky, but hey ;)
'onblur' => 0,
'onchange' => 0,
'onclick' => 0,
@@ -614,14 +596,14 @@ the default attribute rule is applied.
'onunload' => 0,
'src' => 0,
'type' => 0,
- }
+ }
);
my $scrubber = HTML::Scrubber->new();
- $scrubber->allow( @allow );
- $scrubber->rules( @rules ); # key/value pairs
- $scrubber->default( @default );
- $scrubber->comment(1); # 1 allow, 0 deny
+ $scrubber->allow(@allow);
+ $scrubber->rules(@rules); # key/value pairs
+ $scrubber->default(@default);
+ $scrubber->comment(1); # 1 allow, 0 deny
## preferred way to create the same object
$scrubber = HTML::Scrubber->new(
@@ -632,7 +614,7 @@ the default attribute rule is applied.
process => 0,
);
- require Data::Dumper,die Data::Dumper::Dumper($scrubber) if @ARGV;
+ require Data::Dumper, die Data::Dumper::Dumper($scrubber) if @ARGV;
my $it = q[
<?php echo(" EVIL EVIL EVIL "); ?> <!-- asdf -->
@@ -648,21 +630,13 @@ the default attribute rule is applied.
</A> <br>
];
- print "#original text",$/, $it, $/;
+ print "#original text", $/, $it, $/;
print
- "#scrubbed text (default ",
- $scrubber->default(), # no arguments returns the current value
- " comment ",
- $scrubber->comment(),
- " process ",
- $scrubber->process(),
- " )",
- $/,
- $scrubber->scrub($it),
- $/;
+ "#scrubbed text (default ", $scrubber->default(), # no arguments returns the current value
+ " comment ", $scrubber->comment(), " process ", $scrubber->process(), " )", $/, $scrubber->scrub($it), $/;
- $scrubber->default(1); # allow all tags by default
- $scrubber->comment(0); # deny comments
+ $scrubber->default(1); # allow all tags by default
+ $scrubber->comment(0); # deny comments
print
"#scrubbed text (default ",
@@ -671,15 +645,14 @@ the default attribute rule is applied.
$scrubber->comment(),
" process ",
$scrubber->process(),
- " )",
- $/,
+ " )", $/,
$scrubber->scrub($it),
$/;
- $scrubber->process(1); # allow process instructions (dangerous)
- $default[0] = 1; # allow all tags by default
- $default[1]->{'*'} = 0; # deny all attributes by default
- $scrubber->default(@default); # set the default again
+ $scrubber->process(1); # allow process instructions (dangerous)
+ $default[0] = 1; # allow all tags by default
+ $default[1]->{'*'} = 0; # deny all attributes by default
+ $scrubber->default(@default); # set the default again
print
"#scrubbed text (default ",
@@ -688,8 +661,7 @@ the default attribute rule is applied.
$scrubber->comment(),
" process ",
$scrubber->process(),
- " )",
- $/,
+ " )", $/,
$scrubber->scrub($it),
$/;
@@ -707,6 +679,14 @@ If you have Test::Inline (and you've installed HTML::Scrubber), try
L<HTML::Parser>, L<Test::Inline>.
-The HTML::Sanitizer module is no longer available on CPAN.
+The C<HTML::Sanitizer> module is no longer available on CPAN.
+
+=head1 CONTRIBUTING
+
+If you want to contribute to the development of this module, the code is on
+L<GitHub|http://github.com/nigelm/html-scrubber>. You'll need a perl
+environment with L<Dist::Zilla>, and if you're just getting started, there's
+some documentation on using Vagrant and Perlbrew
+L<here|http://mrcaron.github.io/2015/03/06/Perl-CPAN-Pull-Request.html>.
=cut
diff --git a/t/01_use.t b/t/01_use.t
index d31aa24..6bf5370 100644
--- a/t/01_use.t
+++ b/t/01_use.t
@@ -3,7 +3,7 @@
use Test::More tests => 1;
BEGIN {
- use_ok( 'HTML::Scrubber' ) || print "Bail out!\n";
+ use_ok('HTML::Scrubber') || print "Bail out!\n";
}
-diag( "Testing HTML::Scrubber $HTML::Scrubber::VERSION, Perl $], $^X" );
+diag("Testing HTML::Scrubber $HTML::Scrubber::VERSION, Perl $], $^X");
diff --git a/t/03_more.t b/t/03_more.t
index 52554ae..4fed43a 100644
--- a/t/03_more.t
+++ b/t/03_more.t
@@ -1,17 +1,16 @@
# perl Makefile.PL && nmake realclean && cls && perl Makefile.PL && nmake test
# cpan-upload -mailto yo at yo.yo -verbose -user podmaster HTML-Scrubber-0.04.tar.gz
-
use strict;
use Test::More tests => 7;
BEGIN { $^W = 1 }
-use_ok( 'HTML::Scrubber' );
+use_ok('HTML::Scrubber');
-my $s = HTML::Scrubber->new;
+my $s = HTML::Scrubber->new;
my $html = q[<a href=1>link </a><br><B> bold </B><U> UNDERLINE </U>];
-isa_ok($s, 'HTML::Scrubber');
+isa_ok( $s, 'HTML::Scrubber' );
$s->rules( 'font' => { face => 1 } );
@@ -21,26 +20,24 @@ $s->allow(qw[ U ]);
#use Data::Dumper;warn $/,Dumper($s);
-is( $s->scrub($html), q[link bold <u> UNDERLINE </u>],'only U');
+is( $s->scrub($html), q[link bold <u> UNDERLINE </u>], 'only U' );
$s->allow(qw[ B U ]);
#use Data::Dumper;warn $/,Dumper($s);
-is( $s->scrub($html), q[link <b> bold </b><u> UNDERLINE </u>],'B and U');
+is( $s->scrub($html), q[link <b> bold </b><u> UNDERLINE </u>], 'B and U' );
$s->allow(qw[ A B ]);
$s->deny('U');
-$s->default(0,{ '*'=> 1});
+$s->default( 0, { '*' => 1 } );
#use Data::Dumper;warn $/,Dumper($s);
-is( $s->scrub($html), q[<a href="1">link </a><b> bold </b> UNDERLINE ],'A and B');
+is( $s->scrub($html), q[<a href="1">link </a><b> bold </b> UNDERLINE ], 'A and B' );
-$s = HTML::Scrubber->new(
- default => [ 1, { '*' => 1 } ]
-);
+$s = HTML::Scrubber->new( default => [ 1, { '*' => 1 } ] );
-is( $s->scrub($html), q[<a href="1">link </a><br><b> bold </b><u> UNDERLINE </u>], 'A B U and BR');
+is( $s->scrub($html), q[<a href="1">link </a><br><b> bold </b><u> UNDERLINE </u>], 'A B U and BR' );
#use Data::Dumper;warn $/,Dumper($s);
diff --git a/t/04_style_script.t b/t/04_style_script.t
index f1c5130..beea13a 100644
--- a/t/04_style_script.t
+++ b/t/04_style_script.t
@@ -4,24 +4,21 @@ use strict;
use Test::More tests => 9;
BEGIN { $^W = 1 }
-use_ok( 'HTML::Scrubber' );
+use_ok('HTML::Scrubber');
-my $s = HTML::Scrubber->new;
+my $s = HTML::Scrubber->new;
my $html = q[start <style>in the style</style> middle <script>in the script</script> end];
-isa_ok($s, 'HTML::Scrubber');
-
-is( $s->script, 0, 'script off by default');
-is( $s->style, 0, 'style off by default');
-is( $s->scrub($html), 'start middle end', 'default (no style no script)');
+isa_ok( $s, 'HTML::Scrubber' );
+is( $s->script, 0, 'script off by default' );
+is( $s->style, 0, 'style off by default' );
+is( $s->scrub($html), 'start middle end', 'default (no style no script)' );
$s->script(1);
-is( $s->script, 1, 'script on');
-is( $s->scrub($html), 'start middle in the script end', 'script off');
-
-
+is( $s->script, 1, 'script on' );
+is( $s->scrub($html), 'start middle in the script end', 'script off' );
$s->style(1);
-is( $s->style, 1, 'style on');
-is( $s->scrub($html), 'start in the style middle in the script end', 'style off and script off');
\ No newline at end of file
+is( $s->style, 1, 'style on' );
+is( $s->scrub($html), 'start in the style middle in the script end', 'style off and script off' );
diff --git a/t/05_pi_comment.t b/t/05_pi_comment.t
index 7514fe6..40417d3 100644
--- a/t/05_pi_comment.t
+++ b/t/05_pi_comment.t
@@ -4,24 +4,21 @@ use strict;
use Test::More tests => 9;
BEGIN { $^W = 1 }
-use_ok( 'HTML::Scrubber' );
+use_ok('HTML::Scrubber');
-my $s = HTML::Scrubber->new;
+my $s = HTML::Scrubber->new;
my $html = q[start <!--comment--> mid1 <?html pi> mid2 <?xml pi?> end];
-isa_ok($s, 'HTML::Scrubber');
-
-is( $s->comment, 0, 'comment off by default');
-is( $s->process, 0, 'process off by default');
-is( $s->scrub($html), 'start mid1 mid2 end');
+isa_ok( $s, 'HTML::Scrubber' );
+is( $s->comment, 0, 'comment off by default' );
+is( $s->process, 0, 'process off by default' );
+is( $s->scrub($html), 'start mid1 mid2 end' );
$s->comment(1);
-is( $s->comment, 1, 'comment on');
-is( $s->scrub($html), 'start <!--comment--> mid1 mid2 end', 'comment on');
-
-
+is( $s->comment, 1, 'comment on' );
+is( $s->scrub($html), 'start <!--comment--> mid1 mid2 end', 'comment on' );
$s->process(1);
-is( $s->process, 1, 'process on');
-is( $s->scrub($html), 'start <!--comment--> mid1 <?html pi> mid2 <?xml pi?> end', 'process on');
\ No newline at end of file
+is( $s->process, 1, 'process on' );
+is( $s->scrub($html), 'start <!--comment--> mid1 <?html pi> mid2 <?xml pi?> end', 'process on' );
diff --git a/t/06_scrub_file.t b/t/06_scrub_file.t
index 5a9612b..a970be5 100644
--- a/t/06_scrub_file.t
+++ b/t/06_scrub_file.t
@@ -17,7 +17,7 @@ my $tmpdir = tempdir( CLEANUP => 1 );
SKIP: {
skip "no writable temporary directory found", 6
unless length $tmpdir
- and -d $tmpdir;
+ and -d $tmpdir;
my $template = 'html-scrubber-XXXX';
my ( $tfh, $tmpfile ) = tempfile( $template, DIR => $tmpdir, SUFFIX => '.html' );
diff --git a/t/07_booleans.t b/t/07_booleans.t
index a36b65a..713f7dc 100644
--- a/t/07_booleans.t
+++ b/t/07_booleans.t
@@ -5,72 +5,52 @@ use File::Spec;
use Test::More tests => 9;
BEGIN { $^W = 1 }
-use_ok( 'HTML::Scrubber' );
+use_ok('HTML::Scrubber');
use HTML::Scrubber;
-my @allow = qw[ br hr b a option button th ];
+my @allow = qw[ br hr b a option button th ];
my $scrubber = HTML::Scrubber->new();
-$scrubber->allow( @allow );
+$scrubber->allow(@allow);
$scrubber->default(
- undef, # don't change
- { # default attribute rules
- '/' => 1, # '/' ia boolean (stand-alone) attribute
- 'pie' => 1,
+ undef, # don't change
+ { # default attribute rules
+ '/' => 1, # '/' ia boolean (stand-alone) attribute
+ 'pie' => 1,
'selected' => 1,
'disabled' => 1,
- 'nowrap' => 1,
+ 'nowrap' => 1,
}
);
-ok( $scrubber, "got scrubber");
-
-test(
-q~<br> hi <br /> <a href= >~,
-q~<br> hi <br /> <a>~,
-"br /");
+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~<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");
-
+ q~<button name="flicka" Disabled > the flicker </button>~,
+ q~<button disabled> the flicker </button>~,
+ "disabled"
+);
-test(
-q~<a disabled pie=6> | </a>~,
-q~<a disabled pie="6"> | </a>~,
-"pie");
+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");
-
+ q~<a selected disabled selected pie pie pie disabled /> | </a>~,
+ q~<a selected disabled pie /> | </a>~,
+ "selected pie"
+);
#dependent on version of HTML::Parser, after 0.36 1st is returned (ie 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");
-
-
-
+test( q~<th nowrap=nowrap>~, q~<th nowrap="nowrap">~, "th nowrap=nowrap" );
sub test {
- my ($in, $out, $name) = @_;
+ my ( $in, $out, $name ) = @_;
is( $scrubber->scrub($in), $out, $name );
}
diff --git a/t/08_cb_attrs.t b/t/08_cb_attrs.t
index f7545da..7fb874a 100644
--- a/t/08_cb_attrs.t
+++ b/t/08_cb_attrs.t
@@ -9,20 +9,20 @@ my $scrubber = HTML::Scrubber->new;
$scrubber->default(1);
my $cb = sub {
- my ($self, $tag, $attr, $avalue) = @_;
+ my ( $self, $tag, $attr, $avalue ) = @_;
my %h = (
drop => [],
bool => [undef],
empty => [''],
foo => ['bar'],
);
- return @{ $h{ $avalue } };
+ 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");
+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;
diff --git a/t/09_memory_cycle.t b/t/09_memory_cycle.t
index 4fe973c..d49b97e 100644
--- a/t/09_memory_cycle.t
+++ b/t/09_memory_cycle.t
@@ -6,4 +6,4 @@ use HTML::Scrubber;
my $scrubber = HTML::Scrubber->new();
-memory_cycle_ok($scrubber, "Scrubber has no cycles");
+memory_cycle_ok( $scrubber, "Scrubber has no cycles" );
diff --git a/t/rt19063_xhtml.t b/t/rt19063_xhtml.t
index 39f6874..463e966 100644
--- a/t/rt19063_xhtml.t
+++ b/t/rt19063_xhtml.t
@@ -9,10 +9,6 @@ use HTML::Scrubber;
my $scrubber = HTML::Scrubber->new;
$scrubber->default(1);
-is(
- $scrubber->scrub('<hr/><hr><hr /><hr></hr>'),
- '<hr /><hr><hr /><hr></hr>',
- "correct result"
-);
+is( $scrubber->scrub('<hr/><hr><hr /><hr></hr>'), '<hr /><hr><hr /><hr></hr>', "correct result" );
done_testing;
diff --git a/t/rt25477_self_closing.t b/t/rt25477_self_closing.t
index a939caa..4dee117 100644
--- a/t/rt25477_self_closing.t
+++ b/t/rt25477_self_closing.t
@@ -18,7 +18,7 @@ my $scrubbed = $scrubber->scrub( <<'END' );
<b>two</b>
END
-is($scrubbed, <<'END', "correct result");
+is( $scrubbed, <<'END', "correct result" );
<b>one</b>
--
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