vcs.maemo.org Git - pkg-perl/blob - deb-src/libhtml-tree-perl/libhtml-tree-perl-3.23/t/construct_tree.t

   1 #!perl -Tw
   2
   3 use Test::More tests => (3 + 7 * 8);
   4 #initial tests + number of tests in test_new_obj() * number of times called
   5
   6 use strict;
   7
   8 BEGIN {
   9     use_ok( 'HTML::Tree' );
  10 }
  11
  12 my $obj = new HTML::Tree;
  13 isa_ok($obj, "HTML::TreeBuilder");
  14
  15 my $TestInput = "t/oldparse.html";
  16
  17 my $HTML ;
  18 {
  19     local $/ = undef ;
  20     open(INFILE, $TestInput) || die "Can't open $TestInput: $!";
  21     $HTML=<INFILE> ;
  22     close(INFILE) ;
  23 }
  24
  25 # setup some parts of the HTML for the list tests.
  26
  27 # die "$TestInput does not have at least 2 characters!"
  28 #     if length($HTML) <= 2;
  29 # my $HTMLPart1 = substr( $HTML, 0, int( length($HTML) / 2 ) );
  30 # my $HTMLPart2 = substr( $HTML, int( length($HTML) / 2 ) );
  31
  32 # The logic here is to try to split the HTML in the middle of a tag.
  33 # The above commented-out code is also an option.
  34
  35 my $split_at = 4;
  36 die "$TestInput does not have at least " . ($split_at + 1) . " characters!"
  37     if length($HTML) <= $split_at;
  38 my $HTMLPart1 = substr( $HTML, 0, 4 );
  39 my $HTMLPart2 = substr( $HTML, 4 );
  40
  41 is($HTMLPart1 . $HTMLPart2, $HTML, "split \$HTML correctly");
  42
  43
  44 # Filehandle Test
  45 {
  46     open(INFILE, $TestInput) || die "Can't open $TestInput: $!";
  47     my $file_obj    = HTML::Tree->new_from_file( *INFILE );
  48     test_new_obj($file_obj, "new_from_file Filehandle" ) ;
  49     close(INFILE);
  50 }
  51
  52
  53 # Scalar Tests
  54 {
  55     my $content_obj = HTML::Tree->new_from_content($HTML);
  56     test_new_obj($content_obj, "new_from_content Scalar") ;
  57 }
  58
  59 {
  60     my $file_obj    = HTML::Tree->new_from_file( $TestInput);
  61     test_new_obj($file_obj, "new_from_file Scalar" ) ;
  62 }
  63
  64 {
  65     my $parse_content_obj = HTML::Tree->new;
  66     $parse_content_obj->parse_content( $HTML);
  67     test_new_obj($parse_content_obj, "new(); parse_content Scalar" );
  68 }
  69
  70
  71 # Scalar REF Tests
  72 {
  73     my $content_obj = HTML::Tree->new_from_content($HTML);
  74     test_new_obj($content_obj, "new_from_content Scalar REF") ;
  75 }
  76
  77 # None for new_from_file
  78 # Filehandle test instead. (see above)
  79
  80 {
  81     my $parse_content_obj = HTML::Tree->new;
  82     $parse_content_obj->parse_content( $HTML);
  83     test_new_obj($parse_content_obj, "new(); parse_content Scalar REF" );
  84 }
  85
  86
  87 # List Tests (Scalar and Scalar REF)
  88 {
  89     my $content_obj = HTML::Tree->new_from_content(\$HTMLPart1, $HTMLPart2);
  90     test_new_obj($content_obj, "new_from_content List") ;
  91 }
  92
  93 # None for new_from_file.
  94 # Does not support lists.
  95
  96 {
  97     my $parse_content_obj = HTML::Tree->new;
  98     $parse_content_obj->parse_content( \$HTMLPart1, $HTMLPart2 );
  99     test_new_obj($parse_content_obj, "new(); parse_content List");
 100 }
 101
 102
 103 sub test_new_obj {
 104     my $obj = shift ;
 105     my $test_description = shift;
 106
 107     isa_ok($obj, "HTML::TreeBuilder", $test_description);
 108
 109     my $html = $obj->as_HTML(undef, '  ');
 110     ok( $html, "Get HTML as string." );
 111
 112     # This is a very simple test just to ensure that we get something
 113     # sensible back.
 114     like( $html, qr/<BODY>/i, "<BODY> found OK." );
 115     like( $html, qr/www\.sn\.no/, "found www.sn.no link" );
 116
 117     TODO: {
 118         local $TODO = <<ENDTEXT;
 119 HTML::Parser doesn't handle nested comments correctly.
 120 See: http://phalanx.kwiki.org/index.cgi?HTMLTreeNestedComments
 121 ENDTEXT
 122
 123         unlike( $html, qr/nested-comment/, "Nested comment not found" );
 124     }
 125
 126     unlike( $html, qr/simple-comment/, "Simple comment not found" );
 127     like( $html, qr/Gisle/, "found Gisle" );
 128 } # test_new_obj