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