, [undef, $token->{tag_name}]);
for my $attr_name (keys %{ $token->{attributes}}) {
$el->set_attribute_ns (undef, [undef, $attr_name],
$token->{attributes} ->{$attr_name}->{value});
}
$insert->($el);
push @{$self->{open_elements}}, [$el, $token->{tag_name}];
}
$token = $self->_get_next_token;
redo B;
}
} elsif ($token->{type} == END_TAG_TOKEN) {
if ($token->{tag_name} eq 'body') {
if (@{$self->{open_elements}} > 1 and
$self->{open_elements}->[1]->[1] eq 'body') {
for (@{$self->{open_elements}}) {
unless ({
dd => 1, dt => 1, li => 1, p => 1, td => 1,
th => 1, tr => 1, body => 1, html => 1,
tbody => 1, tfoot => 1, thead => 1,
}->{$_->[1]}) {
$self->{parse_error}-> (type => 'not closed:'.$_->[1]);
}
}
$self->{insertion_mode} = AFTER_BODY_IM;
$token = $self->_get_next_token;
redo B;
} else {
$self->{parse_error}-> (type => 'unmatched end tag:'.$token->{tag_name});
## Ignore the token
$token = $self->_get_next_token;
redo B;
}
} elsif ($token->{tag_name} eq 'html') {
if (@{$self->{open_elements}} > 1 and $self->{open_elements}->[1]->[1] eq 'body') {
## ISSUE: There is an issue in the spec.
if ($self->{open_elements}->[-1]->[1] ne 'body') {
$self->{parse_error}-> (type => 'not closed:'.$self->{open_elements}->[1]->[1]);
}
$self->{insertion_mode} = AFTER_BODY_IM;
## reprocess
redo B;
} else {
$self->{parse_error}-> (type => 'unmatched end tag:'.$token->{tag_name});
## Ignore the token
$token = $self->_get_next_token;
redo B;
}
} elsif ({
address => 1, blockquote => 1, center => 1, dir => 1,
div => 1, dl => 1, fieldset => 1, listing => 1,
menu => 1, ol => 1, pre => 1, ul => 1,
p => 1,
dd => 1, dt => 1, li => 1,
button => 1, marquee => 1, object => 1,
}->{$token->{tag_name}}) {
## has an element in scope
my $i;
INSCOPE: for (reverse 0..$#{$self->{open_elements}}) {
my $node = $self->{open_elements}->[$_];
if ($node->[1] eq $token->{tag_name}) {
## generate implied end tags
if ({
dd => ($token->{tag_name} ne 'dd'),
dt => ($token->{tag_name} ne 'dt'),
li => ($token->{tag_name} ne 'li'),
p => ($token->{tag_name} ne 'p'),
td => 1, th => 1, tr => 1,
tbody => 1, tfoot=> 1, thead => 1,
}->{$self->{open_elements}->[-1]->[1]}) {
unshift @{$self->{token}}, $token;
$token = {type => END_TAG_TOKEN,
tag_name => $self->{open_elements}->[-1]->[1]}; # MUST
redo B;
}
$i = $_;
last INSCOPE unless $token->{tag_name} eq 'p';
} elsif ({
table => 1, caption => 1, td => 1, th => 1,
button => 1, marquee => 1, object => 1, html => 1,
}->{$node->[1]}) {
last INSCOPE;
}
} # INSCOPE
if ($self->{open_elements}->[-1]->[1] ne $token->{tag_name}) {
if (defined $i) {
$self->{parse_error}-> (type => 'not closed:'.$self->{open_elements}->[-1]->[1]);
} else {
$self->{parse_error}-> (type => 'unmatched end tag:'.$token->{tag_name});
}
}
if (defined $i) {
splice @{$self->{open_elements}}, $i;
} elsif ($token->{tag_name} eq 'p') {
## As if , then reprocess the current token
my $el;
$el = $self->{document}->create_element_ns
(q, [undef, 'p']);
$insert->($el);
}
$clear_up_to_marker->()
if {
button => 1, marquee => 1, object => 1,
}->{$token->{tag_name}};
$token = $self->_get_next_token;
redo B;
} elsif ($token->{tag_name} eq 'form') {
## has an element in scope
INSCOPE: for (reverse 0..$#{$self->{open_elements}}) {
my $node = $self->{open_elements}->[$_];
if ($node->[1] eq $token->{tag_name}) {
## generate implied end tags
if ({
dd => 1, dt => 1, li => 1, p => 1,
td => 1, th => 1, tr => 1,
tbody => 1, tfoot=> 1, thead => 1,
}->{$self->{open_elements}->[-1]->[1]}) {
unshift @{$self->{token}}, $token;
$token = {type => END_TAG_TOKEN,
tag_name => $self->{open_elements}->[-1]->[1]}; # MUST
redo B;
}
last INSCOPE;
} elsif ({
table => 1, caption => 1, td => 1, th => 1,
button => 1, marquee => 1, object => 1, html => 1,
}->{$node->[1]}) {
last INSCOPE;
}
} # INSCOPE
if ($self->{open_elements}->[-1]->[1] eq $token->{tag_name}) {
pop @{$self->{open_elements}};
} else {
$self->{parse_error}-> (type => 'unmatched end tag:'.$token->{tag_name});
}
undef $self->{form_element};
$token = $self->_get_next_token;
redo B;
} elsif ({
h1 => 1, h2 => 1, h3 => 1, h4 => 1, h5 => 1, h6 => 1,
}->{$token->{tag_name}}) {
## has an element in scope
my $i;
INSCOPE: for (reverse 0..$#{$self->{open_elements}}) {
my $node = $self->{open_elements}->[$_];
if ({
h1 => 1, h2 => 1, h3 => 1, h4 => 1, h5 => 1, h6 => 1,
}->{$node->[1]}) {
## generate implied end tags
if ({
dd => 1, dt => 1, li => 1, p => 1,
td => 1, th => 1, tr => 1,
tbody => 1, tfoot=> 1, thead => 1,
}->{$self->{open_elements}->[-1]->[1]}) {
unshift @{$self->{token}}, $token;
$token = {type => END_TAG_TOKEN,
tag_name => $self->{open_elements}->[-1]->[1]}; # MUST
redo B;
}
$i = $_;
last INSCOPE;
} elsif ({
table => 1, caption => 1, td => 1, th => 1,
button => 1, marquee => 1, object => 1, html => 1,
}->{$node->[1]}) {
last INSCOPE;
}
} # INSCOPE
if ($self->{open_elements}->[-1]->[1] ne $token->{tag_name}) {
$self->{parse_error}-> (type => 'unmatched end tag:'.$token->{tag_name});
}
splice @{$self->{open_elements}}, $i if defined $i;
$token = $self->_get_next_token;
redo B;
} elsif ({
a => 1,
b => 1, big => 1, em => 1, font => 1, i => 1,
nobr => 1, s => 1, small => 1, strile => 1,
strong => 1, tt => 1, u => 1,
}->{$token->{tag_name}}) {
$formatting_end_tag->($token->{tag_name});
redo B;
} elsif ($token->{tag_name} eq 'br') {
$self->{parse_error}-> (type => 'unmatched end tag:br');
## As if
$reconstruct_active_formatting_elements->($insert_to_current);
my $el;
$el = $self->{document}->create_element_ns
(q, [undef, 'br']);
$insert->($el);
## Ignore the token.
$token = $self->_get_next_token;
redo B;
} elsif ({
caption => 1, col => 1, colgroup => 1, frame => 1,
frameset => 1, head => 1, option => 1, optgroup => 1,
tbody => 1, td => 1, tfoot => 1, th => 1,
thead => 1, tr => 1,
area => 1, basefont => 1, bgsound => 1,
embed => 1, hr => 1, iframe => 1, image => 1,
img => 1, input => 1, isindex => 1, noembed => 1,
noframes => 1, param => 1, select => 1, spacer => 1,
table => 1, textarea => 1, wbr => 1,
noscript => 0, ## TODO: if scripting is enabled
}->{$token->{tag_name}}) {
$self->{parse_error}-> (type => 'unmatched end tag:'.$token->{tag_name});
## Ignore the token
$token = $self->_get_next_token;
redo B;
## ISSUE: Issue on HTML5 new elements in spec
} else {
## Step 1
my $node_i = -1;
my $node = $self->{open_elements}->[$node_i];
## Step 2
S2: {
if ($node->[1] eq $token->{tag_name}) {
## Step 1
## generate implied end tags
if ({
dd => 1, dt => 1, li => 1, p => 1,
td => 1, th => 1, tr => 1,
tbody => 1, tfoot => 1, thead => 1,
}->{$self->{open_elements}->[-1]->[1]}) {
unshift @{$self->{token}}, $token;
$token = {type => END_TAG_TOKEN,
tag_name => $self->{open_elements}->[-1]->[1]}; # MUST
redo B;
}
## Step 2
if ($token->{tag_name} ne $self->{open_elements}->[-1]->[1]) {
## NOTE:
$self->{parse_error}-> (type => 'not closed:'.$self->{open_elements}->[-1]->[1]);
}
## Step 3
splice @{$self->{open_elements}}, $node_i;
$token = $self->_get_next_token;
last S2;
} else {
## Step 3
if (not $formatting_category->{$node->[1]} and
#not $phrasing_category->{$node->[1]} and
($special_category->{$node->[1]} or
$scoping_category->{$node->[1]})) {
$self->{parse_error}-> (type => 'unmatched end tag:'.$token->{tag_name});
## Ignore the token
$token = $self->_get_next_token;
last S2;
}
}
## Step 4
$node_i--;
$node = $self->{open_elements}->[$node_i];
## Step 5;
redo S2;
} # S2
redo B;
}
}
redo B;
} # B
## NOTE: The "trailing end" phase in HTML5 is split into
## two insertion modes: "after html body" and "after html frameset".
## NOTE: States in the main stage is preserved while
## the parser stays in the trailing end phase. # MUST
## Stop parsing # MUST
## TODO: script stuffs
} # _tree_construct_main
sub set_inner_html ($$$) {
my $class = shift;
my $node = shift;
my $s = \$_[0];
my $onerror = $_[1];
## ISSUE: Should {confident} be true?
my $nt = $node->node_type;
if ($nt == 9) {
# MUST
## Step 1 # MUST
## TODO: If the document has an active parser, ...
## ISSUE: There is an issue in the spec.
## Step 2 # MUST
my @cn = @{$node->child_nodes};
for (@cn) {
$node->remove_child ($_);
}
## Step 3, 4, 5 # MUST
$class->parse_string ($$s => $node, $onerror);
} elsif ($nt == 1) {
## TODO: If non-html element
## NOTE: Most of this code is copied from |parse_string|
## Step 1 # MUST
my $this_doc = $node->owner_document;
my $doc = $this_doc->implementation->create_document;
$doc->manakai_is_html (1);
my $p = $class->new;
$p->{document} = $doc;
## Step 9 # MUST
my $i = 0;
my $line = 1;
my $column = 0;
$p->{set_next_char} = sub {
my $self = shift;
pop @{$self->{prev_char}};
unshift @{$self->{prev_char}}, $self->{next_char};
$self->{next_char} = -1 and return if $i >= length $$s;
$self->{next_char} = ord substr $$s, $i++, 1;
$column++;
if ($self->{next_char} == 0x000A) { # LF
$line++;
$column = 0;
} elsif ($self->{next_char} == 0x000D) { # CR
$i++ if substr ($$s, $i, 1) eq "\x0A";
$self->{next_char} = 0x000A; # LF # MUST
$line++;
$column = 0;
} elsif ($self->{next_char} > 0x10FFFF) {
$self->{next_char} = 0xFFFD; # REPLACEMENT CHARACTER # MUST
} elsif ($self->{next_char} == 0x0000) { # NULL
$self->{parse_error}-> (type => 'NULL');
$self->{next_char} = 0xFFFD; # REPLACEMENT CHARACTER # MUST
}
};
$p->{prev_char} = [-1, -1, -1];
$p->{next_char} = -1;
my $ponerror = $onerror || sub {
my (%opt) = @_;
warn "Parse error ($opt{type}) at line $opt{line} column $opt{column}\n";
};
$p->{parse_error} = sub {
$ponerror->(@_, line => $line, column => $column);
};
$p->_initialize_tokenizer;
$p->_initialize_tree_constructor;
## Step 2
my $node_ln = $node->manakai_local_name;
$p->{content_model} = {
title => RCDATA_CONTENT_MODEL,
textarea => RCDATA_CONTENT_MODEL,
style => CDATA_CONTENT_MODEL,
script => CDATA_CONTENT_MODEL,
xmp => CDATA_CONTENT_MODEL,
iframe => CDATA_CONTENT_MODEL,
noembed => CDATA_CONTENT_MODEL,
noframes => CDATA_CONTENT_MODEL,
noscript => CDATA_CONTENT_MODEL,
plaintext => PLAINTEXT_CONTENT_MODEL,
}->{$node_ln};
$p->{content_model} = PCDATA_CONTENT_MODEL
unless defined $p->{content_model};
## ISSUE: What is "the name of the element"? local name?
$p->{inner_html_node} = [$node, $node_ln];
## Step 4
my $root = $doc->create_element_ns
('http://www.w3.org/1999/xhtml', [undef, 'html']);
## Step 5 # MUST
$doc->append_child ($root);
## Step 6 # MUST
push @{$p->{open_elements}}, [$root, 'html'];
undef $p->{head_element};
## Step 7 # MUST
$p->_reset_insertion_mode;
## Step 8 # MUST
my $anode = $node;
AN: while (defined $anode) {
if ($anode->node_type == 1) {
my $nsuri = $anode->namespace_uri;
if (defined $nsuri and $nsuri eq 'http://www.w3.org/1999/xhtml') {
if ($anode->manakai_local_name eq 'form') {
$p->{form_element} = $anode;
last AN;
}
}
}
$anode = $anode->parent_node;
} # AN
## Step 3 # MUST
## Step 10 # MUST
{
my $self = $p;
$token = $self->_get_next_token;
}
$p->_tree_construction_main;
## Step 11 # MUST
my @cn = @{$node->child_nodes};
for (@cn) {
$node->remove_child ($_);
}
## ISSUE: mutation events? read-only?
## Step 12 # MUST
@cn = @{$root->child_nodes};
for (@cn) {
$this_doc->adopt_node ($_);
$node->append_child ($_);
}
## ISSUE: mutation events?
$p->_terminate_tree_constructor;
} else {
die "$0: |set_inner_html| is not defined for node of type $nt";
}
} # set_inner_html
} # tree construction stage
package Whatpm::HTML::RestartParser;
push our @ISA, 'Error';
1;
# $Date: 2008/03/03 10:20:19 $