#!perl -w
use strict;
use Test::More tests => 17;
{ package H;
sub new { bless {}, shift; }
sub header {
my $self = shift;
my $key = uc(shift);
die if $key =~ /:/;
my $old = $self->{$key};
if (@_) { $self->{$key} = shift; }
$old;
}
sub push_header {
my($self, $k, $v) = @_;
$k = uc($k);
die if $k =~ /:/;
if (exists $self->{$k}) {
$self->{$k} = [ $self->{$k} ] unless ref $self->{$k};
push(@{$self->{$k}}, $v);
} else {
$self->{$k} = $v;
}
}
sub as_string {
my $self = shift;
my $str = "";
for (sort keys %$self) {
if (ref($self->{$_})) {
my $v;
for $v (@{$self->{$_}}) {
$str .= "$_: $v\n";
}
} else {
$str .= "$_: $self->{$_}\n";
}
}
$str;
}
}
my $HTML = <<'EOT';
Å være eller å ikke være
... and this
/);
# This header should not be present because the head ended
ok(!$p->header('Isindex'));
# Try feeding one char at a time
my $expected = $p->as_string;
my $nl = 1;
$p = HTML::HeadParser->new(H->new);
while ($HTML =~ /(.)/sg) {
#print STDERR '#' if $nl;
#print STDERR $1;
$nl = $1 eq "\n";
$p->parse($1) or last;
}
is($p->as_string, $expected);
# Try reading it from a file
my $file = "hptest$$.html";
die "$file already exists" if -e $file;
open(FILE, ">$file") or die "Can't create $file: $!";
binmode(FILE);
print FILE $HTML;
print FILE "This is more content...
\n" x 2000;
print FILE "Buuuh! \n" x 200;
close FILE or die "Can't close $file: $!";
$p = HTML::HeadParser->new(H->new);
$p->parse_file($file);
unlink($file) or warn "Can't unlink $file: $!";
is($p->header("Title"), "Å være eller å ikke være");
# We got into an infinite loop on data without tags and no EOL.
# This was actually a HTML::Parser bug.
open(FILE, ">$file") or die "Can't create $file: $!";
print FILE "Foo";
close(FILE);
$p = HTML::HeadParser->new(H->new);
$p->parse_file($file);
unlink($file) or warn "Can't unlink $file: $!";
ok(!$p->as_string);
SKIP: {
skip "Need Unicode support", 5 if $] < 5.008;
# Test that the Unicode BOM does not confuse us?
$p = HTML::HeadParser->new(H->new);
ok($p->parse("\x{FEFF}\nHi <foo> "));
$p->eof;
is($p->header("title"), "Hi ");
$p = HTML::HeadParser->new(H->new);
$p->utf8_mode(1);
$p->parse(<<"EOT"); # example from http://rt.cpan.org/Ticket/Display.html?id=27522
\xEF\xBB\xBF
Parkinson's disease
ko\xC5\x84c\xC3\xB3wki kolekcji, outlet, hurtownia odzie\xC5\xBCy Warszawa – MJW \r