|
Packit |
16975c |
#!/usr/bin/perl -T
|
|
Packit |
16975c |
|
|
Packit |
16975c |
use warnings;
|
|
Packit |
16975c |
use strict;
|
|
Packit |
16975c |
|
|
Packit |
16975c |
#Test that we can build and compare trees
|
|
Packit |
16975c |
|
|
Packit |
16975c |
use Test::More tests => 46;
|
|
Packit |
16975c |
|
|
Packit |
16975c |
use HTML::Element;
|
|
Packit |
16975c |
|
|
Packit |
16975c |
FIRST_BLOCK: {
|
|
Packit |
16975c |
my $lol = [
|
|
Packit |
16975c |
'html',
|
|
Packit |
16975c |
[ 'head', [ 'title', 'I like stuff!' ], ],
|
|
Packit |
16975c |
[ 'body', { 'lang', 'en-JP' },
|
|
Packit |
16975c |
'stuff',
|
|
Packit |
16975c |
[ 'p', 'um, p < 4!', { 'class' => 'par123' } ],
|
|
Packit |
16975c |
[ 'div', { foo => 'bar' }, ' 1 2 3 ' ], # at 0.1.2
|
|
Packit |
16975c |
[ 'div', { fu => 'baa' }, " 1 and 2 \xA0 3 " ], # RT #26436 test
|
|
Packit |
16975c |
['hr'],
|
|
Packit |
16975c |
]
|
|
Packit |
16975c |
];
|
|
Packit |
16975c |
my $t1 = HTML::Element->new_from_lol($lol);
|
|
Packit |
16975c |
isa_ok( $t1, 'HTML::Element' );
|
|
Packit |
16975c |
|
|
Packit |
16975c |
### added to test ->is_empty() and ->look_up()
|
|
Packit |
16975c |
my $hr = $t1->find('hr');
|
|
Packit |
16975c |
isa_ok( $hr, 'HTML::Element' );
|
|
Packit |
16975c |
ok( $hr->is_empty(), "testing is_empty method on tag" );
|
|
Packit |
16975c |
my $lookuptag = $hr->look_up( "_tag", "body" );
|
|
Packit |
16975c |
is( '<body lang="en-JP">',
|
|
Packit |
16975c |
$lookuptag->starttag(), "verify hr->look_up found body tag" );
|
|
Packit |
16975c |
my %attrs = $lookuptag->all_attr();
|
|
Packit |
16975c |
my @attrs1 = sort keys %attrs;
|
|
Packit |
16975c |
my @attrs2 = sort $lookuptag->all_attr_names();
|
|
Packit |
16975c |
is_deeply( \@attrs1, \@attrs2, "is_deeply attrs" );
|
|
Packit |
16975c |
|
|
Packit |
16975c |
# Test scalar context
|
|
Packit |
16975c |
my $count = $t1->content_list;
|
|
Packit |
16975c |
is( $count, 2, "Works in scalar" );
|
|
Packit |
16975c |
|
|
Packit |
16975c |
# Test list context
|
|
Packit |
16975c |
my @list = $t1->content_list;
|
|
Packit |
16975c |
is( scalar @list, 2, "Should get two items back" );
|
|
Packit |
16975c |
isa_ok( $list[0], 'HTML::Element' );
|
|
Packit |
16975c |
isa_ok( $list[1], 'HTML::Element' );
|
|
Packit |
16975c |
|
|
Packit |
16975c |
my $div = $t1->find_by_attribute( 'foo', 'bar' );
|
|
Packit |
16975c |
isa_ok( $div, 'HTML::Element' );
|
|
Packit |
16975c |
|
|
Packit |
16975c |
### tests of various output formats
|
|
Packit |
16975c |
is( $div->as_text(), " 1 2 3 ", "Dump element in text format" );
|
|
Packit |
16975c |
is( $div->as_trimmed_text(), "1 2 3",
|
|
Packit |
16975c |
"Dump element in trimmed text format" );
|
|
Packit |
16975c |
is( $div->as_text_trimmed(), "1 2 3",
|
|
Packit |
16975c |
"Dump element in trimmed text format" );
|
|
Packit |
16975c |
is( $div->as_Lisp_form(),
|
|
Packit |
16975c |
qq{("_tag" "div" "foo" "bar" "_content" (\n " 1 2 3 "))\n},
|
|
Packit |
16975c |
"Dump element as Lisp form"
|
|
Packit |
16975c |
);
|
|
Packit |
16975c |
|
|
Packit |
16975c |
is( $div->address, '0.1.2' );
|
|
Packit |
16975c |
is( $div, $t1->address('0.1.2'), 'using address to get the node' );
|
|
Packit |
16975c |
ok( $div->same_as($div) );
|
|
Packit |
16975c |
ok( $t1->same_as($t1) );
|
|
Packit |
16975c |
ok( not( $div->same_as($t1) ) );
|
|
Packit |
16975c |
|
|
Packit |
16975c |
my $div2 = $t1->find_by_attribute( 'fu', 'baa' );
|
|
Packit |
16975c |
isa_ok( $div2, 'HTML::Element' );
|
|
Packit |
16975c |
|
|
Packit |
16975c |
### test for RT #26436 user controlled white space
|
|
Packit |
16975c |
is( $div2->as_text(), " 1 and 2 \xA0 3 ", "Dump element in text format" );
|
|
Packit |
16975c |
is( $div2->as_trimmed_text(),
|
|
Packit |
16975c |
"1 and 2 \xA0 3", "Dump element in trimmed text format" );
|
|
Packit |
16975c |
is( $div2->as_trimmed_text( extra_chars => 'a-z\xA0' ),
|
|
Packit |
16975c |
"1 2 3", "Dump element in trimmed text format without nbsp or letters");
|
|
Packit |
16975c |
is( $div2->as_trimmed_text( extra_chars => '[:alpha:]' ),
|
|
Packit |
16975c |
"1 2 \xA0 3", "Dump element in trimmed text format without letters");
|
|
Packit |
16975c |
|
|
Packit |
16975c |
my $t2 = HTML::Element->new_from_lol($lol);
|
|
Packit |
16975c |
isa_ok( $t2, 'HTML::Element' );
|
|
Packit |
16975c |
ok( $t2->same_as($t1) );
|
|
Packit |
16975c |
$t2->address('0.1.2')->attr( 'snap', 123 );
|
|
Packit |
16975c |
ok( not( $t2->same_as($t1) ) );
|
|
Packit |
16975c |
|
|
Packit |
16975c |
my $body = $t1->find_by_tag_name('body');
|
|
Packit |
16975c |
isa_ok( $body, 'HTML::Element' );
|
|
Packit |
16975c |
is( $body->tag, 'body' );
|
|
Packit |
16975c |
|
|
Packit |
16975c |
my $cl = join '~', $body->content_list;
|
|
Packit |
16975c |
my @detached = $body->detach_content;
|
|
Packit |
16975c |
is( $cl, join '~', @detached );
|
|
Packit |
16975c |
$body->push_content(@detached);
|
|
Packit |
16975c |
is( $cl, join '~', $body->content_list );
|
|
Packit |
16975c |
|
|
Packit |
16975c |
$t2->delete;
|
|
Packit |
16975c |
$t1->delete;
|
|
Packit |
16975c |
} # FIRST_BLOCK
|
|
Packit |
16975c |
|
|
Packit |
16975c |
TEST2: { # for normalization
|
|
Packit |
16975c |
my $t1 = HTML::Element->new_from_lol( [ 'p', 'stuff', ['hr'], 'thing' ] );
|
|
Packit |
16975c |
my @start = $t1->content_list;
|
|
Packit |
16975c |
is( scalar(@start), 3 );
|
|
Packit |
16975c |
my $lr = $t1->content;
|
|
Packit |
16975c |
|
|
Packit |
16975c |
# $lr is ['stuff', HTML::Element('hr'), 'thing']
|
|
Packit |
16975c |
is( $lr->[0], 'stuff' );
|
|
Packit |
16975c |
isa_ok( $lr->[1], 'HTML::Element' );
|
|
Packit |
16975c |
is( $lr->[2], 'thing' );
|
|
Packit |
16975c |
|
|
Packit |
16975c |
# insert some undefs
|
|
Packit |
16975c |
splice @$lr, 1, 0, undef; # insert an undef between [0] and [1]
|
|
Packit |
16975c |
push @$lr, undef; # append an undef to the end
|
|
Packit |
16975c |
unshift @$lr, undef; # prepend an undef to the front
|
|
Packit |
16975c |
# $lr is [undef, 'stuff', undef, H::E('hr'), 'thing', undef]
|
|
Packit |
16975c |
|
|
Packit |
16975c |
UNNORMALIZED: {
|
|
Packit |
16975c |
my $cl_count = $t1->content_list;
|
|
Packit |
16975c |
my @cl = $t1->content_list;
|
|
Packit |
16975c |
is( $cl_count, 6 );
|
|
Packit |
16975c |
is( scalar(@cl), $cl_count ); # also == 6
|
|
Packit |
16975c |
{
|
|
Packit |
16975c |
no warnings; # content_list contains undefs
|
|
Packit |
16975c |
isnt( join( '~', @start ), join( '~', $t1->content_list ) );
|
|
Packit |
16975c |
}
|
|
Packit |
16975c |
}
|
|
Packit |
16975c |
|
|
Packit |
16975c |
NORMALIZED: {
|
|
Packit |
16975c |
$t1->normalize_content;
|
|
Packit |
16975c |
my @cl = $t1->content_list;
|
|
Packit |
16975c |
eq_array( \@start, \@cl );
|
|
Packit |
16975c |
}
|
|
Packit |
16975c |
|
|
Packit |
16975c |
ok( not defined( $t1->attr('foo') ) );
|
|
Packit |
16975c |
$t1->attr( 'foo', 'bar' );
|
|
Packit |
16975c |
is( $t1->attr('foo'), 'bar' );
|
|
Packit |
16975c |
ok( scalar( grep( 'bar', $t1->all_external_attr() ) ) );
|
|
Packit |
16975c |
$t1->attr( 'foo', '' );
|
|
Packit |
16975c |
ok( scalar( grep( 'bar', $t1->all_external_attr() ) ) );
|
|
Packit |
16975c |
$t1->attr( 'foo', undef ); # should delete it
|
|
Packit |
16975c |
ok( not grep( 'bar', $t1->all_external_attr() ) );
|
|
Packit |
16975c |
$t1->delete;
|
|
Packit |
16975c |
} # TEST2
|
|
Packit |
16975c |
|
|
Packit |
16975c |
EXTRA_CHARS_IS_FALSE: {
|
|
Packit |
16975c |
my $h = HTML::Element->new_from_lol([p => '1 2 0 4']);
|
|
Packit |
16975c |
is( $h->as_text, '1 2 0 4', "Dump p in text format" );
|
|
Packit |
16975c |
is( $h->as_trimmed_text, '1 2 0 4', "Dump p in trimmed format" );
|
|
Packit |
16975c |
is( $h->as_trimmed_text(extra_chars => '0'), '1 2 4',
|
|
Packit |
16975c |
"Dump p in trimmed format without 0" );
|
|
Packit |
16975c |
}
|