HTML-StripScripts

 view release on metacpan or  search on metacpan

t/30subclass.t  view on Meta::CPAN

    sub reject_end {
        my ($self, $text) = @_;

    $self->output_text( $self->escape_html_metachars($text) );
    }
}
$f = SubClass_reject_end->new;
$f->input_start_document;
$f->input_text('foo');
$f->input_end('</i>');
$f->input_end_document;
is( $f->filtered_document, 'foo&lt;/i&gt;', 'subclass reject end' );

=item reject_text

Overriding reject_text() so that rejected non-tag text is replaced with
a different HTML comment than the default.

=cut

{
    package SubClass_reject_text;
    use base qw(HTML::StripScripts);

    sub reject_text {
        my ($self, $text) = @_;

    $self->output_comment('<!--foo-->');
    }
}
$f = SubClass_reject_text->new({ Context => 'Document' });
$f->input_start_document;
$f->input_start('<html>');
$f->input_start('<head>');
$f->input_text('bah');
$f->input_end('</head>');
$f->input_text('foo');
$f->input_end_document;
is( $f->filtered_document, '<html><head><!--foo--></head><body>foo</body></html>',
                           'subclass reject_text' );

=item reject_decalaration

Overriding reject_decalaration() so that rejected declarations are replaced
with custom text.

=cut

{
    package SubClass_reject_declaration;
    use base qw(HTML::StripScripts);

    sub reject_declaration {
        my ($self, $text) = @_;

    $self->output_declaration('<! FOO >');
    }
}
$f = SubClass_reject_declaration->new;
$f->input_start_document;
$f->input_declaration('<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
    "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">');
$f->input_text('foo');
$f->input_end_document;
is( $f->filtered_document, '<! FOO >foo', 'subclass reject_decalaration' );

=item reject_comment

Overriding reject_comment() so that rejected HTML comments are replaced
with custom text.

=cut

{
    package SubClass_reject_comment;
    use base qw(HTML::StripScripts);

    sub reject_comment {
        my ($self, $text) = @_;

    $self->output_comment('<!--foo-->');
    }
}
$f = SubClass_reject_comment->new;
$f->input_start_document;
$f->input_text('foo');
$f->input_comment('<!--# exec foo -->');
$f->input_text('foo');
$f->input_end_document;
is( $f->filtered_document, 'foo<!--foo-->foo', 'subclass reject_comment' );

=item reject_process

Overriding reject_process() so that rejected processing instructions are
replaced with custom text.

=cut

{
    package SubClass_reject_process;
    use base qw(HTML::StripScripts);

    sub reject_process {
        my ($self, $text) = @_;

    $self->output_process('<? FOO ?>');
    }
}
$f = SubClass_reject_process->new;
$f->input_start_document;
$f->input_process('<?xml version="1.0" encoding="iso-8859-1"?>');
$f->input_text('foo');
$f->input_end_document;
is( $f->filtered_document, '<? FOO ?>foo', 'subclass reject_process' );

=item init_context_whitelist

Overriding init_context_whitelist() so that the filter will allow C<ins>
tags only at C<Flow> level.




( run in 2.496 seconds using v1.01-cache-2.11-cpan-119454b85a5 )