4 use Test::More tests => 11;
7 sub new { bless {}, shift; }
12 my $old = $self->{$key};
13 if (@_) { $self->{$key} = shift; }
18 my($self, $k, $v) = @_;
20 if (exists $self->{$k}) {
21 $self->{$k} = [ $self->{$k} ] unless ref $self->{$k};
22 push(@{$self->{$k}}, $v);
31 for (sort keys %$self) {
32 if (ref($self->{$_})) {
34 for $v (@{$self->{$_}}) {
38 $str .= "$_: $self->{$_}\n";
48 <title>Å være eller å 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">
60 <base href="http://www.sn.no">
61 <meta name="Keywords" content="test, test, test,...">
62 <meta name="Keywords" content="more">
64 Dette er vanlig tekst. Denne teksten definerer også slutten på
65 <head> delen av dokumentet.
76 Dette er også vanlig tekst som ikke skal blir parset i det hele tatt.
82 #$HTML::HeadParser::DEBUG = 1;
83 require HTML::HeadParser;
84 my $p = HTML::HeadParser->new( H->new );
86 if ($p->parse($HTML)) {
87 fail("Need more data which should not happen");
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>/);
98 # This header should not be present because the head ended
99 ok(!$p->header('Isindex'));
102 # Try feeding one char at a time
103 my $expected = $p->as_string;
105 $p = HTML::HeadParser->new(H->new);
106 while ($HTML =~ /(.)/sg) {
107 #print STDERR '#' if $nl;
110 $p->parse($1) or last;
112 is($p->as_string, $expected);
115 # Try reading it from a file
116 my $file = "hptest$$.html";
117 die "$file already exists" if -e $file;
119 open(FILE, ">$file") or die "Can't create $file: $!";
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: $!";
126 $p = HTML::HeadParser->new(H->new);
127 $p->parse_file($file);
128 unlink($file) or warn "Can't unlink $file: $!";
130 is($p->header("Title"), "Å være eller å ikke være");
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: $!";
139 $p = HTML::HeadParser->new(H->new);
140 $p->parse_file($file);
141 unlink($file) or warn "Can't unlink $file: $!";
146 skip "Need Unicode support", 2 if $] < 5.008;
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>"));
153 is($p->header("title"), "Hi <foo>");