← Back to branch summary

~ubuntu-branches/ubuntu/saucy/libhtml-stripscripts-perl/saucy

« back to all changes in this revision

Viewing changes to t/62rules_callbacks.t

  • Committer: Bazaar Package Importer
  • Author(s): Tim Retout
  • Date: 2008-08-07 17:21:30 UTC
  • Revision ID: james.westby@ubuntu.com-20080807172130-3l9o4bwl9ftodfqh
Tags: upstream-1.04
Import upstream version 1.04

Show diffs side-by-side

added added

removed removed

Lines of Context:
t/62rules_callbacks.t
 
1
use strict;
 
2
use Test::More tests => 11;
 
3
 
 
4
BEGIN {
 
5
     $^W = 1;
 
6
     eval "require Data::Dumper; import Data::Dumper";
 
7
     $@ and eval "sub Dumper {'Install Data::Dumper for detailed diagnostics'}";
 
8
}
 
9
 
 
10
use HTML::StripScripts;
 
11
 
 
12
## test required attributes
 
13
my %results;
 
14
 
 
15
foreach my $test ( sort keys %results ) {
 
16
    my $callback;
 
17
    {
 
18
        no strict 'refs';
 
19
        $callback = \&$test;
 
20
    }
 
21
    my $Rules =
 
22
        $test =~ /^attr/
 
23
        ? { p => { align => $callback } }
 
24
        : { p => $callback };
 
25
    test_callback( $test, $Rules, $results{$test} );
 
26
}
 
27
 
 
28
BEGIN {
 
29
    %results = (
 
30
        attr_accept    => '<p align="right">Normal<b>Bold</b></p>',
 
31
        attr_reject    => '<p>Normal<b>Bold</b></p>',
 
32
        attr_empty     => '<p align="">Normal<b>Bold</b></p>',
 
33
        attr_change    => '<p align="left">Normal<b>Bold</b></p>',
 
34
        tag_accept     => '<p align="right">Normal<b>Bold</b></p>',
 
35
        tag_reject_all => '',
 
36
        tag_remove_tag => 'Normal<b>Bold</b>',
 
37
        tag_change_attrs =>
 
38
            '<p style="text-align:right">Normal<b>Bold</b></p>',
 
39
        tag_change_tag =>
 
40
            '<blockquote align="right">Normal<b>Bold</b></blockquote>',
 
41
        tag_change_content => '<p align="right">Replaced Content</p>',
 
42
        tag_add_tag =>
 
43
            '<p align="right"><span style="color:red">Normal<b>Bold</b></span></p>'
 
44
        ,
 
45
    );
 
46
}
 
47
 
 
48
#===================================
 
49
sub test_callback {
 
50
#===================================
 
51
    my ( $test, $Rules, $result ) = @_;
 
52
    my $f = HTML::StripScripts->new( { Rules => $Rules } );
 
53
 
 
54
    $f->input_start_document;
 
55
    $f->input_start('<p align="right">');
 
56
    $f->input_text('Normal');
 
57
    $f->input_start('<b>');
 
58
    $f->input_text('Bold');
 
59
    $f->input_end('</b>');
 
60
    $f->input_end('</p>');
 
61
    $f->input_end_document;
 
62
    is( $f->filtered_document, $result, "$test" )
 
63
        or diag( Dumper( $Rules, $f->{_hssRules} ) );
 
64
}
 
65
 
 
66
#===================================
 
67
sub attr_accept {
 
68
#===================================
 
69
    my ( $filter, $tag, $attr, $val ) = @_;
 
70
    return $val;
 
71
}
 
72
 
 
73
#===================================
 
74
sub attr_reject {
 
75
#===================================
 
76
    my ( $filter, $tag, $attr, $val ) = @_;
 
77
    return;
 
78
}
 
79
 
 
80
#===================================
 
81
sub attr_empty {
 
82
#===================================
 
83
    my ( $filter, $tag, $attr, $val ) = @_;
 
84
    return '';
 
85
}
 
86
 
 
87
#===================================
 
88
sub attr_change {
 
89
#===================================
 
90
    my ( $filter, $tag, $attr, $val ) = @_;
 
91
    return 'left';
 
92
}
 
93
 
 
94
#===================================
 
95
sub tag_accept {
 
96
#===================================
 
97
    my ( $filter, $element ) = @_;
 
98
    return 1;
 
99
}
 
100
 
 
101
#===================================
 
102
sub tag_reject_all {
 
103
#===================================
 
104
    my ( $filter, $element ) = @_;
 
105
    return 0;
 
106
}
 
107
 
 
108
#===================================
 
109
sub tag_remove_tag {
 
110
#===================================
 
111
    my ( $filter, $element ) = @_;
 
112
    $element->{tag} = '';
 
113
    return 1;
 
114
}
 
115
 
 
116
#===================================
 
117
sub tag_change_attrs {
 
118
#===================================
 
119
    my ( $filter, $element ) = @_;
 
120
    my $attr = $element->{attr};
 
121
    if ( my $align = delete $attr->{align} ) {
 
122
        $attr->{style} = join( ';',
 
123
                               grep { defined $_ } $attr->{style},
 
124
                               'text-align:' . $align );
 
125
    }
 
126
    return 1;
 
127
}
 
128
 
 
129
#===================================
 
130
sub tag_change_tag {
 
131
#===================================
 
132
    my ( $filter, $element ) = @_;
 
133
    $element->{tag} = 'blockquote';
 
134
    return 1;
 
135
}
 
136
 
 
137
#===================================
 
138
sub tag_change_content {
 
139
#===================================
 
140
    my ( $filter, $element ) = @_;
 
141
    $element->{content} = 'Replaced Content';
 
142
    return 1;
 
143
}
 
144
 
 
145
#===================================
 
146
sub tag_add_tag {
 
147
#===================================
 
148
    my ( $filter, $element ) = @_;
 
149
    $element->{content}
 
150
        = '<span style="color:red">' . $element->{content} . '</span>';
 
151
    return 1;
 
152
}
 
153