vcs.maemo.org Git - dh-make-perl/blob - dev/arm/libhtml-parser-perl/libhtml-parser-perl-3.56/t/headparser.t

   1 #!perl -w
   2
   3 use strict;
   4 use Test::More tests => 11;
   5
   6 { package H;
   7   sub new { bless {}, shift; }
   8
   9   sub header {
  10      my $self = shift;
  11      my $key  = uc(shift);
  12      my $old = $self->{$key};
  13      if (@_) { $self->{$key} = shift; }
  14      $old;
  15   }
  16
  17   sub push_header {
  18      my($self, $k, $v) = @_;
  19      $k = uc($k);
  20      if (exists $self->{$k}) {
  21         $self->{$k} = [ $self->{$k} ] unless ref $self->{$k};
  22         push(@{$self->{$k}}, $v);
  23      } else {
  24         $self->{$k} = $v;
  25      }
  26   }
  27
  28   sub as_string {
  29      my $self = shift;
  30      my $str = "";
  31      for (sort keys %$self) {
  32          if (ref($self->{$_})) {
  33             my $v;
  34             for $v (@{$self->{$_}}) {
  35                 $str .= "$_: $v\n";
  36             }
  37          } else {
  38             $str .= "$_: $self->{$_}\n";
  39          }
  40      }
  41      $str;
  42   }
  43 }
  44
  45
  46 my $HTML = <<'EOT';
  47
  48 <title>&Aring være eller &#229; ikke være</title>
  49 <meta http-equiv="Expires" content="Soon">
  50 <meta http-equiv="Foo" content="Bar">
  51 <link href="mailto:gisle@aas.no" rev=made title="Gisle Aas">
  52
  53 <script>
  54
  55    "</script>"
  56     ignore this
  57
  58 </script>
  59
  60 <base href="http://www.sn.no">
  61 <meta name="Keywords" content="test, test, test,...">
  62 <meta name="Keywords" content="more">
  63
  64 Dette er vanlig tekst.  Denne teksten definerer også slutten på
  65 &lt;head> delen av dokumentet.
  66
  67 <style>
  68
  69    "</style>"
  70    ignore this too
  71
  72 </style>
  73
  74 <isindex>
  75
  76 Dette er også vanlig tekst som ikke skal blir parset i det hele tatt.
  77
  78 EOT
  79
  80 $| = 1;
  81
  82 #$HTML::HeadParser::DEBUG = 1;
  83 require HTML::HeadParser;
  84 my $p = HTML::HeadParser->new( H->new );
  85
  86 if ($p->parse($HTML)) {
  87     fail("Need more data which should not happen");
  88 } else {
  89     #diag $p->as_string;
  90     pass();
  91 }
  92
  93 like($p->header('Title'), qr/Å være eller å ikke være/);
  94 is($p->header('Expires'), 'Soon');
  95 is($p->header('Content-Base'), 'http://www.sn.no');
  96 like($p->header('Link'), qr/<mailto:gisle\@aas.no>/);
  97
  98 # This header should not be present because the head ended
  99 ok(!$p->header('Isindex'));
 100
 101
 102 # Try feeding one char at a time
 103 my $expected = $p->as_string;
 104 my $nl = 1;
 105 $p = HTML::HeadParser->new(H->new);
 106 while ($HTML =~ /(.)/sg) {
 107     #print STDERR '#' if $nl;
 108     #print STDERR $1;
 109     $nl = $1 eq "\n";
 110     $p->parse($1) or last;
 111 }
 112 is($p->as_string, $expected);
 113
 114
 115 # Try reading it from a file
 116 my $file = "hptest$$.html";
 117 die "$file already exists" if -e $file;
 118
 119 open(FILE, ">$file") or die "Can't create $file: $!";
 120 binmode(FILE);
 121 print FILE $HTML;
 122 print FILE "<p>This is more content...</p>\n" x 2000;
 123 print FILE "<title>Buuuh!</title>\n" x 200;
 124 close FILE or die "Can't close $file: $!";
 125
 126 $p = HTML::HeadParser->new(H->new);
 127 $p->parse_file($file);
 128 unlink($file) or warn "Can't unlink $file: $!";
 129
 130 is($p->header("Title"), "Å være eller å ikke være");
 131
 132
 133 # We got into an infinite loop on data without tags and no EOL.
 134 # This was actually a HTML::Parser bug.
 135 open(FILE, ">$file") or die "Can't create $file: $!";
 136 print FILE "Foo";
 137 close(FILE);
 138
 139 $p = HTML::HeadParser->new(H->new);
 140 $p->parse_file($file);
 141 unlink($file) or warn "Can't unlink $file: $!";
 142
 143 ok(!$p->as_string);
 144
 145 SKIP: {
 146   skip "Need Unicode support", 2 if $] < 5.008;
 147
 148   # Test that the Unicode BOM does not confuse us?
 149   $p = HTML::HeadParser->new(H->new);
 150   ok($p->parse("\x{FEFF}\n<title>Hi <foo></title>"));
 151   $p->eof;
 152
 153   is($p->header("title"), "Hi <foo>");
 154 }