git.maemo.org Git - pkg-perl/blob - deb-src/libhtml-tree-perl/libhtml-tree-perl-3.23/t/building.t

   1 #!perl -Tw
   2
   3 #Test that we can build and compare trees
   4
   5 use Test::More tests=>39;
   6 use strict;
   7
   8 BEGIN {
   9     use_ok( "HTML::Element", 1.53 );
  10 }
  11
  12 FIRST_BLOCK: {
  13     my $lol =
  14     ['html',
  15         ['head',
  16             [ 'title', 'I like stuff!' ],
  17         ],
  18         ['body', {'lang', 'en-JP'},
  19             'stuff',
  20             ['p', 'um, p < 4!', {'class' => 'par123'}],
  21             ['div', {foo => 'bar'}, ' 1  2  3 '],  # at 0.1.2
  22             ['hr'],
  23         ]
  24     ];
  25     my $t1 = HTML::Element->new_from_lol( $lol );
  26     isa_ok( $t1, 'HTML::Element' );
  27
  28     ### added to test ->is_empty() and ->look_up()
  29     my $hr = $t1->find('hr') ;
  30     isa_ok( $hr, 'HTML::Element' );
  31     ok($hr->is_empty(), "testing is_empty method on <hr> tag") ;
  32     my $lookuptag = $hr->look_up("_tag", "body") ;
  33     is('<body lang="en-JP">', $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
  40     # Test scalar context
  41     my $count = $t1->content_list;
  42     is( $count, 2, "Works in scalar" );
  43
  44     # Test list context
  45     my @list = $t1->content_list;
  46     is( scalar @list, 2, "Should get two items back" );
  47     isa_ok( $list[0], 'HTML::Element' );
  48     isa_ok( $list[1], 'HTML::Element' );
  49
  50     my $div = $t1->find_by_attribute('foo','bar');
  51     isa_ok( $div, 'HTML::Element' );
  52
  53     ### tests of various output formats
  54     is( $div->as_text()," 1  2  3 ", "Dump element in text format");
  55     is( $div->as_trimmed_text(),"1 2 3", "Dump element in trimmed text format");
  56     is( $div->as_text_trimmed(),"1 2 3", "Dump element in trimmed text format");
  57     is( $div->as_Lisp_form(), qq{("_tag" "div" "foo" "bar" "_content" (\n  " 1  2  3 "))\n}, "Dump element as Lisp form");
  58
  59     is( $div->address, '0.1.2' );
  60     is( $div, $t1->address('0.1.2'), 'using address to get the node' );
  61     ok( $div->same_as($div) );
  62     ok( $t1->same_as($t1) );
  63     ok( not($div->same_as($t1)) );
  64
  65     my $t2 = HTML::Element->new_from_lol($lol);
  66     isa_ok( $t2, 'HTML::Element' );
  67     ok( $t2->same_as($t1) );
  68     $t2->address('0.1.2')->attr('snap', 123);
  69     ok( not($t2->same_as($t1)) );
  70
  71     my $body = $t1->find_by_tag_name('body');
  72     isa_ok( $body, 'HTML::Element' );
  73     is( $body->tag, 'body' );
  74
  75     my $cl = join '~', $body->content_list;
  76     my @detached = $body->detach_content;
  77     is( $cl, join '~', @detached );
  78     $body->push_content(@detached);
  79     is( $cl, join '~', $body->content_list );
  80
  81     $t2->delete;
  82     $t1->delete;
  83 } # FIRST_BLOCK
  84
  85 TEST2: { # for normalization
  86     my $t1 = HTML::Element->new_from_lol(['p', 'stuff', ['hr'], 'thing']);
  87     my @start = $t1->content_list;
  88     is( scalar(@start), 3 );
  89     my $lr = $t1->content;
  90     # $lr is ['stuff', HTML::Element('hr'), 'thing']
  91     is( $lr->[0], 'stuff' );
  92     isa_ok( $lr->[1], 'HTML::Element' );
  93     is( $lr->[2], 'thing' );
  94     # insert some undefs
  95     splice @$lr,1,0, undef; # insert an undef between [0] and [1]
  96     push @$lr, undef;       # append an undef to the end
  97     unshift @$lr, undef;    # prepend an undef to the front
  98     # $lr is [undef, 'stuff', undef, H::E('hr'), 'thing', undef]
  99
 100     UNNORMALIZED: {
 101         my $cl_count = $t1->content_list;
 102         my @cl = $t1->content_list;
 103         is( $cl_count, 6 );
 104         is( scalar(@cl), $cl_count ); # also == 6
 105         { no warnings; # content_list contains undefs
 106             isnt( join('~', @start), join('~', $t1->content_list) );
 107         }
 108     }
 109
 110     NORMALIZED: {
 111         $t1->normalize_content;
 112         my @cl = $t1->content_list;
 113         eq_array( \@start, \@cl );
 114     }
 115
 116     ok( not defined( $t1->attr('foo') ) );
 117     $t1->attr('foo', 'bar');
 118     is( $t1->attr('foo'), 'bar' );
 119     ok( scalar( grep( 'bar', $t1->all_external_attr() ) ) );
 120     $t1->attr('foo', '');
 121     ok( scalar( grep( 'bar', $t1->all_external_attr() ) ) );
 122     $t1->attr('foo', undef); # should delete it
 123     ok( not grep( 'bar', $t1->all_external_attr() ) );
 124     $t1->delete;
 125 } # TEST2