1#!/usr/bin/perl -T
2
3use warnings;
4use strict;
5
6#Test that we can build and compare trees
7
8use Test::More tests => 46;
9
10use HTML::Element;
11
12FIRST_BLOCK: {
13    my $lol = [
14        'html',
15        [ 'head', [ 'title', 'I like stuff!' ], ],
16        [   'body', { 'lang', 'en-JP' },
17            'stuff',
18            [ 'p', 'um, p < 4!', { 'class' => 'par123' } ],
19            [ 'div', { foo => 'bar' }, ' 1  2  3 ' ],        # at 0.1.2
20            [ 'div', { fu  => 'baa' }, " 1 and 2 \xA0 3 " ], # RT #26436 test
21            ['hr'],
22        ]
23    ];
24    my $t1 = HTML::Element->new_from_lol($lol);
25    isa_ok( $t1, 'HTML::Element' );
26
27    ### added to test ->is_empty() and ->look_up()
28    my $hr = $t1->find('hr');
29    isa_ok( $hr, 'HTML::Element' );
30    ok( $hr->is_empty(), "testing is_empty method on <hr> tag" );
31    my $lookuptag = $hr->look_up( "_tag", "body" );
32    is( '<body lang="en-JP">',
33        $lookuptag->starttag(), "verify hr->look_up found body tag" );
34    my %attrs  = $lookuptag->all_attr();
35    my @attrs1 = sort keys %attrs;
36    my @attrs2 = sort $lookuptag->all_attr_names();
37    is_deeply( \@attrs1, \@attrs2, "is_deeply attrs" );
38
39    # Test scalar context
40    my $count = $t1->content_list;
41    is( $count, 2, "Works in scalar" );
42
43    # Test list context
44    my @list = $t1->content_list;
45    is( scalar @list, 2, "Should get two items back" );
46    isa_ok( $list[0], 'HTML::Element' );
47    isa_ok( $list[1], 'HTML::Element' );
48
49    my $div = $t1->find_by_attribute( 'foo', 'bar' );
50    isa_ok( $div, 'HTML::Element' );
51
52    ### tests of various output formats
53    is( $div->as_text(), " 1  2  3 ", "Dump element in text format" );
54    is( $div->as_trimmed_text(), "1 2 3",
55        "Dump element in trimmed text format" );
56    is( $div->as_text_trimmed(), "1 2 3",
57        "Dump element in trimmed text format" );
58    is( $div->as_Lisp_form(),
59        qq{("_tag" "div" "foo" "bar" "_content" (\n  " 1  2  3 "))\n},
60        "Dump element as Lisp form"
61    );
62
63    is( $div->address, '0.1.2' );
64    is( $div, $t1->address('0.1.2'), 'using address to get the node' );
65    ok( $div->same_as($div) );
66    ok( $t1->same_as($t1) );
67    ok( not( $div->same_as($t1) ) );
68
69    my $div2 = $t1->find_by_attribute( 'fu', 'baa' );
70    isa_ok( $div2, 'HTML::Element' );
71
72    ### test for RT #26436 user controlled white space
73    is( $div2->as_text(), " 1 and 2 \xA0 3 ", "Dump element in text format" );
74    is( $div2->as_trimmed_text(),
75        "1 and 2 \xA0 3", "Dump element in trimmed text format" );
76    is( $div2->as_trimmed_text( extra_chars => 'a-z\xA0' ),
77        "1 2 3", "Dump element in trimmed text format without nbsp or letters");
78    is( $div2->as_trimmed_text( extra_chars => '[:alpha:]' ),
79        "1 2 \xA0 3", "Dump element in trimmed text format without letters");
80
81    my $t2 = HTML::Element->new_from_lol($lol);
82    isa_ok( $t2, 'HTML::Element' );
83    ok( $t2->same_as($t1) );
84    $t2->address('0.1.2')->attr( 'snap', 123 );
85    ok( not( $t2->same_as($t1) ) );
86
87    my $body = $t1->find_by_tag_name('body');
88    isa_ok( $body, 'HTML::Element' );
89    is( $body->tag, 'body' );
90
91    my $cl = join '~', $body->content_list;
92    my @detached = $body->detach_content;
93    is( $cl, join '~', @detached );
94    $body->push_content(@detached);
95    is( $cl, join '~', $body->content_list );
96
97    $t2->delete;
98    $t1->delete;
99}    # FIRST_BLOCK
100
101TEST2: {    # for normalization
102    my $t1 = HTML::Element->new_from_lol( [ 'p', 'stuff', ['hr'], 'thing' ] );
103    my @start = $t1->content_list;
104    is( scalar(@start), 3 );
105    my $lr = $t1->content;
106
107    # $lr is ['stuff', HTML::Element('hr'), 'thing']
108    is( $lr->[0], 'stuff' );
109    isa_ok( $lr->[1], 'HTML::Element' );
110    is( $lr->[2], 'thing' );
111
112    # insert some undefs
113    splice @$lr, 1, 0, undef;    # insert an undef between [0] and [1]
114    push @$lr, undef;            # append an undef to the end
115    unshift @$lr, undef;         # prepend an undef to the front
116         # $lr is [undef, 'stuff', undef, H::E('hr'), 'thing', undef]
117
118UNNORMALIZED: {
119        my $cl_count = $t1->content_list;
120        my @cl       = $t1->content_list;
121        is( $cl_count,   6 );
122        is( scalar(@cl), $cl_count );    # also == 6
123        {
124            no warnings;                 # content_list contains undefs
125            isnt( join( '~', @start ), join( '~', $t1->content_list ) );
126        }
127    }
128
129NORMALIZED: {
130        $t1->normalize_content;
131        my @cl = $t1->content_list;
132        eq_array( \@start, \@cl );
133    }
134
135    ok( not defined( $t1->attr('foo') ) );
136    $t1->attr( 'foo', 'bar' );
137    is( $t1->attr('foo'), 'bar' );
138    ok( scalar( grep( 'bar', $t1->all_external_attr() ) ) );
139    $t1->attr( 'foo', '' );
140    ok( scalar( grep( 'bar', $t1->all_external_attr() ) ) );
141    $t1->attr( 'foo', undef );    # should delete it
142    ok( not grep( 'bar', $t1->all_external_attr() ) );
143    $t1->delete;
144}    # TEST2
145
146EXTRA_CHARS_IS_FALSE: {
147    my $h = HTML::Element->new_from_lol([p => '1  2 0  4']);
148    is( $h->as_text, '1  2 0  4', "Dump p in text format" );
149    is( $h->as_trimmed_text, '1 2 0 4', "Dump p in trimmed format" );
150    is( $h->as_trimmed_text(extra_chars => '0'), '1 2 4',
151        "Dump p in trimmed format without 0" );
152}
153