Commit d93248bc505a32446fe16565f11259c3352b7b02 - libhtml-restrict-perl

Renames strip_comments to allow_comments. Adds allow_declaration(). Olaf Alders 12 years ago

3 changed file(s) with 55 addition(s) and 16 deletion(s). Raw diff Collapse all Expand all

+26

-8

lib/HTML/Restrict.pm less more

7	7	use HTML::Parser;
8	8	use MooseX::Params::Validate;
9	9	use Perl6::Junction qw( any );
	10
	11	has 'allow_comments' => (
	12	is => 'rw',
	13	isa => 'Bool',
	14	default => 0,
	15	);
	16
	17	has 'allow_declaration' => (
	18	is => 'rw',
	19	isa => 'Bool',
	20	default => 0,
	21	);
10	22
11	23	has 'debug' => (
12	24	is => 'rw',

28	40	is => 'ro',
29	41	lazy => 1,
30	42	builder => '_build_parser',
31		);
32
33		has 'strip_comments' => (
34		is => 'rw',
35		isa => 'Bool',
36		default => 1,
37	43	);
38	44
39	45	has 'trim' => (

110	116	sub {
111	117	my ( $p, $text ) = @_;
112	118	print "comment: $text\n" if $self->debug;
113		if ( !$self->strip_comments ) {
	119	if ( $self->allow_comments ) {
114	120	$self->_processed( ( $self->_processed \|\| q{} ) . $text );
115	121	}
116	122	},
117	123	"self,text"
118	124	],
	125
	126	declaration_h => [
	127	sub {
	128	my ( $p, $text ) = @_;
	129	print "declaration: $text\n" if $self->debug;
	130	if ( $self->allow_declaration ) {
	131	$self->_processed( ( $self->_processed \|\| q{} ) . $text );
	132	}
	133	},
	134	"self,text"
	135	],
	136
119	137
120	138	);
121	139

329	347	By default all leading and trailing spaces will be removed when text is
330	348	processed. Set this value to 0 in order to disable this behaviour.
331	349
332		For example, to preserve leading and trailing whitespace:
	350	For example, to allow leading and trailing whitespace:
333	351
334	352	$hr->trim( 0 );
335	353	my $trimmed = $hr->process(' <b>i am bold</b> ');

-8

t/comments.t less more

10	10	my $text = '<!-- comment here -->stuff';
11	11	$hr->debug( 1 );
12	12
13		is $hr->process( $text ), 'stuff', 'comments stripped';
14		$hr->strip_comments( 0 );
15		is $hr->process( $text ), $text, 'comments preserved';
	13	is $hr->process( $text ), 'stuff', 'comments allowed';
	14	$hr->allow_comments( 1 );
	15	is $hr->process( $text ), $text, 'comments allowd';
16	16
17	17	$text = 'before<!-- This is a comment -- -- So is this -->after';
18		$hr->strip_comments( 1 );
	18	$hr->allow_comments( 0 );
19	19
20		is $hr->process( $text ), 'beforeafter', 'comment stripped';
	20	is $hr->process( $text ), 'beforeafter', 'comment allowed';
21	21
22		$hr->strip_comments( 0 );
23		is $hr->process( $text ), $text, 'comments preserved';
	22	$hr->allow_comments( 1 );
	23	is $hr->process( $text ), $text, 'comments allowd';
24	24
25		$hr->strip_comments( 1 );
	25	$hr->allow_comments( 0 );
26	26	$text = '<!-- <script> <h1> -->';
27	27	is $hr->process( $text ), undef, 'tags nested in comments removed';
28	28

+21

-0

t/declaration.t less more

	0	#!/usr/bin/env perl
	1
	2	use warnings;
	3	use strict;
	4
	5	use HTML::Restrict;
	6	use Test::More;
	7
	8	my $hr = HTML::Restrict->new;
	9
	10	my $text = '<!DOCTYPE HTML> ';
	11	$hr->debug( 1 );
	12
	13	is $hr->process( $text ), '', 'declaration not preserved';
	14	$hr->allow_declaration( 1 );
	15	is $hr->process( $text ), '<!DOCTYPE HTML>', 'declaration is preserved';
	16
	17	$text = '<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">';
	18	is $hr->process( $text ), $text, 'declaration preserved';
	19
	20	done_testing();