/[suikacvs]/markup/html/whatpm/Whatpm/ContentChecker.pm
Suika

Contents of /markup/html/whatpm/Whatpm/ContentChecker.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.19 - (hide annotations) (download)
Sat May 26 08:12:34 2007 UTC (19 years, 2 months ago) by wakaba
Branch: MAIN
Changes since 1.18: +21 -3 lines
++ whatpm/t/ChangeLog	26 May 2007 08:12:26 -0000
2007-05-26  Wakaba  <wakaba@suika.fam.cx>

	* content-model-2.dat: Errors on obsolete media
	type (i.e. |text/javascript|) are added to the expected results.

	* tree-test-1.dat: Tests for |style| elements' attributes
	are added.

++ whatpm/Whatpm/ChangeLog	26 May 2007 08:11:16 -0000
2007-05-26  Wakaba  <wakaba@suika.fam.cx>

	* IMTChecker.pm: New module.

	* ContentChecker.pm ($HTMLIMTAttrChecker): Call IMTChecker
	to test parameter value validity.

	* HTML.pm.src ($style_start_tag): Attributes were
	discarded.

1 wakaba 1.1 package Whatpm::ContentChecker;
2     use strict;
3    
4 wakaba 1.18 require Whatpm::URIChecker;
5    
6 wakaba 1.13 ## ISSUE: How XML and XML Namespaces conformance can (or cannot)
7     ## be applied to an in-memory representation (i.e. DOM)?
8    
9 wakaba 1.9 my $XML_NS = q<http://www.w3.org/XML/1998/namespace>;
10     my $XMLNS_NS = q<http://www.w3.org/2000/xmlns/>;
11    
12     my $AttrChecker = {
13     $XML_NS => {
14 wakaba 1.13 space => sub {
15     my ($self, $attr) = @_;
16     my $value = $attr->value;
17     if ($value eq 'default' or $value eq 'preserve') {
18     #
19     } else {
20     ## NOTE: An XML "error"
21     $self->{onerror}->(node => $attr,
22     type => 'XML error:invalid xml:space value');
23     }
24     },
25     lang => sub {
26     ## NOTE: "The values of the attribute are language identifiers
27     ## as defined by [IETF RFC 3066], Tags for the Identification
28     ## of Languages, or its successor; in addition, the empty string
29     ## may be specified." ("may" in lower case)
30     ## TODO: xml:lang MUST NOT in HTML document
31     },
32     base => sub {
33     my ($self, $attr) = @_;
34     my $value = $attr->value;
35     if ($value =~ /[^\x{0000}-\x{10FFFF}]/) { ## ISSUE: Should we disallow noncharacters?
36     $self->{onerror}->(node => $attr,
37     type => 'syntax error');
38     }
39 wakaba 1.18 ## NOTE: Conformance to URI standard is not checked since there is
40     ## no author requirement on conformance in the XML Base specification.
41 wakaba 1.13 },
42     id => sub {
43     my ($self, $attr) = @_;
44     my $value = $attr->value;
45     $value =~ s/[\x09\x0A\x0D\x20]+/ /g;
46     $value =~ s/^\x20//;
47     $value =~ s/\x20$//;
48     ## TODO: NCName in XML 1.0 or 1.1
49     ## TODO: declared type is ID?
50     if ($self->{id}->{$value}) {
51     $self->{onerror}->(node => $attr, type => 'xml:id error:duplicate ID');
52     } else {
53     $self->{id}->{$value} = 1;
54     }
55     },
56 wakaba 1.9 },
57     $XMLNS_NS => {
58 wakaba 1.13 '' => sub {
59     my ($self, $attr) = @_;
60     my $ln = $attr->manakai_local_name;
61     my $value = $attr->value;
62     if ($value eq $XML_NS and $ln ne 'xml') {
63     $self->{onerror}
64     ->(node => $attr,
65     type => 'NC:Reserved Prefixes and Namespace Names:=xml');
66     } elsif ($value eq $XMLNS_NS) {
67     $self->{onerror}
68     ->(node => $attr,
69     type => 'NC:Reserved Prefixes and Namespace Names:=xmlns');
70     }
71     if ($ln eq 'xml' and $value ne $XML_NS) {
72     $self->{onerror}
73     ->(node => $attr,
74     type => 'NC:Reserved Prefixes and Namespace Names:xmlns:xml=');
75     } elsif ($ln eq 'xmlns') {
76     $self->{onerror}
77     ->(node => $attr,
78     type => 'NC:Reserved Prefixes and Namespace Names:xmlns:xmlns=');
79     }
80     ## TODO: If XML 1.0 and empty
81     },
82     xmlns => sub {
83     my ($self, $attr) = @_;
84     ## TODO: In XML 1.0, URI reference [RFC 3986] or an empty string
85     ## TODO: In XML 1.1, IRI reference [RFC 3987] or an empty string
86 wakaba 1.18 ## TODO: relative references are deprecated
87 wakaba 1.13 my $value = $attr->value;
88     if ($value eq $XML_NS) {
89     $self->{onerror}
90     ->(node => $attr,
91     type => 'NC:Reserved Prefixes and Namespace Names:=xml');
92     } elsif ($value eq $XMLNS_NS) {
93     $self->{onerror}
94     ->(node => $attr,
95     type => 'NC:Reserved Prefixes and Namespace Names:=xmlns');
96     }
97     },
98 wakaba 1.9 },
99     };
100    
101 wakaba 1.14 ## ISSUE: Should we really allow these attributes?
102 wakaba 1.13 $AttrChecker->{''}->{'xml:space'} = $AttrChecker->{$XML_NS}->{space};
103     $AttrChecker->{''}->{'xml:lang'} = $AttrChecker->{$XML_NS}->{lang};
104     $AttrChecker->{''}->{'xml:base'} = $AttrChecker->{$XML_NS}->{base};
105     $AttrChecker->{''}->{'xml:id'} = $AttrChecker->{$XML_NS}->{id};
106    
107 wakaba 1.3 ## ANY
108     my $AnyChecker = sub {
109 wakaba 1.4 my ($self, $todo) = @_;
110     my $el = $todo->{node};
111     my $new_todos = [];
112 wakaba 1.3 my @nodes = (@{$el->child_nodes});
113     while (@nodes) {
114     my $node = shift @nodes;
115     $self->_remove_minuses ($node) and next if ref $node eq 'HASH';
116    
117     my $nt = $node->node_type;
118     if ($nt == 1) {
119     my $node_ns = $node->namespace_uri;
120     $node_ns = '' unless defined $node_ns;
121     my $node_ln = $node->manakai_local_name;
122     if ($self->{minuses}->{$node_ns}->{$node_ln}) {
123     $self->{onerror}->(node => $node, type => 'element not allowed');
124     }
125 wakaba 1.4 push @$new_todos, {type => 'element', node => $node};
126 wakaba 1.3 } elsif ($nt == 5) {
127     unshift @nodes, @{$node->child_nodes};
128     }
129     }
130 wakaba 1.4 return ($new_todos);
131 wakaba 1.3 }; # $AnyChecker
132    
133 wakaba 1.1 my $ElementDefault = {
134     checker => sub {
135 wakaba 1.4 my ($self, $todo) = @_;
136     $self->{onerror}->(node => $todo->{node}, type => 'element not supported');
137     return $AnyChecker->($self, $todo);
138 wakaba 1.1 },
139 wakaba 1.9 attrs_checker => sub {
140     my ($self, $todo) = @_;
141     for my $attr (@{$todo->{node}->attributes}) {
142     my $attr_ns = $attr->namespace_uri;
143     $attr_ns = '' unless defined $attr_ns;
144     my $attr_ln = $attr->manakai_local_name;
145     my $checker = $AttrChecker->{$attr_ns}->{$attr_ln}
146     || $AttrChecker->{$attr_ns}->{''};
147     if ($checker) {
148     $checker->($self, $attr);
149 wakaba 1.17 } else {
150     $self->{onerror}->(node => $attr, type => 'attribute not supported');
151 wakaba 1.9 }
152     }
153     },
154 wakaba 1.1 };
155    
156     my $Element = {};
157    
158     my $HTML_NS = q<http://www.w3.org/1999/xhtml>;
159    
160 wakaba 1.7 my $HTMLMetadataElements = {
161     $HTML_NS => {
162     qw/link 1 meta 1 style 1 script 1 event-source 1 command 1 base 1 title 1/,
163     },
164     };
165 wakaba 1.1
166 wakaba 1.2 my $HTMLSectioningElements = {
167     $HTML_NS => {qw/body 1 section 1 nav 1 article 1 blockquote 1 aside 1/},
168     };
169 wakaba 1.1
170 wakaba 1.7 my $HTMLBlockLevelElements = {
171     $HTML_NS => {
172     qw/
173     section 1 nav 1 article 1 blockquote 1 aside 1
174     h1 1 h2 1 h3 1 h4 1 h5 1 h6 1 header 1 footer 1
175     address 1 p 1 hr 1 dialog 1 pre 1 ol 1 ul 1 dl 1
176     ins 1 del 1 figure 1 map 1 table 1 script 1 noscript 1
177     event-source 1 details 1 datagrid 1 menu 1 div 1 font 1
178     /,
179     },
180     };
181    
182     my $HTMLStrictlyInlineLevelElements = {
183     $HTML_NS => {
184     qw/
185     br 1 a 1 q 1 cite 1 em 1 strong 1 small 1 m 1 dfn 1 abbr 1
186     time 1 meter 1 progress 1 code 1 var 1 samp 1 kbd 1
187     sub 1 sup 1 span 1 i 1 b 1 bdo 1 ins 1 del 1 img 1
188     iframe 1 embed 1 object 1 video 1 audio 1 canvas 1 area 1
189     script 1 noscript 1 event-source 1 command 1 font 1
190     /,
191     },
192     };
193    
194     my $HTMLStructuredInlineLevelElements = {
195     $HTML_NS => {qw/blockquote 1 pre 1 ol 1 ul 1 dl 1 table 1 menu 1/},
196     };
197 wakaba 1.1
198 wakaba 1.6 my $HTMLInteractiveElements = {
199     $HTML_NS => {a => 1, details => 1, datagrid => 1},
200     };
201     ## NOTE: |html:a| and |html:datagrid| are not allowed as a descendant
202     ## of interactive elements
203 wakaba 1.1
204 wakaba 1.7 my $HTMLTransparentElements = {
205     $HTML_NS => {qw/ins 1 font 1 noscript 1/},
206     ## NOTE: |html:noscript| is transparent if scripting is disabled.
207     };
208    
209     #my $HTMLSemiTransparentElements = {
210     # $HTML_NS => {qw/video 1 audio 1/},
211     #};
212    
213     my $HTMLEmbededElements = {
214     $HTML_NS => {qw/img 1 iframe 1 embed 1 object 1 video 1 audio 1 canvas 1/},
215     };
216 wakaba 1.1
217     ## Empty
218     my $HTMLEmptyChecker = sub {
219 wakaba 1.4 my ($self, $todo) = @_;
220     my $el = $todo->{node};
221     my $new_todos = [];
222 wakaba 1.1 my @nodes = (@{$el->child_nodes});
223    
224     while (@nodes) {
225     my $node = shift @nodes;
226 wakaba 1.2 $self->_remove_minuses ($node) and next if ref $node eq 'HASH';
227    
228 wakaba 1.1 my $nt = $node->node_type;
229     if ($nt == 1) {
230 wakaba 1.2 ## NOTE: |minuses| list is not checked since redundant
231     $self->{onerror}->(node => $node, type => 'element not allowed');
232     my ($sib, $ch) = $self->_check_get_children ($node);
233     unshift @nodes, @$sib;
234 wakaba 1.4 push @$new_todos, @$ch;
235 wakaba 1.1 } elsif ($nt == 3 or $nt == 4) {
236 wakaba 1.3 if ($node->data =~ /[^\x09-\x0D\x20]/) {
237     $self->{onerror}->(node => $node, type => 'character not allowed');
238     }
239 wakaba 1.1 } elsif ($nt == 5) {
240     unshift @nodes, @{$node->child_nodes};
241     }
242     }
243 wakaba 1.4 return ($new_todos);
244 wakaba 1.1 };
245    
246     ## Text
247     my $HTMLTextChecker = sub {
248 wakaba 1.4 my ($self, $todo) = @_;
249     my $el = $todo->{node};
250     my $new_todos = [];
251 wakaba 1.1 my @nodes = (@{$el->child_nodes});
252    
253     while (@nodes) {
254     my $node = shift @nodes;
255 wakaba 1.2 $self->_remove_minuses ($node) and next if ref $node eq 'HASH';
256    
257 wakaba 1.1 my $nt = $node->node_type;
258     if ($nt == 1) {
259 wakaba 1.2 ## NOTE: |minuses| list is not checked since redundant
260     $self->{onerror}->(node => $node, type => 'element not allowed');
261     my ($sib, $ch) = $self->_check_get_children ($node);
262     unshift @nodes, @$sib;
263 wakaba 1.4 push @$new_todos, @$ch;
264 wakaba 1.1 } elsif ($nt == 5) {
265     unshift @nodes, @{$node->child_nodes};
266     }
267     }
268 wakaba 1.4 return ($new_todos);
269 wakaba 1.1 };
270    
271     ## Zero or more |html:style| elements,
272     ## followed by zero or more block-level elements
273     my $HTMLStylableBlockChecker = sub {
274 wakaba 1.4 my ($self, $todo) = @_;
275     my $el = $todo->{node};
276     my $new_todos = [];
277 wakaba 1.1 my @nodes = (@{$el->child_nodes});
278    
279     my $has_non_style;
280     while (@nodes) {
281     my $node = shift @nodes;
282 wakaba 1.2 $self->_remove_minuses ($node) and next if ref $node eq 'HASH';
283    
284 wakaba 1.1 my $nt = $node->node_type;
285     if ($nt == 1) {
286 wakaba 1.2 my $node_ns = $node->namespace_uri;
287     $node_ns = '' unless defined $node_ns;
288     my $node_ln = $node->manakai_local_name;
289 wakaba 1.6 my $not_allowed = $self->{minuses}->{$node_ns}->{$node_ln};
290 wakaba 1.8 if ($node_ns eq $HTML_NS and $node_ln eq 'style') {
291 wakaba 1.6 $not_allowed = 1 if $has_non_style;
292 wakaba 1.7 } elsif ($HTMLBlockLevelElements->{$node_ns}->{$node_ln}) {
293     $has_non_style = 1;
294 wakaba 1.1 } else {
295     $has_non_style = 1;
296 wakaba 1.7 $not_allowed = 1;
297 wakaba 1.1 }
298 wakaba 1.6 $self->{onerror}->(node => $node, type => 'element not allowed')
299     if $not_allowed;
300 wakaba 1.2 my ($sib, $ch) = $self->_check_get_children ($node);
301     unshift @nodes, @$sib;
302 wakaba 1.4 push @$new_todos, @$ch;
303 wakaba 1.1 } elsif ($nt == 3 or $nt == 4) {
304     if ($node->data =~ /[^\x09-\x0D\x20]/) {
305 wakaba 1.2 $self->{onerror}->(node => $node, type => 'character not allowed');
306 wakaba 1.1 }
307     } elsif ($nt == 5) {
308     unshift @nodes, @{$node->child_nodes};
309     }
310     }
311 wakaba 1.4 return ($new_todos);
312 wakaba 1.1 }; # $HTMLStylableBlockChecker
313    
314     ## Zero or more block-level elements
315     my $HTMLBlockChecker = sub {
316 wakaba 1.4 my ($self, $todo) = @_;
317     my $el = $todo->{node};
318     my $new_todos = [];
319 wakaba 1.1 my @nodes = (@{$el->child_nodes});
320    
321     while (@nodes) {
322     my $node = shift @nodes;
323 wakaba 1.2 $self->_remove_minuses ($node) and next if ref $node eq 'HASH';
324    
325 wakaba 1.1 my $nt = $node->node_type;
326     if ($nt == 1) {
327 wakaba 1.2 my $node_ns = $node->namespace_uri;
328     $node_ns = '' unless defined $node_ns;
329     my $node_ln = $node->manakai_local_name;
330 wakaba 1.6 my $not_allowed = $self->{minuses}->{$node_ns}->{$node_ln};
331 wakaba 1.7 $not_allowed = 1
332     unless $HTMLBlockLevelElements->{$node_ns}->{$node_ln};
333 wakaba 1.6 $self->{onerror}->(node => $node, type => 'element not allowed')
334     if $not_allowed;
335 wakaba 1.2 my ($sib, $ch) = $self->_check_get_children ($node);
336     unshift @nodes, @$sib;
337 wakaba 1.4 push @$new_todos, @$ch;
338 wakaba 1.1 } elsif ($nt == 3 or $nt == 4) {
339     if ($node->data =~ /[^\x09-\x0D\x20]/) {
340 wakaba 1.2 $self->{onerror}->(node => $node, type => 'character not allowed');
341 wakaba 1.1 }
342     } elsif ($nt == 5) {
343     unshift @nodes, @{$node->child_nodes};
344     }
345     }
346 wakaba 1.4 return ($new_todos);
347 wakaba 1.1 }; # $HTMLBlockChecker
348    
349     ## Inline-level content
350     my $HTMLInlineChecker = sub {
351 wakaba 1.4 my ($self, $todo) = @_;
352     my $el = $todo->{node};
353     my $new_todos = [];
354 wakaba 1.1 my @nodes = (@{$el->child_nodes});
355    
356     while (@nodes) {
357     my $node = shift @nodes;
358 wakaba 1.2 $self->_remove_minuses ($node) and next if ref $node eq 'HASH';
359    
360 wakaba 1.1 my $nt = $node->node_type;
361     if ($nt == 1) {
362 wakaba 1.2 my $node_ns = $node->namespace_uri;
363     $node_ns = '' unless defined $node_ns;
364     my $node_ln = $node->manakai_local_name;
365 wakaba 1.6 my $not_allowed = $self->{minuses}->{$node_ns}->{$node_ln};
366 wakaba 1.7 $not_allowed = 1
367     unless $HTMLStrictlyInlineLevelElements->{$node_ns}->{$node_ln} or
368     $HTMLStructuredInlineLevelElements->{$node_ns}->{$node_ln};
369 wakaba 1.6 $self->{onerror}->(node => $node, type => 'element not allowed')
370     if $not_allowed;
371 wakaba 1.2 my ($sib, $ch) = $self->_check_get_children ($node);
372     unshift @nodes, @$sib;
373 wakaba 1.4 push @$new_todos, @$ch;
374 wakaba 1.1 } elsif ($nt == 5) {
375     unshift @nodes, @{$node->child_nodes};
376     }
377     }
378 wakaba 1.4
379     for (@$new_todos) {
380     $_->{inline} = 1;
381     }
382     return ($new_todos);
383     }; # $HTMLInlineChecker
384 wakaba 1.1
385     my $HTMLSignificantInlineChecker = $HTMLInlineChecker;
386     ## TODO: check significant content
387    
388     ## Strictly inline-level content
389     my $HTMLStrictlyInlineChecker = sub {
390 wakaba 1.4 my ($self, $todo) = @_;
391     my $el = $todo->{node};
392     my $new_todos = [];
393 wakaba 1.1 my @nodes = (@{$el->child_nodes});
394    
395     while (@nodes) {
396     my $node = shift @nodes;
397 wakaba 1.2 $self->_remove_minuses ($node) and next if ref $node eq 'HASH';
398    
399 wakaba 1.1 my $nt = $node->node_type;
400     if ($nt == 1) {
401 wakaba 1.2 my $node_ns = $node->namespace_uri;
402     $node_ns = '' unless defined $node_ns;
403     my $node_ln = $node->manakai_local_name;
404 wakaba 1.6 my $not_allowed = $self->{minuses}->{$node_ns}->{$node_ln};
405 wakaba 1.7 $not_allowed = 1
406     unless $HTMLStrictlyInlineLevelElements->{$node_ns}->{$node_ln};
407 wakaba 1.6 $self->{onerror}->(node => $node, type => 'element not allowed')
408     if $not_allowed;
409 wakaba 1.2 my ($sib, $ch) = $self->_check_get_children ($node);
410     unshift @nodes, @$sib;
411 wakaba 1.4 push @$new_todos, @$ch;
412 wakaba 1.1 } elsif ($nt == 5) {
413     unshift @nodes, @{$node->child_nodes};
414     }
415     }
416 wakaba 1.4
417     for (@$new_todos) {
418     $_->{inline} = 1;
419     $_->{strictly_inline} = 1;
420     }
421     return ($new_todos);
422 wakaba 1.1 }; # $HTMLStrictlyInlineChecker
423    
424     my $HTMLSignificantStrictlyInlineChecker = $HTMLStrictlyInlineChecker;
425     ## TODO: check significant content
426    
427 wakaba 1.4 ## Inline-level or strictly inline-kevek content
428     my $HTMLInlineOrStrictlyInlineChecker = sub {
429     my ($self, $todo) = @_;
430     my $el = $todo->{node};
431     my $new_todos = [];
432     my @nodes = (@{$el->child_nodes});
433    
434     while (@nodes) {
435     my $node = shift @nodes;
436     $self->_remove_minuses ($node) and next if ref $node eq 'HASH';
437    
438     my $nt = $node->node_type;
439     if ($nt == 1) {
440     my $node_ns = $node->namespace_uri;
441     $node_ns = '' unless defined $node_ns;
442     my $node_ln = $node->manakai_local_name;
443 wakaba 1.6 my $not_allowed = $self->{minuses}->{$node_ns}->{$node_ln};
444 wakaba 1.7 if ($todo->{strictly_inline}) {
445     $not_allowed = 1
446     unless $HTMLStrictlyInlineLevelElements->{$node_ns}->{$node_ln};
447     } else {
448     $not_allowed = 1
449     unless $HTMLStrictlyInlineLevelElements->{$node_ns}->{$node_ln} or
450     $HTMLStructuredInlineLevelElements->{$node_ns}->{$node_ln};
451     }
452 wakaba 1.6 $self->{onerror}->(node => $node, type => 'element not allowed')
453     if $not_allowed;
454 wakaba 1.4 my ($sib, $ch) = $self->_check_get_children ($node);
455     unshift @nodes, @$sib;
456     push @$new_todos, @$ch;
457     } elsif ($nt == 5) {
458     unshift @nodes, @{$node->child_nodes};
459     }
460     }
461    
462     for (@$new_todos) {
463     $_->{inline} = 1;
464     $_->{strictly_inline} = 1;
465     }
466     return ($new_todos);
467     }; # $HTMLInlineOrStrictlyInlineChecker
468    
469 wakaba 1.6 my $HTMLSignificantInlineOrStrictlyInlineChecker
470     = $HTMLInlineOrStrictlyInlineChecker;
471     ## TODO: check significant content
472    
473 wakaba 1.1 my $HTMLBlockOrInlineChecker = sub {
474 wakaba 1.4 my ($self, $todo) = @_;
475     my $el = $todo->{node};
476     my $new_todos = [];
477 wakaba 1.1 my @nodes = (@{$el->child_nodes});
478    
479     my $content = 'block-or-inline'; # or 'block' or 'inline'
480     my @block_not_inline;
481     while (@nodes) {
482     my $node = shift @nodes;
483 wakaba 1.2 $self->_remove_minuses ($node) and next if ref $node eq 'HASH';
484    
485 wakaba 1.1 my $nt = $node->node_type;
486     if ($nt == 1) {
487 wakaba 1.2 my $node_ns = $node->namespace_uri;
488     $node_ns = '' unless defined $node_ns;
489     my $node_ln = $node->manakai_local_name;
490 wakaba 1.6 my $not_allowed = $self->{minuses}->{$node_ns}->{$node_ln};
491 wakaba 1.1 if ($content eq 'block') {
492 wakaba 1.7 $not_allowed = 1
493     unless $HTMLBlockLevelElements->{$node_ns}->{$node_ln};
494 wakaba 1.1 } elsif ($content eq 'inline') {
495 wakaba 1.7 $not_allowed = 1
496     unless $HTMLStrictlyInlineLevelElements->{$node_ns}->{$node_ln} or
497     $HTMLStructuredInlineLevelElements->{$node_ns}->{$node_ln};
498 wakaba 1.1 } else {
499 wakaba 1.7 my $is_block = $HTMLBlockLevelElements->{$node_ns}->{$node_ln};
500     my $is_inline
501     = $HTMLStrictlyInlineLevelElements->{$node_ns}->{$node_ln} ||
502     $HTMLStructuredInlineLevelElements->{$node_ns}->{$node_ln};
503 wakaba 1.1
504 wakaba 1.6 push @block_not_inline, $node
505     if $is_block and not $is_inline and not $not_allowed;
506 wakaba 1.1 unless ($is_block) {
507     $content = 'inline';
508     for (@block_not_inline) {
509 wakaba 1.2 $self->{onerror}->(node => $_, type => 'element not allowed');
510 wakaba 1.1 }
511 wakaba 1.6 $not_allowed = 1 unless $is_inline;
512 wakaba 1.1 }
513     }
514 wakaba 1.6 $self->{onerror}->(node => $node, type => 'element not allowed')
515     if $not_allowed;
516 wakaba 1.2 my ($sib, $ch) = $self->_check_get_children ($node);
517     unshift @nodes, @$sib;
518 wakaba 1.4 push @$new_todos, @$ch;
519 wakaba 1.1 } elsif ($nt == 3 or $nt == 4) {
520     if ($node->data =~ /[^\x09-\x0D\x20]/) {
521     if ($content eq 'block') {
522 wakaba 1.2 $self->{onerror}->(node => $node, type => 'character not allowed');
523 wakaba 1.1 } else {
524     $content = 'inline';
525     for (@block_not_inline) {
526 wakaba 1.2 $self->{onerror}->(node => $_, type => 'element not allowed');
527 wakaba 1.1 }
528     }
529     }
530     } elsif ($nt == 5) {
531     unshift @nodes, @{$node->child_nodes};
532     }
533     }
534 wakaba 1.4
535     if ($content eq 'inline') {
536     for (@$new_todos) {
537     $_->{inline} = 1;
538     }
539     }
540     return ($new_todos);
541 wakaba 1.1 };
542    
543 wakaba 1.2 ## Zero or more XXX element, then either block-level or inline-level
544     my $GetHTMLZeroOrMoreThenBlockOrInlineChecker = sub ($$) {
545     my ($elnsuri, $ellname) = @_;
546     return sub {
547 wakaba 1.4 my ($self, $todo) = @_;
548     my $el = $todo->{node};
549     my $new_todos = [];
550 wakaba 1.2 my @nodes = (@{$el->child_nodes});
551    
552     my $has_non_style;
553     my $content = 'block-or-inline'; # or 'block' or 'inline'
554     my @block_not_inline;
555     while (@nodes) {
556     my $node = shift @nodes;
557     $self->_remove_minuses ($node) and next if ref $node eq 'HASH';
558    
559     my $nt = $node->node_type;
560     if ($nt == 1) {
561     my $node_ns = $node->namespace_uri;
562     $node_ns = '' unless defined $node_ns;
563     my $node_ln = $node->manakai_local_name;
564 wakaba 1.6 my $not_allowed = $self->{minuses}->{$node_ns}->{$node_ln};
565 wakaba 1.8 if ($node_ns eq $elnsuri and $node_ln eq $ellname) {
566 wakaba 1.6 $not_allowed = 1 if $has_non_style;
567 wakaba 1.2 } elsif ($content eq 'block') {
568     $has_non_style = 1;
569 wakaba 1.7 $not_allowed = 1
570     unless $HTMLBlockLevelElements->{$node_ns}->{$node_ln};
571 wakaba 1.2 } elsif ($content eq 'inline') {
572     $has_non_style = 1;
573 wakaba 1.7 $not_allowed = 1
574     unless $HTMLStrictlyInlineLevelElements->{$node_ns}->{$node_ln} or
575     $HTMLStructuredInlineLevelElements->{$node_ns}->{$node_ln};
576 wakaba 1.2 } else {
577     $has_non_style = 1;
578 wakaba 1.7 my $is_block = $HTMLBlockLevelElements->{$node_ns}->{$node_ln};
579     my $is_inline
580     = $HTMLStrictlyInlineLevelElements->{$node_ns}->{$node_ln} ||
581     $HTMLStructuredInlineLevelElements->{$node_ns}->{$node_ln};
582 wakaba 1.2
583 wakaba 1.6 push @block_not_inline, $node
584     if $is_block and not $is_inline and not $not_allowed;
585 wakaba 1.2 unless ($is_block) {
586     $content = 'inline';
587     for (@block_not_inline) {
588     $self->{onerror}->(node => $_, type => 'element not allowed');
589     }
590 wakaba 1.6 $not_allowed = 1 unless $is_inline;
591 wakaba 1.1 }
592     }
593 wakaba 1.6 $self->{onerror}->(node => $node, type => 'element not allowed')
594     if $not_allowed;
595 wakaba 1.2 my ($sib, $ch) = $self->_check_get_children ($node);
596     unshift @nodes, @$sib;
597 wakaba 1.4 push @$new_todos, @$ch;
598 wakaba 1.2 } elsif ($nt == 3 or $nt == 4) {
599     if ($node->data =~ /[^\x09-\x0D\x20]/) {
600     $has_non_style = 1;
601     if ($content eq 'block') {
602     $self->{onerror}->(node => $node, type => 'character not allowed');
603     } else {
604     $content = 'inline';
605     for (@block_not_inline) {
606     $self->{onerror}->(node => $_, type => 'element not allowed');
607     }
608 wakaba 1.1 }
609     }
610 wakaba 1.2 } elsif ($nt == 5) {
611     unshift @nodes, @{$node->child_nodes};
612 wakaba 1.1 }
613     }
614 wakaba 1.4
615     if ($content eq 'inline') {
616     for (@$new_todos) {
617     $_->{inline} = 1;
618     }
619     }
620     return ($new_todos);
621 wakaba 1.2 };
622     }; # $GetHTMLZeroOrMoreThenBlockOrInlineChecker
623 wakaba 1.1
624     my $HTMLTransparentChecker = $HTMLBlockOrInlineChecker;
625    
626 wakaba 1.10 my $GetHTMLEnumeratedAttrChecker = sub {
627     my $states = shift; # {value => conforming ? 1 : -1}
628     return sub {
629     my ($self, $attr) = @_;
630     my $value = lc $attr->value; ## TODO: ASCII case insensitibility?
631     if ($states->{$value} > 0) {
632     #
633     } elsif ($states->{$value}) {
634     $self->{onerror}->(node => $attr,
635     type => 'non-conforming enumerated attribute value');
636     } else {
637     $self->{onerror}->(node => $attr,
638     type => 'invalid enumerated attribute value');
639     }
640     };
641     }; # $GetHTMLEnumeratedAttrChecker
642 wakaba 1.9
643 wakaba 1.10 my $GetHTMLBooleanAttrChecker = sub {
644     my $local_name = shift;
645     return sub {
646     my ($self, $attr) = @_;
647     my $value = $attr->value;
648     unless ($value eq $local_name or $value eq '') {
649     $self->{onerror}->(node => $attr,
650     type => 'invalid boolean attribute value');
651     }
652     };
653     }; # $GetHTMLBooleanAttrChecker
654 wakaba 1.9
655 wakaba 1.10 my $HTMLUnorderedSetOfSpaceSeparatedTokensAttrChecker = sub {
656     my ($self, $attr) = @_;
657     my %word;
658     for my $word (grep {length $_} split /[\x09-\x0D\x20]/, $attr->value) {
659     unless ($word{$word}) {
660     $word{$word} = 1;
661 wakaba 1.9 } else {
662 wakaba 1.10 $self->{onerror}->(node => $attr, type => 'duplicate token:'.$word);
663 wakaba 1.9 }
664     }
665 wakaba 1.10 }; # $HTMLUnorderedSetOfSpaceSeparatedTokensAttrChecker
666    
667 wakaba 1.18 ## URI (or IRI)
668 wakaba 1.11 my $HTMLURIAttrChecker = sub {
669     my ($self, $attr) = @_;
670 wakaba 1.15 ## ISSUE: Relative references are allowed? (RFC 3987 "IRI" is an absolute reference with optional fragment identifier.)
671 wakaba 1.18 my $value = $attr->value;
672     Whatpm::URIChecker->check_iri_reference ($value, sub {
673     my %opt = @_;
674     $self->{onerror}->(node => $attr, type => 'URI:'.$opt{level}.':'.$opt{type});
675     });
676 wakaba 1.11 }; # $HTMLURIAttrChecker
677    
678 wakaba 1.15 ## A space separated list of one or more URIs (or IRIs)
679     my $HTMLSpaceURIsAttrChecker = sub {
680     my ($self, $attr) = @_;
681     ## TODO: URI or IRI check
682     ## ISSUE: Relative references?
683     ## ISSUE: Leading or trailing white spaces are conformant?
684     ## ISSUE: A sequence of white space characters are conformant?
685     ## ISSUE: A zero-length string is conformant? (It does contain a relative reference, i.e. same as base URI.)
686     ## NOTE: Duplication seems not an error.
687     }; # $HTMLSpaceURIsAttrChecker
688    
689 wakaba 1.11 my $HTMLIntegerAttrChecker = sub {
690     my ($self, $attr) = @_;
691     my $value = $attr->value;
692     unless ($value =~ /\A-?[0-9]+\z/) {
693 wakaba 1.15 $self->{onerror}->(node => $attr, type => 'integer syntax error');
694 wakaba 1.11 }
695     }; # $HTMLIntegerAttrChecker
696    
697 wakaba 1.12 my $GetHTMLNonNegativeIntegerAttrChecker = sub {
698     my $range_check = shift;
699     return sub {
700     my ($self, $attr) = @_;
701     my $value = $attr->value;
702     if ($value =~ /\A[0-9]+\z/) {
703     unless ($range_check->($value + 0)) {
704     $self->{onerror}->(node => $attr, type => 'out of range');
705     }
706     } else {
707 wakaba 1.15 $self->{onerror}->(node => $attr,
708     type => 'non-negative integer syntax error');
709 wakaba 1.12 }
710     };
711     }; # $GetHTMLNonNegativeIntegerAttrChecker
712    
713 wakaba 1.11 my $GetHTMLFloatingPointNumberAttrChecker = sub {
714     my $range_check = shift;
715     return sub {
716     my ($self, $attr) = @_;
717     my $value = $attr->value;
718     if ($value =~ /\A-?[0-9.]+\z/ and $value =~ /[0-9]/) {
719     unless ($range_check->($value + 0)) {
720     $self->{onerror}->(node => $attr, type => 'out of range');
721     }
722     } else {
723 wakaba 1.15 $self->{onerror}->(node => $attr,
724     type => 'floating point number syntax error');
725 wakaba 1.11 }
726     };
727     }; # $GetHTMLFloatingPointNumberAttrChecker
728    
729 wakaba 1.15 ## "A valid MIME type, optionally with parameters. [RFC 2046]"
730     ## ISSUE: RFC 2046 does not define syntax of media types.
731     ## ISSUE: The definition of "a valid MIME type" is unknown.
732     ## Syntactical correctness?
733     my $HTMLIMTAttrChecker = sub {
734     my ($self, $attr) = @_;
735     my $value = $attr->value;
736     ## ISSUE: RFC 2045 Content-Type header field allows insertion
737     ## of LWS/comments between tokens. Is it allowed in HTML? Maybe no.
738     ## ISSUE: RFC 2231 extension? Maybe no.
739     my $lws0 = qr/(?>(?>\x0D\x0A)?[\x09\x20])*/;
740     my $token = qr/[\x21\x23-\x27\x2A\x2B\x2D\x2E\x30-\x39\x41-\x5A\x5E-\x7E]+/;
741     my $qs = qr/"(?>[\x00-\x0C\x0E-\x21\x23-\x5B\x5D-\x7E]|\x0D\x0A[\x09\x20]|\x5C[\x00-\x7F])*"/;
742 wakaba 1.19 if ($value =~ m#\A$lws0($token)$lws0/$lws0($token)$lws0((?>;$lws0$token$lws0=$lws0(?>$token|$qs)$lws0)*)\z#) {
743     my @type = ($1, $2);
744     my $param = $3;
745     while ($param =~ s/^;$lws0($token)$lws0=$lws0(?>($token)|($qs))$lws0//) {
746     if (defined $2) {
747     push @type, $1 => $2;
748     } else {
749     my $n = $1;
750     my $v = $2;
751     $v =~ s/\\(.)/$1/gs;
752     push @type, $n => $v;
753     }
754     }
755     require Whatpm::IMTChecker;
756     Whatpm::IMTChecker->check_imt (sub {
757     my %opt = @_;
758     $self->{onerror}->(node => $attr,
759     type => 'IMT:'.$opt{level}.':'.$opt{type});
760     }, @type);
761     } else {
762 wakaba 1.15 $self->{onerror}->(node => $attr, type => 'IMT syntax error');
763     }
764     }; # $HTMLIMTAttrChecker
765    
766 wakaba 1.17 my $HTMLLanguageTagAttrChecker = sub {
767     my ($self, $attr) = @_;
768     if ($attr->value eq '') {
769     $self->{onerror}->(node => $attr, type => 'language tag syntax error');
770     }
771     ## TODO: RFC 3066 test
772     ## ISSUE: RFC 4646 (3066bis)?
773     }; # $HTMLLanguageTagAttrChecker
774    
775     ## "A valid media query [MQ]"
776     my $HTMLMQAttrChecker = sub {
777     ## ISSUE: What is "a valid media query"?
778     }; # $HTMLMQAttrChecker
779    
780 wakaba 1.16 my $HTMLEventHandlerAttrChecker = sub {
781     ## TODO: MUST contain valid ECMAScript code matching the
782     ## ECMAScript |FunctionBody| production. [ECMA262]
783     ## ISSUE: MUST be ES3? E4X? ES4? JS1.x?
784     ## ISSUE: Automatic semicolon insertion does not apply?
785     ## ISSUE: Other script languages?
786     }; # $HTMLEventHandlerAttrChecker
787    
788 wakaba 1.17 my $HTMLUsemapAttrChecker = sub {
789     my ($self, $attr) = @_;
790     ## MUST be a valid hashed ID reference to a |map| element
791     my $value = $attr->value;
792     if ($value =~ s/^#//) {
793     ## ISSUE: Is |usemap="#"| conformant? (c.f. |id=""| is non-conformant.)
794     push @{$self->{usemap}}, [$value => $attr];
795     } else {
796     $self->{onerror}->(node => $attr, type => 'hashed idref syntax error');
797     }
798     }; # $HTMLUsemapAttrChecker
799    
800     my $HTMLTargetAttrChecker = sub {
801     my ($self, $attr) = @_;
802     my $value = $attr->value;
803     if ($value =~ /^_/) {
804     $value = lc $value; ## ISSUE: ASCII case-insentitive?
805     unless ({
806     _self => 1, _parent => 1, _top => 1,
807     }->{$value}) {
808     $self->{onerror}->(node => $attr,
809     type => 'reserved browsing context name');
810     }
811     } else {
812     #$ ISSUE: An empty string is conforming?
813     }
814     }; # $HTMLTargetAttrChecker
815    
816 wakaba 1.10 my $HTMLAttrChecker = {
817     id => sub {
818 wakaba 1.17 ## NOTE: |map| has its own variant of |id=""| checker
819 wakaba 1.10 my ($self, $attr) = @_;
820     my $value = $attr->value;
821 wakaba 1.17 if (length $value > 0) {
822 wakaba 1.10 if ($self->{id}->{$value}) {
823     $self->{onerror}->(node => $attr, type => 'duplicate ID');
824     } else {
825     $self->{id}->{$value} = 1;
826     }
827 wakaba 1.17 } else {
828     ## NOTE: MUST contain at least one character
829     $self->{onerror}->(node => $attr, type => 'attribute value is empty');
830 wakaba 1.10 }
831     },
832     title => sub {}, ## NOTE: No conformance creteria
833     lang => sub {
834 wakaba 1.17 ## TODO: RFC 3066 or empty test
835 wakaba 1.10 ## ISSUE: RFC 4646 (3066bis)?
836     ## TODO: HTML vs XHTML
837     },
838     dir => $GetHTMLEnumeratedAttrChecker->({ltr => 1, rtl => 1}),
839     class => $HTMLUnorderedSetOfSpaceSeparatedTokensAttrChecker,
840     irrelevant => $GetHTMLBooleanAttrChecker->('irrelevant'),
841     ## TODO: tabindex
842     };
843    
844 wakaba 1.16 for (qw/
845     onabort onbeforeunload onblur onchange onclick oncontextmenu
846     ondblclick ondrag ondragend ondragenter ondragleave ondragover
847     ondragstart ondrop onerror onfocus onkeydown onkeypress
848     onkeyup onload onmessage onmousedown onmousemove onmouseout
849     onmouseover onmouseup onmousewheel onresize onscroll onselect
850     onsubmit onunload
851     /) {
852     $HTMLAttrChecker->{$_} = $HTMLEventHandlerAttrChecker;
853     }
854    
855 wakaba 1.10 my $GetHTMLAttrsChecker = sub {
856     my $element_specific_checker = shift;
857     return sub {
858     my ($self, $todo) = @_;
859     for my $attr (@{$todo->{node}->attributes}) {
860     my $attr_ns = $attr->namespace_uri;
861     $attr_ns = '' unless defined $attr_ns;
862     my $attr_ln = $attr->manakai_local_name;
863     my $checker;
864     if ($attr_ns eq '') {
865     $checker = $element_specific_checker->{$attr_ln}
866     || $HTMLAttrChecker->{$attr_ln};
867     }
868     $checker ||= $AttrChecker->{$attr_ns}->{$attr_ln}
869     || $AttrChecker->{$attr_ns}->{''};
870     if ($checker) {
871     $checker->($self, $attr);
872     } else {
873     $self->{onerror}->(node => $attr, type => 'attribute not supported');
874     ## ISSUE: No comformance createria for unknown attributes in the spec
875     }
876     }
877     };
878     }; # $GetHTMLAttrsChecker
879 wakaba 1.9
880     $Element->{$HTML_NS}->{''} = {
881 wakaba 1.10 attrs_checker => $GetHTMLAttrsChecker->({}),
882 wakaba 1.9 checker => $ElementDefault->{checker},
883     };
884    
885 wakaba 1.1 $Element->{$HTML_NS}->{html} = {
886 wakaba 1.10 attrs_checker => $GetHTMLAttrsChecker->({
887     xmlns => sub {
888     my ($self, $attr) = @_;
889     my $value = $attr->value;
890     unless ($value eq $HTML_NS) {
891     $self->{onerror}->(node => $attr, type => 'syntax error');
892     ## TODO: only in HTML documents
893     }
894     },
895     }),
896 wakaba 1.1 checker => sub {
897 wakaba 1.4 my ($self, $todo) = @_;
898     my $el = $todo->{node};
899     my $new_todos = [];
900 wakaba 1.1 my @nodes = (@{$el->child_nodes});
901    
902     my $phase = 'before head';
903     while (@nodes) {
904     my $node = shift @nodes;
905 wakaba 1.2 $self->_remove_minuses ($node) and next if ref $node eq 'HASH';
906    
907 wakaba 1.1 my $nt = $node->node_type;
908     if ($nt == 1) {
909 wakaba 1.2 my $node_ns = $node->namespace_uri;
910     $node_ns = '' unless defined $node_ns;
911     my $node_ln = $node->manakai_local_name;
912 wakaba 1.6 my $not_allowed = $self->{minuses}->{$node_ns}->{$node_ln};
913 wakaba 1.1 if ($phase eq 'before head') {
914 wakaba 1.8 if ($node_ns eq $HTML_NS and $node_ln eq 'head') {
915 wakaba 1.1 $phase = 'after head';
916 wakaba 1.8 } elsif ($node_ns eq $HTML_NS and $node_ln eq 'body') {
917     $self->{onerror}->(node => $node, type => 'ps element missing:head');
918 wakaba 1.1 $phase = 'after body';
919     } else {
920 wakaba 1.6 $not_allowed = 1;
921 wakaba 1.1 # before head
922     }
923     } elsif ($phase eq 'after head') {
924 wakaba 1.8 if ($node_ns eq $HTML_NS and $node_ln eq 'body') {
925 wakaba 1.1 $phase = 'after body';
926     } else {
927 wakaba 1.6 $not_allowed = 1;
928 wakaba 1.1 # after head
929     }
930     } else { #elsif ($phase eq 'after body') {
931 wakaba 1.6 $not_allowed = 1;
932 wakaba 1.1 # after body
933     }
934 wakaba 1.6 $self->{onerror}->(node => $node, type => 'element not allowed')
935     if $not_allowed;
936 wakaba 1.2 my ($sib, $ch) = $self->_check_get_children ($node);
937     unshift @nodes, @$sib;
938 wakaba 1.4 push @$new_todos, @$ch;
939 wakaba 1.1 } elsif ($nt == 3 or $nt == 4) {
940     if ($node->data =~ /[^\x09-\x0D\x20]/) {
941 wakaba 1.2 $self->{onerror}->(node => $node, type => 'character not allowed');
942 wakaba 1.1 }
943     } elsif ($nt == 5) {
944     unshift @nodes, @{$node->child_nodes};
945     }
946     }
947 wakaba 1.3
948     if ($phase eq 'before head') {
949     $self->{onerror}->(node => $el, type => 'child element missing:head');
950     $self->{onerror}->(node => $el, type => 'child element missing:body');
951     } elsif ($phase eq 'after head') {
952     $self->{onerror}->(node => $el, type => 'child element missing:body');
953     }
954    
955 wakaba 1.4 return ($new_todos);
956 wakaba 1.1 },
957     };
958    
959     $Element->{$HTML_NS}->{head} = {
960 wakaba 1.10 attrs_checker => $GetHTMLAttrsChecker->({}),
961 wakaba 1.1 checker => sub {
962 wakaba 1.4 my ($self, $todo) = @_;
963     my $el = $todo->{node};
964     my $new_todos = [];
965 wakaba 1.1 my @nodes = (@{$el->child_nodes});
966    
967     my $has_title;
968 wakaba 1.3 my $phase = 'initial'; # 'after charset', 'after base'
969 wakaba 1.1 while (@nodes) {
970     my $node = shift @nodes;
971 wakaba 1.2 $self->_remove_minuses ($node) and next if ref $node eq 'HASH';
972    
973 wakaba 1.1 my $nt = $node->node_type;
974     if ($nt == 1) {
975 wakaba 1.2 my $node_ns = $node->namespace_uri;
976     $node_ns = '' unless defined $node_ns;
977     my $node_ln = $node->manakai_local_name;
978 wakaba 1.6 my $not_allowed = $self->{minuses}->{$node_ns}->{$node_ln};
979 wakaba 1.8 if ($node_ns eq $HTML_NS and $node_ln eq 'title') {
980 wakaba 1.3 $phase = 'after base';
981 wakaba 1.1 unless ($has_title) {
982     $has_title = 1;
983     } else {
984 wakaba 1.6 $not_allowed = 1;
985 wakaba 1.1 }
986 wakaba 1.8 } elsif ($node_ns eq $HTML_NS and $node_ln eq 'meta') {
987 wakaba 1.1 if ($node->has_attribute_ns (undef, 'charset')) {
988 wakaba 1.3 if ($phase eq 'initial') {
989     $phase = 'after charset';
990 wakaba 1.1 } else {
991 wakaba 1.6 $not_allowed = 1;
992 wakaba 1.3 ## NOTE: See also |base|'s "contexts" field in the spec
993 wakaba 1.1 }
994     } else {
995 wakaba 1.3 $phase = 'after base';
996 wakaba 1.1 }
997 wakaba 1.8 } elsif ($node_ns eq $HTML_NS and $node_ln eq 'base') {
998 wakaba 1.3 if ($phase eq 'initial' or $phase eq 'after charset') {
999     $phase = 'after base';
1000 wakaba 1.1 } else {
1001 wakaba 1.6 $not_allowed = 1;
1002 wakaba 1.1 }
1003 wakaba 1.7 } elsif ($HTMLMetadataElements->{$node_ns}->{$node_ln}) {
1004     $phase = 'after base';
1005 wakaba 1.1 } else {
1006 wakaba 1.7 $not_allowed = 1;
1007 wakaba 1.1 }
1008 wakaba 1.6 $self->{onerror}->(node => $node, type => 'element not allowed')
1009     if $not_allowed;
1010 wakaba 1.2 my ($sib, $ch) = $self->_check_get_children ($node);
1011     unshift @nodes, @$sib;
1012 wakaba 1.4 push @$new_todos, @$ch;
1013 wakaba 1.1 } elsif ($nt == 3 or $nt == 4) {
1014     if ($node->data =~ /[^\x09-\x0D\x20]/) {
1015 wakaba 1.2 $self->{onerror}->(node => $node, type => 'character not allowed');
1016 wakaba 1.1 }
1017     } elsif ($nt == 5) {
1018     unshift @nodes, @{$node->child_nodes};
1019     }
1020     }
1021     unless ($has_title) {
1022 wakaba 1.3 $self->{onerror}->(node => $el, type => 'child element missing:title');
1023 wakaba 1.1 }
1024 wakaba 1.4 return ($new_todos);
1025 wakaba 1.1 },
1026     };
1027    
1028     $Element->{$HTML_NS}->{title} = {
1029 wakaba 1.10 attrs_checker => $GetHTMLAttrsChecker->({}),
1030 wakaba 1.1 checker => $HTMLTextChecker,
1031     };
1032    
1033     $Element->{$HTML_NS}->{base} = {
1034 wakaba 1.10 attrs_checker => $GetHTMLAttrsChecker->({
1035 wakaba 1.11 href => $HTMLURIAttrChecker,
1036 wakaba 1.17 target => $HTMLTargetAttrChecker,
1037 wakaba 1.10 }),
1038 wakaba 1.1 checker => $HTMLEmptyChecker,
1039     };
1040    
1041     $Element->{$HTML_NS}->{link} = {
1042 wakaba 1.16 attrs_checker => sub {
1043     my ($self, $todo) = @_;
1044     $GetHTMLAttrsChecker->({
1045     href => $HTMLURIAttrChecker,
1046     rel => $HTMLUnorderedSetOfSpaceSeparatedTokensAttrChecker, ## TODO: registered? check
1047 wakaba 1.17 media => $HTMLMQAttrChecker,
1048     hreflang => $HTMLLanguageTagAttrChecker,
1049 wakaba 1.16 type => $HTMLIMTAttrChecker,
1050     ## NOTE: Though |title| has special semantics,
1051     ## syntactically same as the |title| as global attribute.
1052     })->($self, $todo);
1053     unless ($todo->{node}->has_attribute_ns (undef, 'href')) {
1054     $self->{onerror}->(node => $todo->{node},
1055     type => 'attribute missing:href');
1056     }
1057     unless ($todo->{node}->has_attribute_ns (undef, 'rel')) {
1058     $self->{onerror}->(node => $todo->{node},
1059     type => 'attribute missing:rel');
1060     }
1061     },
1062 wakaba 1.1 checker => $HTMLEmptyChecker,
1063     };
1064    
1065     $Element->{$HTML_NS}->{meta} = {
1066 wakaba 1.10 attrs_checker => sub {
1067     my ($self, $todo) = @_;
1068     my $name_attr;
1069     my $http_equiv_attr;
1070     my $charset_attr;
1071     my $content_attr;
1072     for my $attr (@{$todo->{node}->attributes}) {
1073     my $attr_ns = $attr->namespace_uri;
1074     $attr_ns = '' unless defined $attr_ns;
1075     my $attr_ln = $attr->manakai_local_name;
1076     my $checker;
1077     if ($attr_ns eq '') {
1078     if ($attr_ln eq 'content') {
1079     $content_attr = $attr;
1080     $checker = 1;
1081     } elsif ($attr_ln eq 'name') {
1082     $name_attr = $attr;
1083     $checker = 1;
1084     } elsif ($attr_ln eq 'http-equiv') {
1085     $http_equiv_attr = $attr;
1086     $checker = 1;
1087     } elsif ($attr_ln eq 'charset') {
1088     $charset_attr = $attr;
1089     $checker = 1;
1090     } else {
1091     $checker = $HTMLAttrChecker->{$attr_ln}
1092     || $AttrChecker->{$attr_ns}->{$attr_ln}
1093     || $AttrChecker->{$attr_ns}->{''};
1094     }
1095     } else {
1096     $checker ||= $AttrChecker->{$attr_ns}->{$attr_ln}
1097     || $AttrChecker->{$attr_ns}->{''};
1098     }
1099     if ($checker) {
1100     $checker->($self, $attr) if ref $checker;
1101     } else {
1102     $self->{onerror}->(node => $attr, type => 'attribute not supported');
1103     ## ISSUE: No comformance createria for unknown attributes in the spec
1104     }
1105     }
1106    
1107     if (defined $name_attr) {
1108     if (defined $http_equiv_attr) {
1109     $self->{onerror}->(node => $http_equiv_attr,
1110     type => 'attribute not allowed');
1111     } elsif (defined $charset_attr) {
1112     $self->{onerror}->(node => $charset_attr,
1113     type => 'attribute not allowed');
1114     }
1115     my $metadata_name = $name_attr->value;
1116     my $metadata_value;
1117     if (defined $content_attr) {
1118     $metadata_value = $content_attr->value;
1119     } else {
1120     $self->{onerror}->(node => $todo->{node},
1121     type => 'attribute missing:content');
1122     $metadata_value = '';
1123     }
1124     } elsif (defined $http_equiv_attr) {
1125     if (defined $charset_attr) {
1126     $self->{onerror}->(node => $charset_attr,
1127     type => 'attribute not allowed');
1128     }
1129     unless (defined $content_attr) {
1130     $self->{onerror}->(node => $todo->{node},
1131     type => 'attribute missing:content');
1132     }
1133     } elsif (defined $charset_attr) {
1134     if (defined $content_attr) {
1135     $self->{onerror}->(node => $content_attr,
1136     type => 'attribute not allowed');
1137     }
1138     ## TODO: Allowed only in HTML documents
1139     } else {
1140     if (defined $content_attr) {
1141     $self->{onerror}->(node => $content_attr,
1142     type => 'attribute not allowed');
1143     $self->{onerror}->(node => $todo->{node},
1144     type => 'attribute missing:name|http-equiv');
1145     } else {
1146     $self->{onerror}->(node => $todo->{node},
1147     type => 'attribute missing:name|http-equiv|charset');
1148     }
1149     }
1150    
1151     ## TODO: metadata conformance
1152    
1153     ## TODO: pragma conformance
1154     if (defined $http_equiv_attr) { ## An enumerated attribute
1155     my $keyword = lc $http_equiv_attr->value; ## TODO: ascii case?
1156     if ({
1157     'refresh' => 1,
1158     'default-style' => 1,
1159     }->{$keyword}) {
1160     #
1161     } else {
1162     $self->{onerror}->(node => $http_equiv_attr,
1163     type => 'invalid enumerated attribute value');
1164     }
1165     }
1166    
1167     ## TODO: charset
1168     },
1169 wakaba 1.1 checker => $HTMLEmptyChecker,
1170     };
1171    
1172     ## NOTE: |html:style| has no conformance creteria on content model
1173 wakaba 1.3 $Element->{$HTML_NS}->{style} = {
1174 wakaba 1.10 attrs_checker => $GetHTMLAttrsChecker->({
1175 wakaba 1.15 type => $HTMLIMTAttrChecker, ## TODO: MUST be a styling language
1176 wakaba 1.17 media => $HTMLMQAttrChecker,
1177 wakaba 1.10 scoped => $GetHTMLBooleanAttrChecker->('scoped'),
1178     ## NOTE: |title| has special semantics for |style|s, but is syntactically
1179     ## not different
1180     }),
1181 wakaba 1.3 checker => $AnyChecker,
1182     };
1183 wakaba 1.1
1184     $Element->{$HTML_NS}->{body} = {
1185 wakaba 1.10 attrs_checker => $GetHTMLAttrsChecker->({}),
1186 wakaba 1.1 checker => $HTMLBlockChecker,
1187     };
1188    
1189     $Element->{$HTML_NS}->{section} = {
1190 wakaba 1.10 attrs_checker => $GetHTMLAttrsChecker->({}),
1191 wakaba 1.1 checker => $HTMLStylableBlockChecker,
1192     };
1193    
1194     $Element->{$HTML_NS}->{nav} = {
1195 wakaba 1.10 attrs_checker => $GetHTMLAttrsChecker->({}),
1196 wakaba 1.1 checker => $HTMLBlockOrInlineChecker,
1197     };
1198    
1199     $Element->{$HTML_NS}->{article} = {
1200 wakaba 1.10 attrs_checker => $GetHTMLAttrsChecker->({}),
1201 wakaba 1.1 checker => $HTMLStylableBlockChecker,
1202     };
1203    
1204     $Element->{$HTML_NS}->{blockquote} = {
1205 wakaba 1.11 attrs_checker => $GetHTMLAttrsChecker->({
1206     cite => $HTMLURIAttrChecker,
1207     }),
1208 wakaba 1.1 checker => $HTMLBlockChecker,
1209     };
1210    
1211     $Element->{$HTML_NS}->{aside} = {
1212 wakaba 1.10 attrs_checker => $GetHTMLAttrsChecker->({}),
1213 wakaba 1.2 checker => $GetHTMLZeroOrMoreThenBlockOrInlineChecker->($HTML_NS, 'style'),
1214 wakaba 1.1 };
1215    
1216     $Element->{$HTML_NS}->{h1} = {
1217 wakaba 1.10 attrs_checker => $GetHTMLAttrsChecker->({}),
1218 wakaba 1.1 checker => $HTMLSignificantStrictlyInlineChecker,
1219     };
1220    
1221     $Element->{$HTML_NS}->{h2} = {
1222 wakaba 1.10 attrs_checker => $GetHTMLAttrsChecker->({}),
1223 wakaba 1.1 checker => $HTMLSignificantStrictlyInlineChecker,
1224     };
1225    
1226     $Element->{$HTML_NS}->{h3} = {
1227 wakaba 1.10 attrs_checker => $GetHTMLAttrsChecker->({}),
1228 wakaba 1.1 checker => $HTMLSignificantStrictlyInlineChecker,
1229     };
1230    
1231     $Element->{$HTML_NS}->{h4} = {
1232 wakaba 1.10 attrs_checker => $GetHTMLAttrsChecker->({}),
1233 wakaba 1.1 checker => $HTMLSignificantStrictlyInlineChecker,
1234     };
1235    
1236     $Element->{$HTML_NS}->{h5} = {
1237 wakaba 1.10 attrs_checker => $GetHTMLAttrsChecker->({}),
1238 wakaba 1.1 checker => $HTMLSignificantStrictlyInlineChecker,
1239     };
1240    
1241     $Element->{$HTML_NS}->{h6} = {
1242 wakaba 1.10 attrs_checker => $GetHTMLAttrsChecker->({}),
1243 wakaba 1.1 checker => $HTMLSignificantStrictlyInlineChecker,
1244     };
1245    
1246     ## TODO: header
1247    
1248 wakaba 1.2 $Element->{$HTML_NS}->{footer} = {
1249 wakaba 1.10 attrs_checker => $GetHTMLAttrsChecker->({}),
1250 wakaba 1.2 checker => sub { ## block -hn -header -footer -sectioning or inline
1251 wakaba 1.4 my ($self, $todo) = @_;
1252     my $el = $todo->{node};
1253     my $new_todos = [];
1254 wakaba 1.2 my @nodes = (@{$el->child_nodes});
1255    
1256     my $content = 'block-or-inline'; # or 'block' or 'inline'
1257     my @block_not_inline;
1258     while (@nodes) {
1259     my $node = shift @nodes;
1260     $self->_remove_minuses ($node) and next if ref $node eq 'HASH';
1261    
1262     my $nt = $node->node_type;
1263     if ($nt == 1) {
1264     my $node_ns = $node->namespace_uri;
1265     $node_ns = '' unless defined $node_ns;
1266     my $node_ln = $node->manakai_local_name;
1267 wakaba 1.6 my $not_allowed;
1268 wakaba 1.2 if ($self->{minuses}->{$node_ns}->{$node_ln}) {
1269 wakaba 1.6 $not_allowed = 1;
1270 wakaba 1.2 } elsif ($node_ns eq $HTML_NS and
1271     {
1272     qw/h1 1 h2 1 h3 1 h4 1 h5 1 h6 1 header 1 footer 1/
1273     }->{$node_ln}) {
1274 wakaba 1.6 $not_allowed = 1;
1275 wakaba 1.2 } elsif ($HTMLSectioningElements->{$node_ns}->{$node_ln}) {
1276 wakaba 1.6 $not_allowed = 1;
1277 wakaba 1.2 }
1278     if ($content eq 'block') {
1279 wakaba 1.7 $not_allowed = 1
1280     unless $HTMLBlockLevelElements->{$node_ns}->{$node_ln};
1281 wakaba 1.2 } elsif ($content eq 'inline') {
1282 wakaba 1.7 $not_allowed = 1
1283     unless $HTMLStrictlyInlineLevelElements->{$node_ns}->{$node_ln} or
1284     $HTMLStructuredInlineLevelElements->{$node_ns}->{$node_ln};
1285 wakaba 1.2 } else {
1286 wakaba 1.7 my $is_block = $HTMLBlockLevelElements->{$node_ns}->{$node_ln};
1287     my $is_inline
1288     = $HTMLStrictlyInlineLevelElements->{$node_ns}->{$node_ln} ||
1289     $HTMLStructuredInlineLevelElements->{$node_ns}->{$node_ln};
1290 wakaba 1.2
1291 wakaba 1.6 push @block_not_inline, $node
1292     if $is_block and not $is_inline and not $not_allowed;
1293 wakaba 1.2 unless ($is_block) {
1294     $content = 'inline';
1295     for (@block_not_inline) {
1296     $self->{onerror}->(node => $_, type => 'element not allowed');
1297     }
1298 wakaba 1.6 $not_allowed = 1 unless $is_inline;
1299 wakaba 1.2 }
1300     }
1301 wakaba 1.6 $self->{onerror}->(node => $node, type => 'element not allowed')
1302     if $not_allowed;
1303 wakaba 1.2 my ($sib, $ch) = $self->_check_get_children ($node);
1304     unshift @nodes, @$sib;
1305 wakaba 1.4 push @$new_todos, @$ch;
1306 wakaba 1.2 } elsif ($nt == 3 or $nt == 4) {
1307     if ($node->data =~ /[^\x09-\x0D\x20]/) {
1308     if ($content eq 'block') {
1309     $self->{onerror}->(node => $node, type => 'character not allowed');
1310     } else {
1311     $content = 'inline';
1312     for (@block_not_inline) {
1313     $self->{onerror}->(node => $_, type => 'element not allowed');
1314     }
1315     }
1316     }
1317     } elsif ($nt == 5) {
1318     unshift @nodes, @{$node->child_nodes};
1319     }
1320     }
1321    
1322     my $end = $self->_add_minuses
1323     ({$HTML_NS => {qw/h1 1 h2 1 h3 1 h4 1 h5 1 h6 1/}},
1324     $HTMLSectioningElements);
1325 wakaba 1.4 push @$new_todos, $end;
1326 wakaba 1.2
1327 wakaba 1.4 if ($content eq 'inline') {
1328     for (@$new_todos) {
1329     $_->{inline} = 1;
1330     }
1331     }
1332    
1333     return ($new_todos);
1334 wakaba 1.2 },
1335     };
1336 wakaba 1.1
1337     $Element->{$HTML_NS}->{address} = {
1338 wakaba 1.10 attrs_checker => $GetHTMLAttrsChecker->({}),
1339 wakaba 1.1 checker => $HTMLInlineChecker,
1340     };
1341    
1342     $Element->{$HTML_NS}->{p} = {
1343 wakaba 1.10 attrs_checker => $GetHTMLAttrsChecker->({}),
1344 wakaba 1.1 checker => $HTMLSignificantInlineChecker,
1345     };
1346    
1347     $Element->{$HTML_NS}->{hr} = {
1348 wakaba 1.10 attrs_checker => $GetHTMLAttrsChecker->({}),
1349 wakaba 1.1 checker => $HTMLEmptyChecker,
1350     };
1351    
1352     $Element->{$HTML_NS}->{br} = {
1353 wakaba 1.10 attrs_checker => $GetHTMLAttrsChecker->({}),
1354 wakaba 1.1 checker => $HTMLEmptyChecker,
1355     };
1356    
1357     $Element->{$HTML_NS}->{dialog} = {
1358 wakaba 1.10 attrs_checker => $GetHTMLAttrsChecker->({}),
1359 wakaba 1.1 checker => sub {
1360 wakaba 1.4 my ($self, $todo) = @_;
1361     my $el = $todo->{node};
1362     my $new_todos = [];
1363 wakaba 1.1 my @nodes = (@{$el->child_nodes});
1364    
1365     my $phase = 'before dt';
1366     while (@nodes) {
1367     my $node = shift @nodes;
1368 wakaba 1.2 $self->_remove_minuses ($node) and next if ref $node eq 'HASH';
1369    
1370 wakaba 1.1 my $nt = $node->node_type;
1371     if ($nt == 1) {
1372 wakaba 1.8 my $node_ns = $node->namespace_uri;
1373     $node_ns = '' unless defined $node_ns;
1374     my $node_ln = $node->manakai_local_name;
1375 wakaba 1.2 ## NOTE: |minuses| list is not checked since redundant
1376 wakaba 1.1 if ($phase eq 'before dt') {
1377 wakaba 1.8 if ($node_ns eq $HTML_NS and $node_ln eq 'dt') {
1378 wakaba 1.1 $phase = 'before dd';
1379 wakaba 1.8 } elsif ($node_ns eq $HTML_NS and $node_ln eq 'dd') {
1380 wakaba 1.2 $self->{onerror}
1381 wakaba 1.3 ->(node => $node, type => 'ps element missing:dt');
1382 wakaba 1.1 $phase = 'before dt';
1383     } else {
1384 wakaba 1.2 $self->{onerror}->(node => $node, type => 'element not allowed');
1385 wakaba 1.1 }
1386     } else { # before dd
1387 wakaba 1.8 if ($node_ns eq $HTML_NS and $node_ln eq 'dd') {
1388 wakaba 1.1 $phase = 'before dt';
1389 wakaba 1.8 } elsif ($node_ns eq $HTML_NS and $node_ln eq 'dt') {
1390 wakaba 1.2 $self->{onerror}
1391 wakaba 1.3 ->(node => $node, type => 'ps element missing:dd');
1392 wakaba 1.1 $phase = 'before dd';
1393     } else {
1394 wakaba 1.2 $self->{onerror}->(node => $node, type => 'element not allowed');
1395 wakaba 1.1 }
1396     }
1397 wakaba 1.2 my ($sib, $ch) = $self->_check_get_children ($node);
1398     unshift @nodes, @$sib;
1399 wakaba 1.4 push @$new_todos, @$ch;
1400 wakaba 1.1 } elsif ($nt == 3 or $nt == 4) {
1401     if ($node->data =~ /[^\x09-\x0D\x20]/) {
1402 wakaba 1.2 $self->{onerror}->(node => $node, type => 'character not allowed');
1403 wakaba 1.1 }
1404     } elsif ($nt == 5) {
1405     unshift @nodes, @{$node->child_nodes};
1406     }
1407     }
1408     if ($phase eq 'before dd') {
1409 wakaba 1.3 $self->{onerror}->(node => $el, type => 'ps element missing:dd');
1410 wakaba 1.1 }
1411 wakaba 1.4 return ($new_todos);
1412 wakaba 1.1 },
1413     };
1414    
1415     $Element->{$HTML_NS}->{pre} = {
1416 wakaba 1.10 attrs_checker => $GetHTMLAttrsChecker->({}),
1417 wakaba 1.1 checker => $HTMLStrictlyInlineChecker,
1418     };
1419    
1420     $Element->{$HTML_NS}->{ol} = {
1421 wakaba 1.11 attrs_checker => $GetHTMLAttrsChecker->({
1422     start => $HTMLIntegerAttrChecker,
1423     }),
1424 wakaba 1.1 checker => sub {
1425 wakaba 1.4 my ($self, $todo) = @_;
1426     my $el = $todo->{node};
1427     my $new_todos = [];
1428 wakaba 1.1 my @nodes = (@{$el->child_nodes});
1429    
1430     while (@nodes) {
1431     my $node = shift @nodes;
1432 wakaba 1.2 $self->_remove_minuses ($node) and next if ref $node eq 'HASH';
1433    
1434 wakaba 1.1 my $nt = $node->node_type;
1435     if ($nt == 1) {
1436 wakaba 1.8 my $node_ns = $node->namespace_uri;
1437     $node_ns = '' unless defined $node_ns;
1438     my $node_ln = $node->manakai_local_name;
1439 wakaba 1.2 ## NOTE: |minuses| list is not checked since redundant
1440 wakaba 1.8 unless ($node_ns eq $HTML_NS and $node_ln eq 'li') {
1441 wakaba 1.2 $self->{onerror}->(node => $node, type => 'element not allowed');
1442 wakaba 1.1 }
1443 wakaba 1.2 my ($sib, $ch) = $self->_check_get_children ($node);
1444     unshift @nodes, @$sib;
1445 wakaba 1.4 push @$new_todos, @$ch;
1446 wakaba 1.1 } elsif ($nt == 3 or $nt == 4) {
1447     if ($node->data =~ /[^\x09-\x0D\x20]/) {
1448 wakaba 1.2 $self->{onerror}->(node => $node, type => 'character not allowed');
1449 wakaba 1.1 }
1450     } elsif ($nt == 5) {
1451     unshift @nodes, @{$node->child_nodes};
1452     }
1453     }
1454 wakaba 1.4
1455     if ($todo->{inline}) {
1456     for (@$new_todos) {
1457     $_->{inline} = 1;
1458     }
1459     }
1460     return ($new_todos);
1461 wakaba 1.1 },
1462     };
1463    
1464     $Element->{$HTML_NS}->{ul} = {
1465 wakaba 1.10 attrs_checker => $GetHTMLAttrsChecker->({}),
1466 wakaba 1.1 checker => $Element->{$HTML_NS}->{ol}->{checker},
1467     };
1468    
1469 wakaba 1.5
1470     $Element->{$HTML_NS}->{li} = {
1471 wakaba 1.11 attrs_checker => $GetHTMLAttrsChecker->({
1472     start => sub {
1473     my ($self, $attr) = @_;
1474     my $parent = $attr->owner_element->manakai_parent_element;
1475     if (defined $parent) {
1476     my $parent_ns = $parent->namespace_uri;
1477     $parent_ns = '' unless defined $parent_ns;
1478     my $parent_ln = $parent->manakai_local_name;
1479     unless ($parent_ns eq $HTML_NS and $parent_ln eq 'ol') {
1480     $self->{onerror}->(node => $attr, type => 'attribute not supported');
1481     }
1482     }
1483     $HTMLIntegerAttrChecker->($self, $attr);
1484     },
1485     }),
1486 wakaba 1.5 checker => sub {
1487     my ($self, $todo) = @_;
1488     if ($todo->{inline}) {
1489     return $HTMLInlineChecker->($self, $todo);
1490     } else {
1491     return $HTMLBlockOrInlineChecker->($self, $todo);
1492     }
1493     },
1494     };
1495 wakaba 1.1
1496     $Element->{$HTML_NS}->{dl} = {
1497 wakaba 1.10 attrs_checker => $GetHTMLAttrsChecker->({}),
1498 wakaba 1.1 checker => sub {
1499 wakaba 1.4 my ($self, $todo) = @_;
1500     my $el = $todo->{node};
1501     my $new_todos = [];
1502 wakaba 1.1 my @nodes = (@{$el->child_nodes});
1503    
1504     my $phase = 'before dt';
1505     while (@nodes) {
1506     my $node = shift @nodes;
1507 wakaba 1.2 $self->_remove_minuses ($node) and next if ref $node eq 'HASH';
1508    
1509 wakaba 1.1 my $nt = $node->node_type;
1510     if ($nt == 1) {
1511 wakaba 1.8 my $node_ns = $node->namespace_uri;
1512     $node_ns = '' unless defined $node_ns;
1513     my $node_ln = $node->manakai_local_name;
1514 wakaba 1.2 ## NOTE: |minuses| list is not checked since redundant
1515 wakaba 1.1 if ($phase eq 'in dds') {
1516 wakaba 1.8 if ($node_ns eq $HTML_NS and $node_ln eq 'dd') {
1517 wakaba 1.1 #$phase = 'in dds';
1518 wakaba 1.8 } elsif ($node_ns eq $HTML_NS and $node_ln eq 'dt') {
1519 wakaba 1.1 $phase = 'in dts';
1520     } else {
1521 wakaba 1.2 $self->{onerror}->(node => $node, type => 'element not allowed');
1522 wakaba 1.1 }
1523     } elsif ($phase eq 'in dts') {
1524 wakaba 1.8 if ($node_ns eq $HTML_NS and $node_ln eq 'dt') {
1525 wakaba 1.1 #$phase = 'in dts';
1526 wakaba 1.8 } elsif ($node_ns eq $HTML_NS and $node_ln eq 'dd') {
1527 wakaba 1.1 $phase = 'in dds';
1528     } else {
1529 wakaba 1.2 $self->{onerror}->(node => $node, type => 'element not allowed');
1530 wakaba 1.1 }
1531     } else { # before dt
1532 wakaba 1.8 if ($node_ns eq $HTML_NS and $node_ln eq 'dt') {
1533 wakaba 1.1 $phase = 'in dts';
1534 wakaba 1.8 } elsif ($node_ns eq $HTML_NS and $node_ln eq 'dd') {
1535 wakaba 1.2 $self->{onerror}
1536 wakaba 1.3 ->(node => $node, type => 'ps element missing:dt');
1537 wakaba 1.1 $phase = 'in dds';
1538     } else {
1539 wakaba 1.2 $self->{onerror}->(node => $node, type => 'element not allowed');
1540 wakaba 1.1 }
1541     }
1542 wakaba 1.2 my ($sib, $ch) = $self->_check_get_children ($node);
1543     unshift @nodes, @$sib;
1544 wakaba 1.4 push @$new_todos, @$ch;
1545 wakaba 1.1 } elsif ($nt == 3 or $nt == 4) {
1546     if ($node->data =~ /[^\x09-\x0D\x20]/) {
1547 wakaba 1.2 $self->{onerror}->(node => $node, type => 'character not allowed');
1548 wakaba 1.1 }
1549     } elsif ($nt == 5) {
1550     unshift @nodes, @{$node->child_nodes};
1551     }
1552     }
1553     if ($phase eq 'in dts') {
1554 wakaba 1.3 $self->{onerror}->(node => $el, type => 'ps element missing:dd');
1555 wakaba 1.1 }
1556 wakaba 1.4
1557     if ($todo->{inline}) {
1558     for (@$new_todos) {
1559     $_->{inline} = 1;
1560     }
1561     }
1562     return ($new_todos);
1563 wakaba 1.1 },
1564     };
1565    
1566     $Element->{$HTML_NS}->{dt} = {
1567 wakaba 1.10 attrs_checker => $GetHTMLAttrsChecker->({}),
1568 wakaba 1.1 checker => $HTMLStrictlyInlineChecker,
1569     };
1570    
1571 wakaba 1.4 $Element->{$HTML_NS}->{dd} = {
1572 wakaba 1.10 attrs_checker => $GetHTMLAttrsChecker->({}),
1573 wakaba 1.5 checker => $Element->{$HTML_NS}->{li}->{checker},
1574 wakaba 1.4 };
1575 wakaba 1.1
1576 wakaba 1.6 $Element->{$HTML_NS}->{a} = {
1577 wakaba 1.17 attrs_checker => sub {
1578     my ($self, $todo) = @_;
1579 wakaba 1.15 my %attr;
1580 wakaba 1.17 for my $attr (@{$todo->{node}->attributes}) {
1581     my $attr_ns = $attr->namespace_uri;
1582     $attr_ns = '' unless defined $attr_ns;
1583     my $attr_ln = $attr->manakai_local_name;
1584     my $checker;
1585     if ($attr_ns eq '') {
1586     $checker = {
1587     target => $HTMLTargetAttrChecker,
1588     href => $HTMLURIAttrChecker,
1589     ping => $HTMLSpaceURIsAttrChecker,
1590     rel => $HTMLUnorderedSetOfSpaceSeparatedTokensAttrChecker, ## TODO: registered? check
1591     media => $HTMLMQAttrChecker,
1592     hreflang => $HTMLLanguageTagAttrChecker,
1593     type => $HTMLIMTAttrChecker,
1594     }->{$attr_ln};
1595     if ($checker) {
1596     $attr{$attr_ln} = $attr;
1597     } else {
1598     $checker = $HTMLAttrChecker->{$attr_ln};
1599     }
1600     }
1601     $checker ||= $AttrChecker->{$attr_ns}->{$attr_ln}
1602     || $AttrChecker->{$attr_ns}->{''};
1603     if ($checker) {
1604     $checker->($self, $attr) if ref $checker;
1605     } else {
1606     $self->{onerror}->(node => $attr, type => 'attribute not supported');
1607     ## ISSUE: No comformance createria for unknown attributes in the spec
1608     }
1609     }
1610    
1611     unless (defined $attr{href}) {
1612     for (qw/target ping rel media hreflang type/) {
1613     if (defined $attr{$_}) {
1614     $self->{onerror}->(node => $attr{$_},
1615     type => 'attribute not allowed');
1616 wakaba 1.15 }
1617     }
1618 wakaba 1.17 }
1619 wakaba 1.15 },
1620 wakaba 1.6 checker => sub {
1621     my ($self, $todo) = @_;
1622    
1623     my $end = $self->_add_minuses ($HTMLInteractiveElements);
1624     my ($sib, $ch)
1625     = $HTMLSignificantInlineOrStrictlyInlineChecker->($self, $todo);
1626     push @$sib, $end;
1627     return ($sib, $ch);
1628     },
1629     };
1630 wakaba 1.1
1631 wakaba 1.4 $Element->{$HTML_NS}->{q} = {
1632 wakaba 1.11 attrs_checker => $GetHTMLAttrsChecker->({
1633     cite => $HTMLURIAttrChecker,
1634     }),
1635 wakaba 1.4 checker => $HTMLInlineOrStrictlyInlineChecker,
1636     };
1637 wakaba 1.1
1638     $Element->{$HTML_NS}->{cite} = {
1639 wakaba 1.10 attrs_checker => $GetHTMLAttrsChecker->({}),
1640 wakaba 1.1 checker => $HTMLStrictlyInlineChecker,
1641     };
1642    
1643 wakaba 1.4 $Element->{$HTML_NS}->{em} = {
1644 wakaba 1.10 attrs_checker => $GetHTMLAttrsChecker->({}),
1645 wakaba 1.4 checker => $HTMLInlineOrStrictlyInlineChecker,
1646     };
1647    
1648     $Element->{$HTML_NS}->{strong} = {
1649 wakaba 1.10 attrs_checker => $GetHTMLAttrsChecker->({}),
1650 wakaba 1.4 checker => $HTMLInlineOrStrictlyInlineChecker,
1651     };
1652 wakaba 1.1
1653 wakaba 1.4 $Element->{$HTML_NS}->{small} = {
1654 wakaba 1.10 attrs_checker => $GetHTMLAttrsChecker->({}),
1655 wakaba 1.4 checker => $HTMLInlineOrStrictlyInlineChecker,
1656     };
1657    
1658     $Element->{$HTML_NS}->{m} = {
1659 wakaba 1.10 attrs_checker => $GetHTMLAttrsChecker->({}),
1660 wakaba 1.4 checker => $HTMLInlineOrStrictlyInlineChecker,
1661     };
1662    
1663 wakaba 1.11 $Element->{$HTML_NS}->{dfn} = { ## TODO: term duplication
1664 wakaba 1.10 attrs_checker => $GetHTMLAttrsChecker->({}),
1665 wakaba 1.4 checker => sub {
1666     my ($self, $todo) = @_;
1667    
1668     my $end = $self->_add_minuses ({$HTML_NS => {dfn => 1}});
1669     my ($sib, $ch) = $HTMLStrictlyInlineChecker->($self, $todo);
1670     push @$sib, $end;
1671     return ($sib, $ch);
1672     },
1673     };
1674 wakaba 1.1
1675     $Element->{$HTML_NS}->{abbr} = {
1676 wakaba 1.11 attrs_checker => $GetHTMLAttrsChecker->({
1677     ## NOTE: |title| has special semantics for |abbr|s, but is syntactically
1678     ## not different. The spec says that the |title| MAY be omitted
1679     ## if there is a |dfn| whose defining term is the abbreviation,
1680     ## but it does not prohibit |abbr| w/o |title| in other cases.
1681     }),
1682 wakaba 1.1 checker => $HTMLStrictlyInlineChecker,
1683     };
1684    
1685 wakaba 1.11 $Element->{$HTML_NS}->{time} = { ## TODO: validate content
1686     attrs_checker => $GetHTMLAttrsChecker->({}), ## TODO: datetime
1687 wakaba 1.1 checker => $HTMLStrictlyInlineChecker,
1688     };
1689    
1690 wakaba 1.11 $Element->{$HTML_NS}->{meter} = { ## TODO: "The recommended way of giving the value is to include it as contents of the element"
1691     attrs_checker => $GetHTMLAttrsChecker->({
1692     value => $GetHTMLFloatingPointNumberAttrChecker->(sub { 1 }),
1693     min => $GetHTMLFloatingPointNumberAttrChecker->(sub { 1 }),
1694     low => $GetHTMLFloatingPointNumberAttrChecker->(sub { 1 }),
1695     high => $GetHTMLFloatingPointNumberAttrChecker->(sub { 1 }),
1696     max => $GetHTMLFloatingPointNumberAttrChecker->(sub { 1 }),
1697     optimum => $GetHTMLFloatingPointNumberAttrChecker->(sub { 1 }),
1698     }),
1699 wakaba 1.1 checker => $HTMLStrictlyInlineChecker,
1700     };
1701    
1702 wakaba 1.11 $Element->{$HTML_NS}->{progress} = { ## TODO: recommended to use content
1703     attrs_checker => $GetHTMLAttrsChecker->({
1704     value => $GetHTMLFloatingPointNumberAttrChecker->(sub { shift >= 0 }),
1705     max => $GetHTMLFloatingPointNumberAttrChecker->(sub { shift > 0 }),
1706     }),
1707 wakaba 1.1 checker => $HTMLStrictlyInlineChecker,
1708     };
1709    
1710 wakaba 1.4 $Element->{$HTML_NS}->{code} = {
1711 wakaba 1.10 attrs_checker => $GetHTMLAttrsChecker->({}),
1712 wakaba 1.12 ## NOTE: Though |title| has special semantics,
1713     ## syntatically same as the |title| as global attribute.
1714 wakaba 1.4 checker => $HTMLInlineOrStrictlyInlineChecker,
1715     };
1716 wakaba 1.1
1717     $Element->{$HTML_NS}->{var} = {
1718 wakaba 1.10 attrs_checker => $GetHTMLAttrsChecker->({}),
1719 wakaba 1.12 ## NOTE: Though |title| has special semantics,
1720     ## syntatically same as the |title| as global attribute.
1721 wakaba 1.1 checker => $HTMLStrictlyInlineChecker,
1722     };
1723    
1724 wakaba 1.4 $Element->{$HTML_NS}->{samp} = {
1725 wakaba 1.10 attrs_checker => $GetHTMLAttrsChecker->({}),
1726 wakaba 1.12 ## NOTE: Though |title| has special semantics,
1727     ## syntatically same as the |title| as global attribute.
1728 wakaba 1.4 checker => $HTMLInlineOrStrictlyInlineChecker,
1729     };
1730 wakaba 1.1
1731     $Element->{$HTML_NS}->{kbd} = {
1732 wakaba 1.10 attrs_checker => $GetHTMLAttrsChecker->({}),
1733 wakaba 1.1 checker => $HTMLStrictlyInlineChecker,
1734     };
1735    
1736     $Element->{$HTML_NS}->{sub} = {
1737 wakaba 1.10 attrs_checker => $GetHTMLAttrsChecker->({}),
1738 wakaba 1.1 checker => $HTMLStrictlyInlineChecker,
1739     };
1740    
1741     $Element->{$HTML_NS}->{sup} = {
1742 wakaba 1.10 attrs_checker => $GetHTMLAttrsChecker->({}),
1743 wakaba 1.1 checker => $HTMLStrictlyInlineChecker,
1744     };
1745    
1746 wakaba 1.4 $Element->{$HTML_NS}->{span} = {
1747 wakaba 1.10 attrs_checker => $GetHTMLAttrsChecker->({}),
1748 wakaba 1.12 ## NOTE: Though |title| has special semantics,
1749     ## syntatically same as the |title| as global attribute.
1750 wakaba 1.4 checker => $HTMLInlineOrStrictlyInlineChecker,
1751     };
1752 wakaba 1.1
1753     $Element->{$HTML_NS}->{i} = {
1754 wakaba 1.10 attrs_checker => $GetHTMLAttrsChecker->({}),
1755 wakaba 1.12 ## NOTE: Though |title| has special semantics,
1756     ## syntatically same as the |title| as global attribute.
1757 wakaba 1.1 checker => $HTMLStrictlyInlineChecker,
1758     };
1759    
1760     $Element->{$HTML_NS}->{b} = {
1761 wakaba 1.10 attrs_checker => $GetHTMLAttrsChecker->({}),
1762 wakaba 1.1 checker => $HTMLStrictlyInlineChecker,
1763     };
1764    
1765     $Element->{$HTML_NS}->{bdo} = {
1766 wakaba 1.12 attrs_checker => sub {
1767     my ($self, $todo) = @_;
1768     $GetHTMLAttrsChecker->({})->($self, $todo);
1769     unless ($todo->{node}->has_attribute_ns (undef, 'dir')) {
1770     $self->{onerror}->(node => $todo->{node}, type => 'attribute missing:dir');
1771     }
1772     },
1773     ## ISSUE: The spec does not directly say that |dir| is a enumerated attr.
1774 wakaba 1.1 checker => $HTMLStrictlyInlineChecker,
1775     };
1776    
1777     $Element->{$HTML_NS}->{ins} = {
1778 wakaba 1.12 attrs_checker => $GetHTMLAttrsChecker->({
1779     cite => $HTMLURIAttrChecker,
1780     ## TODO: datetime
1781     }),
1782 wakaba 1.1 checker => $HTMLTransparentChecker,
1783     };
1784    
1785     $Element->{$HTML_NS}->{del} = {
1786 wakaba 1.12 attrs_checker => $GetHTMLAttrsChecker->({
1787     cite => $HTMLURIAttrChecker,
1788     ## TODO: datetime
1789     }),
1790 wakaba 1.1 checker => sub {
1791 wakaba 1.4 my ($self, $todo) = @_;
1792 wakaba 1.1
1793 wakaba 1.4 my $parent = $todo->{node}->manakai_parent_element;
1794 wakaba 1.1 if (defined $parent) {
1795     my $nsuri = $parent->namespace_uri;
1796     $nsuri = '' unless defined $nsuri;
1797     my $ln = $parent->manakai_local_name;
1798     my $eldef = $Element->{$nsuri}->{$ln} ||
1799     $Element->{$nsuri}->{''} ||
1800     $ElementDefault;
1801 wakaba 1.4 return $eldef->{checker}->($self, $todo);
1802 wakaba 1.1 } else {
1803 wakaba 1.4 return $HTMLBlockOrInlineChecker->($self, $todo);
1804 wakaba 1.1 }
1805     },
1806     };
1807    
1808     ## TODO: figure
1809    
1810     $Element->{$HTML_NS}->{img} = {
1811 wakaba 1.17 attrs_checker => sub {
1812     my ($self, $todo) = @_;
1813     $GetHTMLAttrsChecker->({
1814     alt => sub { }, ## NOTE: No syntactical requirement
1815     src => $HTMLURIAttrChecker,
1816     usemap => $HTMLUsemapAttrChecker,
1817     ismap => $GetHTMLBooleanAttrChecker->('ismap'), ## TODO: MUST ancestor <a>
1818     ## TODO: height
1819     ## TODO: width
1820     })->($self, $todo);
1821     unless ($todo->{node}->has_attribute_ns (undef, 'alt')) {
1822     $self->{onerror}->(node => $todo->{node}, type => 'attribute missing:alt');
1823     }
1824     unless ($todo->{node}->has_attribute_ns (undef, 'src')) {
1825     $self->{onerror}->(node => $todo->{node}, type => 'attribute missing:src');
1826     }
1827     },
1828 wakaba 1.1 checker => $HTMLEmptyChecker,
1829     };
1830    
1831     $Element->{$HTML_NS}->{iframe} = {
1832 wakaba 1.12 attrs_checker => $GetHTMLAttrsChecker->({
1833     src => $HTMLURIAttrChecker,
1834     }),
1835 wakaba 1.1 checker => $HTMLTextChecker,
1836     };
1837    
1838     $Element->{$HTML_NS}->{embed} = {
1839 wakaba 1.16 attrs_checker => sub {
1840     my ($self, $todo) = @_;
1841     my $has_src;
1842     for my $attr (@{$todo->{node}->attributes}) {
1843     my $attr_ns = $attr->namespace_uri;
1844     $attr_ns = '' unless defined $attr_ns;
1845     my $attr_ln = $attr->manakai_local_name;
1846     my $checker;
1847     if ($attr_ns eq '') {
1848     if ($attr_ln eq 'src') {
1849     $checker = $HTMLURIAttrChecker;
1850     $has_src = 1;
1851     } elsif ($attr_ln eq 'type') {
1852     $checker = $HTMLIMTAttrChecker;
1853     } else {
1854     ## TODO: height
1855     ## TODO: width
1856     $checker = $HTMLAttrChecker->{$attr_ln}
1857     || sub { }; ## NOTE: Any local attribute is ok.
1858     }
1859     }
1860     $checker ||= $AttrChecker->{$attr_ns}->{$attr_ln}
1861     || $AttrChecker->{$attr_ns}->{''};
1862     if ($checker) {
1863     $checker->($self, $attr);
1864     } else {
1865     $self->{onerror}->(node => $attr, type => 'attribute not supported');
1866     ## ISSUE: No comformance createria for global attributes in the spec
1867     }
1868     }
1869    
1870     unless ($has_src) {
1871     $self->{onerror}->(node => $todo->{node},
1872     type => 'attribute missing:src');
1873     }
1874     },
1875 wakaba 1.1 checker => $HTMLEmptyChecker,
1876     };
1877    
1878 wakaba 1.15 $Element->{$HTML_NS}->{object} = {
1879 wakaba 1.17 attrs_checker => sub {
1880     my ($self, $todo) = @_;
1881     $GetHTMLAttrsChecker->({
1882     data => $HTMLURIAttrChecker,
1883     type => $HTMLIMTAttrChecker,
1884     usemap => $HTMLUsemapAttrChecker,
1885     ## TODO: width
1886     ## TODO: height
1887     })->($self, $todo);
1888     unless ($todo->{node}->has_attribute_ns (undef, 'data')) {
1889     unless ($todo->{node}->has_attribute_ns (undef, 'type')) {
1890     $self->{onerror}->(node => $todo->{node},
1891     type => 'attribute missing:data|type');
1892     }
1893     }
1894     },
1895 wakaba 1.15 checker => $ElementDefault->{checker}, ## TODO
1896     };
1897    
1898 wakaba 1.1 $Element->{$HTML_NS}->{param} = {
1899 wakaba 1.12 attrs_checker => sub {
1900     my ($self, $todo) = @_;
1901     $GetHTMLAttrsChecker->({
1902     name => sub { },
1903     value => sub { },
1904     })->($self, $todo);
1905     unless ($todo->{node}->has_attribute_ns (undef, 'name')) {
1906     $self->{onerror}->(node => $todo->{node},
1907     type => 'attribute missing:name');
1908     }
1909     unless ($todo->{node}->has_attribute_ns (undef, 'value')) {
1910     $self->{onerror}->(node => $todo->{node},
1911     type => 'attribute missing:value');
1912     }
1913     },
1914 wakaba 1.1 checker => $HTMLEmptyChecker,
1915     };
1916    
1917 wakaba 1.2 $Element->{$HTML_NS}->{video} = {
1918 wakaba 1.12 attrs_checker => $GetHTMLAttrsChecker->({
1919     src => $HTMLURIAttrChecker,
1920     ## TODO: start, loopstart, loopend, end
1921     ## ISSUE: they MUST be "value time offset"s. Value?
1922     ## ISSUE: loopcount has no conformance creteria
1923     autoplay => $GetHTMLBooleanAttrChecker->('autoplay'),
1924     controls => $GetHTMLBooleanAttrChecker->('controls'),
1925     }),
1926 wakaba 1.2 checker => sub {
1927 wakaba 1.4 my ($self, $todo) = @_;
1928 wakaba 1.2
1929 wakaba 1.4 if ($todo->{node}->has_attribute_ns (undef, 'src')) {
1930     return $HTMLBlockOrInlineChecker->($self, $todo);
1931 wakaba 1.2 } else {
1932     return $GetHTMLZeroOrMoreThenBlockOrInlineChecker->($HTML_NS, 'source')
1933 wakaba 1.4 ->($self, $todo);
1934 wakaba 1.2 }
1935     },
1936     };
1937    
1938     $Element->{$HTML_NS}->{audio} = {
1939 wakaba 1.12 attrs_checker => $Element->{$HTML_NS}->{video}->{attrs_checker},
1940     checker => $Element->{$HTML_NS}->{video}->{checker},
1941 wakaba 1.2 };
1942 wakaba 1.1
1943     $Element->{$HTML_NS}->{source} = {
1944 wakaba 1.17 attrs_checker => sub {
1945     my ($self, $todo) = @_;
1946     $GetHTMLAttrsChecker->({
1947     src => $HTMLURIAttrChecker,
1948     type => $HTMLIMTAttrChecker,
1949     media => $HTMLMQAttrChecker,
1950     })->($self, $todo);
1951     unless ($todo->{node}->has_attribute_ns (undef, 'src')) {
1952     $self->{onerror}->(node => $todo->{node},
1953     type => 'attribute missing:src');
1954     }
1955     },
1956 wakaba 1.1 checker => $HTMLEmptyChecker,
1957     };
1958    
1959     $Element->{$HTML_NS}->{canvas} = {
1960 wakaba 1.12 attrs_checker => $GetHTMLAttrsChecker->({
1961     height => $GetHTMLNonNegativeIntegerAttrChecker->(sub { 1 }),
1962     width => $GetHTMLNonNegativeIntegerAttrChecker->(sub { 1 }),
1963     }),
1964 wakaba 1.1 checker => $HTMLInlineChecker,
1965     };
1966    
1967     $Element->{$HTML_NS}->{map} = {
1968 wakaba 1.17 attrs_checker => $GetHTMLAttrsChecker->({
1969     id => sub {
1970     ## NOTE: same as global |id=""|, with |$self->{map}| registeration
1971     my ($self, $attr) = @_;
1972     my $value = $attr->value;
1973     if (length $value > 0) {
1974     if ($self->{id}->{$value}) {
1975     $self->{onerror}->(node => $attr, type => 'duplicate ID');
1976     } else {
1977     $self->{id}->{$value} = 1;
1978     }
1979     } else {
1980     ## NOTE: MUST contain at least one character
1981     $self->{onerror}->(node => $attr, type => 'attribute value is empty');
1982     }
1983     $self->{map}->{$value} ||= $attr;
1984     },
1985     }),
1986 wakaba 1.1 checker => $HTMLBlockChecker,
1987     };
1988    
1989     $Element->{$HTML_NS}->{area} = {
1990 wakaba 1.15 attrs_checker => sub {
1991     my ($self, $todo) = @_;
1992     my %attr;
1993     my $coords;
1994     for my $attr (@{$todo->{node}->attributes}) {
1995     my $attr_ns = $attr->namespace_uri;
1996     $attr_ns = '' unless defined $attr_ns;
1997     my $attr_ln = $attr->manakai_local_name;
1998     my $checker;
1999     if ($attr_ns eq '') {
2000     $checker = {
2001     alt => sub { },
2002     ## NOTE: |alt| value has no conformance creteria.
2003     shape => $GetHTMLEnumeratedAttrChecker->({
2004     circ => -1, circle => 1,
2005     default => 1,
2006     poly => 1, polygon => -1,
2007     rect => 1, rectangle => -1,
2008     }),
2009     coords => sub {
2010     my ($self, $attr) = @_;
2011     my $value = $attr->value;
2012     if ($value =~ /\A-?[0-9]+(?>,-?[0-9]+)*\z/) {
2013     $coords = [split /,/, $value];
2014     } else {
2015     $self->{onerror}->(node => $attr,
2016     type => 'syntax error');
2017     }
2018     },
2019 wakaba 1.17 target => $HTMLTargetAttrChecker,
2020 wakaba 1.15 href => $HTMLURIAttrChecker,
2021     ping => $HTMLSpaceURIsAttrChecker,
2022     rel => $HTMLUnorderedSetOfSpaceSeparatedTokensAttrChecker, ## TODO: registered? check
2023 wakaba 1.17 media => $HTMLMQAttrChecker,
2024     hreflang => $HTMLLanguageTagAttrChecker,
2025 wakaba 1.15 type => $HTMLIMTAttrChecker,
2026     }->{$attr_ln};
2027     if ($checker) {
2028     $attr{$attr_ln} = $attr;
2029     } else {
2030     $checker = $HTMLAttrChecker->{$attr_ln};
2031     }
2032     }
2033     $checker ||= $AttrChecker->{$attr_ns}->{$attr_ln}
2034     || $AttrChecker->{$attr_ns}->{''};
2035     if ($checker) {
2036     $checker->($self, $attr) if ref $checker;
2037     } else {
2038     $self->{onerror}->(node => $attr, type => 'attribute not supported');
2039     ## ISSUE: No comformance createria for unknown attributes in the spec
2040     }
2041     }
2042    
2043     if (defined $attr{href}) {
2044     unless (defined $attr{alt}) {
2045     $self->{onerror}->(node => $todo->{node},
2046     type => 'attribute missing:alt');
2047     }
2048     } else {
2049     for (qw/target ping rel media hreflang type alt/) {
2050     if (defined $attr{$_}) {
2051     $self->{onerror}->(node => $attr{$_},
2052     type => 'attribute not allowed');
2053     }
2054     }
2055     }
2056    
2057     my $shape = 'rectangle';
2058     if (defined $attr{shape}) {
2059     $shape = {
2060     circ => 'circle', circle => 'circle',
2061     default => 'default',
2062     poly => 'polygon', polygon => 'polygon',
2063     rect => 'rectangle', rectangle => 'rectangle',
2064     }->{lc $attr{shape}->value} || 'rectangle';
2065     ## TODO: ASCII lowercase?
2066     }
2067    
2068     if ($shape eq 'circle') {
2069     if (defined $attr{coords}) {
2070     if (defined $coords) {
2071     if (@$coords == 3) {
2072     if ($coords->[2] < 0) {
2073     $self->{onerror}->(node => $attr{coords},
2074     type => 'out of range:2');
2075     }
2076     } else {
2077     $self->{onerror}->(node => $attr{coords},
2078     type => 'list item number:3:'.@$coords);
2079     }
2080     } else {
2081     ## NOTE: A syntax error has been reported.
2082     }
2083     } else {
2084     $self->{onerror}->(node => $todo->{node},
2085     type => 'attribute missing:coords');
2086     }
2087     } elsif ($shape eq 'default') {
2088     if (defined $attr{coords}) {
2089     $self->{onerror}->(node => $attr{coords},
2090     type => 'attribute not allowed');
2091     }
2092     } elsif ($shape eq 'polygon') {
2093     if (defined $attr{coords}) {
2094     if (defined $coords) {
2095     if (@$coords >= 6) {
2096     unless (@$coords % 2 == 0) {
2097     $self->{onerror}->(node => $attr{coords},
2098     type => 'list item number:even:'.@$coords);
2099     }
2100     } else {
2101     $self->{onerror}->(node => $attr{coords},
2102     type => 'list item number:>=6:'.@$coords);
2103     }
2104     } else {
2105     ## NOTE: A syntax error has been reported.
2106     }
2107     } else {
2108     $self->{onerror}->(node => $todo->{node},
2109     type => 'attribute missing:coords');
2110     }
2111     } elsif ($shape eq 'rectangle') {
2112     if (defined $attr{coords}) {
2113     if (defined $coords) {
2114     if (@$coords == 4) {
2115     unless ($coords->[0] < $coords->[2]) {
2116     $self->{onerror}->(node => $attr{coords},
2117     type => 'out of range:0');
2118     }
2119     unless ($coords->[1] < $coords->[3]) {
2120     $self->{onerror}->(node => $attr{coords},
2121     type => 'out of range:1');
2122     }
2123     } else {
2124     $self->{onerror}->(node => $attr{coords},
2125     type => 'list item number:4:'.@$coords);
2126     }
2127     } else {
2128     ## NOTE: A syntax error has been reported.
2129     }
2130     } else {
2131     $self->{onerror}->(node => $todo->{node},
2132     type => 'attribute missing:coords');
2133     }
2134     }
2135     },
2136 wakaba 1.1 checker => $HTMLEmptyChecker,
2137     };
2138     ## TODO: only in map
2139    
2140     $Element->{$HTML_NS}->{table} = {
2141 wakaba 1.10 attrs_checker => $GetHTMLAttrsChecker->({}),
2142 wakaba 1.1 checker => sub {
2143 wakaba 1.4 my ($self, $todo) = @_;
2144     my $el = $todo->{node};
2145     my $new_todos = [];
2146 wakaba 1.1 my @nodes = (@{$el->child_nodes});
2147    
2148     my $phase = 'before caption';
2149     my $has_tfoot;
2150     while (@nodes) {
2151     my $node = shift @nodes;
2152 wakaba 1.2 $self->_remove_minuses ($node) and next if ref $node eq 'HASH';
2153    
2154 wakaba 1.1 my $nt = $node->node_type;
2155     if ($nt == 1) {
2156 wakaba 1.8 my $node_ns = $node->namespace_uri;
2157     $node_ns = '' unless defined $node_ns;
2158     my $node_ln = $node->manakai_local_name;
2159 wakaba 1.2 ## NOTE: |minuses| list is not checked since redundant
2160 wakaba 1.1 if ($phase eq 'in tbodys') {
2161 wakaba 1.8 if ($node_ns eq $HTML_NS and $node_ln eq 'tbody') {
2162 wakaba 1.1 #$phase = 'in tbodys';
2163     } elsif (not $has_tfoot and
2164 wakaba 1.8 $node_ns eq $HTML_NS and $node_ln eq 'tfoot') {
2165 wakaba 1.1 $phase = 'after tfoot';
2166     $has_tfoot = 1;
2167     } else {
2168 wakaba 1.2 $self->{onerror}->(node => $node, type => 'element not allowed');
2169 wakaba 1.1 }
2170     } elsif ($phase eq 'in trs') {
2171 wakaba 1.8 if ($node_ns eq $HTML_NS and $node_ln eq 'tr') {
2172 wakaba 1.1 #$phase = 'in trs';
2173     } elsif (not $has_tfoot and
2174 wakaba 1.8 $node_ns eq $HTML_NS and $node_ln eq 'tfoot') {
2175 wakaba 1.1 $phase = 'after tfoot';
2176     $has_tfoot = 1;
2177     } else {
2178 wakaba 1.2 $self->{onerror}->(node => $node, type => 'element not allowed');
2179 wakaba 1.1 }
2180     } elsif ($phase eq 'after thead') {
2181 wakaba 1.8 if ($node_ns eq $HTML_NS and $node_ln eq 'tbody') {
2182 wakaba 1.1 $phase = 'in tbodys';
2183 wakaba 1.8 } elsif ($node_ns eq $HTML_NS and $node_ln eq 'tr') {
2184 wakaba 1.1 $phase = 'in trs';
2185 wakaba 1.8 } elsif ($node_ns eq $HTML_NS and $node_ln eq 'tfoot') {
2186 wakaba 1.1 $phase = 'in tbodys';
2187     $has_tfoot = 1;
2188     } else {
2189 wakaba 1.2 $self->{onerror}->(node => $node, type => 'element not allowed');
2190 wakaba 1.1 }
2191     } elsif ($phase eq 'in colgroup') {
2192 wakaba 1.8 if ($node_ns eq $HTML_NS and $node_ln eq 'colgroup') {
2193 wakaba 1.1 $phase = 'in colgroup';
2194 wakaba 1.8 } elsif ($node_ns eq $HTML_NS and $node_ln eq 'thead') {
2195 wakaba 1.1 $phase = 'after thead';
2196 wakaba 1.8 } elsif ($node_ns eq $HTML_NS and $node_ln eq 'tbody') {
2197 wakaba 1.1 $phase = 'in tbodys';
2198 wakaba 1.8 } elsif ($node_ns eq $HTML_NS and $node_ln eq 'tr') {
2199 wakaba 1.1 $phase = 'in trs';
2200 wakaba 1.8 } elsif ($node_ns eq $HTML_NS and $node_ln eq 'tfoot') {
2201 wakaba 1.1 $phase = 'in tbodys';
2202     $has_tfoot = 1;
2203     } else {
2204 wakaba 1.2 $self->{onerror}->(node => $node, type => 'element not allowed');
2205 wakaba 1.1 }
2206     } elsif ($phase eq 'before caption') {
2207 wakaba 1.8 if ($node_ns eq $HTML_NS and $node_ln eq 'caption') {
2208 wakaba 1.1 $phase = 'in colgroup';
2209 wakaba 1.8 } elsif ($node_ns eq $HTML_NS and $node_ln eq 'colgroup') {
2210 wakaba 1.1 $phase = 'in colgroup';
2211 wakaba 1.8 } elsif ($node_ns eq $HTML_NS and $node_ln eq 'thead') {
2212 wakaba 1.1 $phase = 'after thead';
2213 wakaba 1.8 } elsif ($node_ns eq $HTML_NS and $node_ln eq 'tbody') {
2214 wakaba 1.1 $phase = 'in tbodys';
2215 wakaba 1.8 } elsif ($node_ns eq $HTML_NS and $node_ln eq 'tr') {
2216 wakaba 1.1 $phase = 'in trs';
2217 wakaba 1.8 } elsif ($node_ns eq $HTML_NS and $node_ln eq 'tfoot') {
2218 wakaba 1.1 $phase = 'in tbodys';
2219     $has_tfoot = 1;
2220     } else {
2221 wakaba 1.2 $self->{onerror}->(node => $node, type => 'element not allowed');
2222 wakaba 1.1 }
2223     } else { # after tfoot
2224 wakaba 1.2 $self->{onerror}->(node => $node, type => 'element not allowed');
2225 wakaba 1.1 }
2226 wakaba 1.2 my ($sib, $ch) = $self->_check_get_children ($node);
2227     unshift @nodes, @$sib;
2228 wakaba 1.4 push @$new_todos, @$ch;
2229 wakaba 1.1 } elsif ($nt == 3 or $nt == 4) {
2230     if ($node->data =~ /[^\x09-\x0D\x20]/) {
2231 wakaba 1.2 $self->{onerror}->(node => $node, type => 'character not allowed');
2232 wakaba 1.1 }
2233     } elsif ($nt == 5) {
2234     unshift @nodes, @{$node->child_nodes};
2235     }
2236     }
2237 wakaba 1.4 return ($new_todos);
2238 wakaba 1.1 },
2239     };
2240    
2241     $Element->{$HTML_NS}->{caption} = {
2242 wakaba 1.10 attrs_checker => $GetHTMLAttrsChecker->({}),
2243 wakaba 1.1 checker => $HTMLSignificantStrictlyInlineChecker,
2244     };
2245    
2246     $Element->{$HTML_NS}->{colgroup} = {
2247 wakaba 1.17 attrs_checker => $GetHTMLAttrsChecker->({
2248     span => $GetHTMLNonNegativeIntegerAttrChecker->(sub { shift > 0 }),
2249     ## NOTE: Defined only if "the |colgroup| element contains no |col| elements"
2250     ## TODO: "attribute not supported" if |col|.
2251     ## ISSUE: MUST NOT if any |col|?
2252     ## ISSUE: MUST NOT for |<colgroup span="1"><any><col/></any></colgroup>| (though non-conforming)?
2253     }),
2254 wakaba 1.1 checker => sub {
2255 wakaba 1.4 my ($self, $todo) = @_;
2256     my $el = $todo->{node};
2257     my $new_todos = [];
2258 wakaba 1.1 my @nodes = (@{$el->child_nodes});
2259    
2260     while (@nodes) {
2261     my $node = shift @nodes;
2262 wakaba 1.2 $self->_remove_minuses ($node) and next if ref $node eq 'HASH';
2263    
2264 wakaba 1.1 my $nt = $node->node_type;
2265     if ($nt == 1) {
2266 wakaba 1.8 my $node_ns = $node->namespace_uri;
2267     $node_ns = '' unless defined $node_ns;
2268     my $node_ln = $node->manakai_local_name;
2269 wakaba 1.2 ## NOTE: |minuses| list is not checked since redundant
2270 wakaba 1.8 unless ($node_ns eq $HTML_NS and $node_ln eq 'col') {
2271 wakaba 1.2 $self->{onerror}->(node => $node, type => 'element not allowed');
2272 wakaba 1.1 }
2273 wakaba 1.2 my ($sib, $ch) = $self->_check_get_children ($node);
2274     unshift @nodes, @$sib;
2275 wakaba 1.4 push @$new_todos, @$ch;
2276 wakaba 1.1 } elsif ($nt == 3 or $nt == 4) {
2277     if ($node->data =~ /[^\x09-\x0D\x20]/) {
2278 wakaba 1.2 $self->{onerror}->(node => $node, type => 'character not allowed');
2279 wakaba 1.1 }
2280     } elsif ($nt == 5) {
2281     unshift @nodes, @{$node->child_nodes};
2282     }
2283     }
2284 wakaba 1.4 return ($new_todos);
2285 wakaba 1.1 },
2286     };
2287    
2288     $Element->{$HTML_NS}->{col} = {
2289 wakaba 1.12 attrs_checker => $GetHTMLAttrsChecker->({
2290     span => $GetHTMLNonNegativeIntegerAttrChecker->(sub { shift > 0 }),
2291     }),
2292 wakaba 1.1 checker => $HTMLEmptyChecker,
2293     };
2294    
2295     $Element->{$HTML_NS}->{tbody} = {
2296 wakaba 1.10 attrs_checker => $GetHTMLAttrsChecker->({}),
2297 wakaba 1.1 checker => sub {
2298 wakaba 1.4 my ($self, $todo) = @_;
2299     my $el = $todo->{node};
2300     my $new_todos = [];
2301 wakaba 1.1 my @nodes = (@{$el->child_nodes});
2302    
2303     my $has_tr;
2304     while (@nodes) {
2305     my $node = shift @nodes;
2306 wakaba 1.2 $self->_remove_minuses ($node) and next if ref $node eq 'HASH';
2307    
2308 wakaba 1.1 my $nt = $node->node_type;
2309     if ($nt == 1) {
2310 wakaba 1.8 my $node_ns = $node->namespace_uri;
2311     $node_ns = '' unless defined $node_ns;
2312     my $node_ln = $node->manakai_local_name;
2313 wakaba 1.2 ## NOTE: |minuses| list is not checked since redundant
2314 wakaba 1.8 if ($node_ns eq $HTML_NS and $node_ln eq 'tr') {
2315 wakaba 1.1 $has_tr = 1;
2316     } else {
2317 wakaba 1.2 $self->{onerror}->(node => $node, type => 'element not allowed');
2318 wakaba 1.1 }
2319 wakaba 1.2 my ($sib, $ch) = $self->_check_get_children ($node);
2320     unshift @nodes, @$sib;
2321 wakaba 1.4 push @$new_todos, @$ch;
2322 wakaba 1.1 } elsif ($nt == 3 or $nt == 4) {
2323     if ($node->data =~ /[^\x09-\x0D\x20]/) {
2324 wakaba 1.2 $self->{onerror}->(node => $node, type => 'character not allowed');
2325 wakaba 1.1 }
2326     } elsif ($nt == 5) {
2327     unshift @nodes, @{$node->child_nodes};
2328     }
2329     }
2330     unless ($has_tr) {
2331 wakaba 1.3 $self->{onerror}->(node => $el, type => 'child element missing:tr');
2332 wakaba 1.1 }
2333 wakaba 1.4 return ($new_todos);
2334 wakaba 1.1 },
2335     };
2336    
2337     $Element->{$HTML_NS}->{thead} = {
2338 wakaba 1.10 attrs_checker => $GetHTMLAttrsChecker->({}),
2339 wakaba 1.1 checker => $Element->{$HTML_NS}->{tbody},
2340     };
2341    
2342     $Element->{$HTML_NS}->{tfoot} = {
2343 wakaba 1.10 attrs_checker => $GetHTMLAttrsChecker->({}),
2344 wakaba 1.1 checker => $Element->{$HTML_NS}->{tbody},
2345     };
2346    
2347     $Element->{$HTML_NS}->{tr} = {
2348 wakaba 1.10 attrs_checker => $GetHTMLAttrsChecker->({}),
2349 wakaba 1.1 checker => sub {
2350 wakaba 1.4 my ($self, $todo) = @_;
2351     my $el = $todo->{node};
2352     my $new_todos = [];
2353 wakaba 1.1 my @nodes = (@{$el->child_nodes});
2354    
2355     my $has_td;
2356     while (@nodes) {
2357     my $node = shift @nodes;
2358 wakaba 1.2 $self->_remove_minuses ($node) and next if ref $node eq 'HASH';
2359    
2360 wakaba 1.1 my $nt = $node->node_type;
2361     if ($nt == 1) {
2362 wakaba 1.8 my $node_ns = $node->namespace_uri;
2363     $node_ns = '' unless defined $node_ns;
2364     my $node_ln = $node->manakai_local_name;
2365 wakaba 1.2 ## NOTE: |minuses| list is not checked since redundant
2366 wakaba 1.8 if ($node_ns eq $HTML_NS and ($node_ln eq 'td' or $node_ln eq 'th')) {
2367 wakaba 1.1 $has_td = 1;
2368     } else {
2369 wakaba 1.2 $self->{onerror}->(node => $node, type => 'element not allowed');
2370 wakaba 1.1 }
2371 wakaba 1.2 my ($sib, $ch) = $self->_check_get_children ($node);
2372     unshift @nodes, @$sib;
2373 wakaba 1.4 push @$new_todos, @$ch;
2374 wakaba 1.1 } elsif ($nt == 3 or $nt == 4) {
2375     if ($node->data =~ /[^\x09-\x0D\x20]/) {
2376 wakaba 1.2 $self->{onerror}->(node => $node, type => 'character not allowed');
2377 wakaba 1.1 }
2378     } elsif ($nt == 5) {
2379     unshift @nodes, @{$node->child_nodes};
2380     }
2381     }
2382     unless ($has_td) {
2383 wakaba 1.3 $self->{onerror}->(node => $el, type => 'child element missing:td|th');
2384 wakaba 1.1 }
2385 wakaba 1.4 return ($new_todos);
2386 wakaba 1.1 },
2387     };
2388    
2389     $Element->{$HTML_NS}->{td} = {
2390 wakaba 1.12 attrs_checker => $GetHTMLAttrsChecker->({
2391     colspan => $GetHTMLNonNegativeIntegerAttrChecker->(sub { shift > 0 }),
2392     rowspan => $GetHTMLNonNegativeIntegerAttrChecker->(sub { shift > 0 }),
2393     }),
2394 wakaba 1.1 checker => $HTMLBlockOrInlineChecker,
2395     };
2396    
2397     $Element->{$HTML_NS}->{th} = {
2398 wakaba 1.12 attrs_checker => $GetHTMLAttrsChecker->({
2399     colspan => $GetHTMLNonNegativeIntegerAttrChecker->(sub { shift > 0 }),
2400     rowspan => $GetHTMLNonNegativeIntegerAttrChecker->(sub { shift > 0 }),
2401     scope => $GetHTMLEnumeratedAttrChecker
2402     ->({row => 1, col => 1, rowgroup => 1, colgroup => 1}),
2403     }),
2404 wakaba 1.1 checker => $HTMLBlockOrInlineChecker,
2405     };
2406    
2407 wakaba 1.12 ## TODO: table model error checking
2408    
2409 wakaba 1.1 ## TODO: forms
2410    
2411 wakaba 1.2 $Element->{$HTML_NS}->{script} = {
2412 wakaba 1.15 attrs_checker => $GetHTMLAttrsChecker->({
2413     src => $HTMLURIAttrChecker,
2414     defer => $GetHTMLBooleanAttrChecker->('defer'), ## TODO: if src ## ISSUE: no MUST NOT
2415     async => $GetHTMLBooleanAttrChecker->('async'), ## TODO: if src ## ISSUE: no MUST NOT
2416     type => $HTMLIMTAttrChecker,
2417     }),
2418 wakaba 1.2 checker => sub {
2419 wakaba 1.4 my ($self, $todo) = @_;
2420 wakaba 1.2
2421 wakaba 1.4 if ($todo->{node}->has_attribute_ns (undef, 'src')) {
2422     return $HTMLEmptyChecker->($self, $todo);
2423 wakaba 1.2 } else {
2424     ## NOTE: No content model conformance in HTML5 spec.
2425 wakaba 1.4 return $AnyChecker->($self, $todo);
2426 wakaba 1.2 }
2427     },
2428     };
2429    
2430     ## NOTE: When script is disabled.
2431     $Element->{$HTML_NS}->{noscript} = {
2432 wakaba 1.10 attrs_checker => $GetHTMLAttrsChecker->({}),
2433 wakaba 1.2 checker => sub {
2434 wakaba 1.4 my ($self, $todo) = @_;
2435 wakaba 1.1
2436 wakaba 1.2 my $end = $self->_add_minuses ({$HTML_NS => {noscript => 1}});
2437 wakaba 1.4 my ($sib, $ch) = $HTMLBlockOrInlineChecker->($self, $todo);
2438 wakaba 1.2 push @$sib, $end;
2439     return ($sib, $ch);
2440     },
2441     };
2442 wakaba 1.1
2443     $Element->{$HTML_NS}->{'event-source'} = {
2444 wakaba 1.12 attrs_checker => $GetHTMLAttrsChecker->({
2445     src => $HTMLURIAttrChecker,
2446     }),
2447 wakaba 1.1 checker => $HTMLEmptyChecker,
2448     };
2449    
2450     $Element->{$HTML_NS}->{details} = {
2451 wakaba 1.12 attrs_checker => $GetHTMLAttrsChecker->({
2452     open => $GetHTMLBooleanAttrChecker->('open'),
2453     }),
2454 wakaba 1.6 checker => sub {
2455     my ($self, $todo) = @_;
2456    
2457     my $end = $self->_add_minuses ({$HTML_NS => {a => 1, datagrid => 1}});
2458     my ($sib, $ch)
2459     = $GetHTMLZeroOrMoreThenBlockOrInlineChecker->($HTML_NS, 'legend')
2460     ->($self, $todo);
2461     push @$sib, $end;
2462     return ($sib, $ch);
2463     },
2464 wakaba 1.1 };
2465    
2466     $Element->{$HTML_NS}->{datagrid} = {
2467 wakaba 1.12 attrs_checker => $GetHTMLAttrsChecker->({
2468     disabled => $GetHTMLBooleanAttrChecker->('disabled'),
2469     multiple => $GetHTMLBooleanAttrChecker->('multiple'),
2470     }),
2471 wakaba 1.6 checker => sub {
2472     my ($self, $todo) = @_;
2473    
2474     my $end = $self->_add_minuses ({$HTML_NS => {a => 1, datagrid => 1}});
2475     my ($sib, $ch) = $HTMLBlockChecker->($self, $todo);
2476     push @$sib, $end;
2477     return ($sib, $ch);
2478     },
2479 wakaba 1.1 };
2480    
2481     $Element->{$HTML_NS}->{command} = {
2482 wakaba 1.12 attrs_checker => $GetHTMLAttrsChecker->({}), ## TODO
2483 wakaba 1.1 checker => $HTMLEmptyChecker,
2484     };
2485    
2486     $Element->{$HTML_NS}->{menu} = {
2487 wakaba 1.12 attrs_checker => $GetHTMLAttrsChecker->({}), ## TODO
2488 wakaba 1.1 checker => sub {
2489 wakaba 1.4 my ($self, $todo) = @_;
2490     my $el = $todo->{node};
2491     my $new_todos = [];
2492 wakaba 1.1 my @nodes = (@{$el->child_nodes});
2493    
2494     my $content = 'li or inline';
2495     while (@nodes) {
2496     my $node = shift @nodes;
2497 wakaba 1.2 $self->_remove_minuses ($node) and next if ref $node eq 'HASH';
2498    
2499 wakaba 1.1 my $nt = $node->node_type;
2500     if ($nt == 1) {
2501 wakaba 1.2 my $node_ns = $node->namespace_uri;
2502     $node_ns = '' unless defined $node_ns;
2503     my $node_ln = $node->manakai_local_name;
2504 wakaba 1.6 my $not_allowed = $self->{minuses}->{$node_ns}->{$node_ln};
2505 wakaba 1.8 if ($node_ns eq $HTML_NS and $node_ln eq 'li') {
2506 wakaba 1.1 if ($content eq 'inline') {
2507 wakaba 1.6 $not_allowed = 1;
2508 wakaba 1.1 } elsif ($content eq 'li or inline') {
2509     $content = 'li';
2510     }
2511     } else {
2512 wakaba 1.7 if ($HTMLStrictlyInlineLevelElements->{$node_ns}->{$node_ln} or
2513     $HTMLStructuredInlineLevelElements->{$node_ns}->{$node_ln}) {
2514     $content = 'inline';
2515     } else {
2516 wakaba 1.6 $not_allowed = 1;
2517 wakaba 1.7 }
2518 wakaba 1.1 }
2519 wakaba 1.6 $self->{onerror}->(node => $node, type => 'element not allowed')
2520     if $not_allowed;
2521 wakaba 1.2 my ($sib, $ch) = $self->_check_get_children ($node);
2522     unshift @nodes, @$sib;
2523 wakaba 1.4 push @$new_todos, @$ch;
2524 wakaba 1.1 } elsif ($nt == 3 or $nt == 4) {
2525     if ($node->data =~ /[^\x09-\x0D\x20]/) {
2526     if ($content eq 'li') {
2527 wakaba 1.2 $self->{onerror}->(node => $node, type => 'character not allowed');
2528 wakaba 1.1 } elsif ($content eq 'li or inline') {
2529     $content = 'inline';
2530     }
2531     }
2532     } elsif ($nt == 5) {
2533     unshift @nodes, @{$node->child_nodes};
2534     }
2535     }
2536 wakaba 1.4
2537     for (@$new_todos) {
2538     $_->{inline} = 1;
2539     }
2540     return ($new_todos);
2541 wakaba 1.1 },
2542     };
2543    
2544 wakaba 1.6 $Element->{$HTML_NS}->{legend} = {
2545 wakaba 1.10 attrs_checker => $GetHTMLAttrsChecker->({}),
2546 wakaba 1.6 checker => sub {
2547     my ($self, $todo) = @_;
2548    
2549     my $parent = $todo->{node}->manakai_parent_element;
2550     if (defined $parent) {
2551     my $nsuri = $parent->namespace_uri;
2552     $nsuri = '' unless defined $nsuri;
2553     my $ln = $parent->manakai_local_name;
2554     if ($nsuri eq $HTML_NS and $ln eq 'figure') {
2555     return $HTMLInlineChecker->($self, $todo);
2556     } else {
2557     return $HTMLSignificantStrictlyInlineChecker->($self, $todo);
2558     }
2559     } else {
2560     return $HTMLInlineChecker->($self, $todo);
2561     }
2562    
2563     ## ISSUE: Content model is defined only for fieldset/legend,
2564     ## details/legend, and figure/legend.
2565     },
2566     };
2567 wakaba 1.1
2568     $Element->{$HTML_NS}->{div} = {
2569 wakaba 1.10 attrs_checker => $GetHTMLAttrsChecker->({}),
2570 wakaba 1.2 checker => $GetHTMLZeroOrMoreThenBlockOrInlineChecker->($HTML_NS, 'style'),
2571 wakaba 1.1 };
2572    
2573     $Element->{$HTML_NS}->{font} = {
2574 wakaba 1.12 attrs_checker => $GetHTMLAttrsChecker->({}), ## TODO
2575 wakaba 1.1 checker => $HTMLTransparentChecker,
2576     };
2577    
2578 wakaba 1.2 sub new ($) {
2579     return bless {}, shift;
2580     } # new
2581    
2582 wakaba 1.1 sub check_element ($$$) {
2583     my ($self, $el, $onerror) = @_;
2584    
2585 wakaba 1.2 $self->{minuses} = {};
2586     $self->{onerror} = $onerror;
2587 wakaba 1.10 $self->{id} = {};
2588 wakaba 1.17 $self->{usemap} = [];
2589     $self->{map} = {};
2590 wakaba 1.2
2591 wakaba 1.4 my @todo = ({type => 'element', node => $el});
2592     while (@todo) {
2593     my $todo = shift @todo;
2594     if ($todo->{type} eq 'element') {
2595 wakaba 1.13 my $prefix = $todo->{node}->prefix;
2596     if (defined $prefix and $prefix eq 'xmlns') {
2597     $self->{onerror}
2598     ->(node => $todo->{node},
2599     type => 'NC:Reserved Prefixes and Namespace Names:<xmlns:>');
2600     }
2601 wakaba 1.4 my $nsuri = $todo->{node}->namespace_uri;
2602     $nsuri = '' unless defined $nsuri;
2603     my $ln = $todo->{node}->manakai_local_name;
2604     my $eldef = $Element->{$nsuri}->{$ln} ||
2605     $Element->{$nsuri}->{''} ||
2606     $ElementDefault;
2607 wakaba 1.9 $eldef->{attrs_checker}->($self, $todo);
2608 wakaba 1.4 my ($new_todos) = $eldef->{checker}->($self, $todo);
2609 wakaba 1.14 unshift @todo, @$new_todos;
2610 wakaba 1.9 } elsif ($todo->{type} eq 'element-attributes') {
2611 wakaba 1.13 my $prefix = $todo->{node}->prefix;
2612     if (defined $prefix and $prefix eq 'xmlns') {
2613     $self->{onerror}
2614     ->(node => $todo->{node},
2615     type => 'NC:Reserved Prefixes and Namespace Names:<xmlns:>');
2616     }
2617 wakaba 1.9 my $nsuri = $todo->{node}->namespace_uri;
2618     $nsuri = '' unless defined $nsuri;
2619     my $ln = $todo->{node}->manakai_local_name;
2620     my $eldef = $Element->{$nsuri}->{$ln} ||
2621     $Element->{$nsuri}->{''} ||
2622     $ElementDefault;
2623     $eldef->{attrs_checker}->($self, $todo);
2624 wakaba 1.4 } elsif ($todo->{type} eq 'plus') {
2625     $self->_remove_minuses ($todo);
2626     }
2627 wakaba 1.1 }
2628 wakaba 1.17
2629     for (@{$self->{usemap}}) {
2630     unless ($self->{map}->{$_->[0]}) {
2631     $self->{onerror}->(node => $_->[1], type => 'no referenced map');
2632     }
2633     }
2634    
2635     delete $self->{minuses};
2636     delete $self->{onerror};
2637     delete $self->{id};
2638     delete $self->{usemap};
2639     delete $self->{map};
2640 wakaba 1.1 } # check_element
2641    
2642 wakaba 1.2 sub _add_minuses ($@) {
2643     my $self = shift;
2644     my $r = {};
2645     for my $list (@_) {
2646     for my $ns (keys %$list) {
2647     for my $ln (keys %{$list->{$ns}}) {
2648     unless ($self->{minuses}->{$ns}->{$ln}) {
2649     $self->{minuses}->{$ns}->{$ln} = 1;
2650     $r->{$ns}->{$ln} = 1;
2651     }
2652     }
2653     }
2654     }
2655 wakaba 1.4 return {type => 'plus', list => $r};
2656 wakaba 1.2 } # _add_minuses
2657    
2658     sub _remove_minuses ($$) {
2659 wakaba 1.4 my ($self, $todo) = @_;
2660     for my $ns (keys %{$todo->{list}}) {
2661     for my $ln (keys %{$todo->{list}->{$ns}}) {
2662     delete $self->{minuses}->{$ns}->{$ln} if $todo->{list}->{$ns}->{$ln};
2663 wakaba 1.2 }
2664     }
2665     1;
2666     } # _remove_minuses
2667    
2668     sub _check_get_children ($$) {
2669     my ($self, $node) = @_;
2670 wakaba 1.4 my $new_todos = [];
2671 wakaba 1.2 my $sib = [];
2672     TP: {
2673     my $node_ns = $node->namespace_uri;
2674     $node_ns = '' unless defined $node_ns;
2675     my $node_ln = $node->manakai_local_name;
2676     if ($node_ns eq $HTML_NS) {
2677     if ($node_ln eq 'noscript') {
2678     my $end = $self->_add_minuses ({$HTML_NS, {noscript => 1}});
2679     push @$sib, $end;
2680     }
2681     }
2682 wakaba 1.7 if ($HTMLTransparentElements->{$node_ns}->{$node_ln}) {
2683     unshift @$sib, @{$node->child_nodes};
2684 wakaba 1.9 push @$new_todos, {type => 'element-attributes', node => $node};
2685 wakaba 1.7 last TP;
2686 wakaba 1.2 }
2687 wakaba 1.8 if ($node_ns eq $HTML_NS and ($node_ln eq 'video' or $node_ln eq 'audio')) {
2688 wakaba 1.2 if ($node->has_attribute_ns (undef, 'src')) {
2689     unshift @$sib, @{$node->child_nodes};
2690 wakaba 1.9 push @$new_todos, {type => 'element-attributes', node => $node};
2691 wakaba 1.2 last TP;
2692     } else {
2693     my @cn = @{$node->child_nodes};
2694     CN: while (@cn) {
2695     my $cn = shift @cn;
2696     my $cnt = $cn->node_type;
2697     if ($cnt == 1) {
2698 wakaba 1.8 my $cn_nsuri = $cn->namespace_uri;
2699     $cn_nsuri = '' unless defined $cn_nsuri;
2700     if ($cn_nsuri eq $HTML_NS and $cn->manakai_local_name eq 'source') {
2701 wakaba 1.2 #
2702     } else {
2703     last CN;
2704     }
2705     } elsif ($cnt == 3 or $cnt == 4) {
2706     if ($cn->data =~ /[^\x09-\x0D\x20]/) {
2707     last CN;
2708     }
2709     }
2710     } # CN
2711     unshift @$sib, @cn;
2712     }
2713     }
2714 wakaba 1.4 push @$new_todos, {type => 'element', node => $node};
2715 wakaba 1.2 } # TP
2716 wakaba 1.4 return ($sib, $new_todos);
2717 wakaba 1.2 } # _check_get_children
2718    
2719 wakaba 1.1 1;
2720 wakaba 1.19 # $Date: 2007/05/25 14:46:54 $

[email protected]
ViewVC Help
Powered by ViewVC 1.1.24