/[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.20 - (hide annotations) (download)
Sat May 26 12:33:04 2007 UTC (19 years, 2 months ago) by wakaba
Branch: MAIN
Changes since 1.19: +69 -4 lines
++ whatpm/t/ChangeLog	26 May 2007 12:32:50 -0000
	* content-model-2.dat: Tests for |rel| values are added.

2007-05-26  Wakaba  <wakaba@suika.fam.cx>

++ whatpm/Whatpm/ChangeLog	26 May 2007 12:32:20 -0000
	* ContentChecker.pm ($HTMLLinkTypesAttrChecker): New checker.
	(link/@rel, a/@rel, area/@rel): Use new checker.

	* Makefile (_LinkTypeList.pm, RelExtensions.html): New rules.

	* _LinkTypeList.pm: New file.

	* mklinktypelist.pl: New file.

	* .cvsignore: |RelExtensions.html| added.

	* NanoDOM.pm (child_nodes): Returns an empty array
	for non-child-containing node types.
	(text_content): New attribute.

2007-05-26  Wakaba  <wakaba@suika.fam.cx>

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.20 ## |rel| attribute (unordered set of space separated tokens,
668     ## whose allowed values are defined by the section on link types)
669     my $HTMLLinkTypesAttrChecker = sub {
670     my ($a_or_area, $self, $attr) = @_;
671     my %word;
672     for my $word (grep {length $_} split /[\x09-\x0D\x20]/, $attr->value) {
673     unless ($word{$word}) {
674     $word{$word} = 1;
675     } else {
676     $self->{onerror}->(node => $attr, type => 'duplicate token:'.$word);
677     }
678     }
679     ## NOTE: Case sensitive match (since HTML5 spec does not say link
680     ## types are case-insensitive and it says "The value should not
681     ## be confusingly similar to any other defined value (e.g.
682     ## differing only in case).").
683     ## NOTE: Though there is no explicit "MUST NOT" for undefined values,
684     ## "MAY"s and "only ... MAY" restrict non-standard non-registered
685     ## values to be used conformingly.
686     require Whatpm::_LinkTypeList;
687     our $LinkType;
688     for my $word (keys %word) {
689     my $def = $LinkType->{$word};
690     if (defined $def) {
691     if ($def->{status} eq 'accepted') {
692     if (defined $def->{effect}->[$a_or_area]) {
693     #
694     } else {
695     $self->{onerror}->(node => $attr,
696     type => 'link type bad context:'.$word);
697     }
698     } elsif ($def->{status} eq 'proposal') {
699     $self->{onerror}->(node => $attr,
700     type => 'proposed link type:'.$word);
701     } else { # rejected or synonym
702     $self->{onerror}->(node => $attr,
703     type => 'non-conforming link type:'.$word);
704     }
705     if ($def->{unique}) {
706     unless ($self->{has_link_type}->{$word}) {
707     $self->{has_link_type}->{$word} = 1;
708     } else {
709     $self->{onerror}->(node => $attr,
710     type => 'link with type not unique:'.$word);
711     }
712     }
713     } else {
714     $self->{onerror}->(node => $attr,
715     type => 'link type not supported:'.$word);
716     }
717     }
718     ## TODO: The Pingback 1.0 specification, which is referenced by HTML5,
719     ## says that using both X-Pingback: header field and HTML
720     ## <link rel=pingback> is deprecated and if both appears they
721     ## SHOULD contain exactly the same value.
722     ## ISSUE: Pingback 1.0 specification defines the exact representation
723     ## of its link element, which cannot be tested by the current arch.
724     ## ISSUE: Pingback 1.0 specification says that the document MUST NOT
725     ## include any string that matches to the pattern for the rel=pingback link,
726     ## which again inpossible to test.
727     ## ISSUE: rel=pingback href MUST NOT include entities other than predefined 4.
728     }; # $HTMLLinkTypesAttrChecker
729    
730 wakaba 1.18 ## URI (or IRI)
731 wakaba 1.11 my $HTMLURIAttrChecker = sub {
732     my ($self, $attr) = @_;
733 wakaba 1.15 ## ISSUE: Relative references are allowed? (RFC 3987 "IRI" is an absolute reference with optional fragment identifier.)
734 wakaba 1.18 my $value = $attr->value;
735     Whatpm::URIChecker->check_iri_reference ($value, sub {
736     my %opt = @_;
737     $self->{onerror}->(node => $attr, type => 'URI:'.$opt{level}.':'.$opt{type});
738     });
739 wakaba 1.11 }; # $HTMLURIAttrChecker
740    
741 wakaba 1.15 ## A space separated list of one or more URIs (or IRIs)
742     my $HTMLSpaceURIsAttrChecker = sub {
743     my ($self, $attr) = @_;
744     ## TODO: URI or IRI check
745     ## ISSUE: Relative references?
746     ## ISSUE: Leading or trailing white spaces are conformant?
747     ## ISSUE: A sequence of white space characters are conformant?
748     ## ISSUE: A zero-length string is conformant? (It does contain a relative reference, i.e. same as base URI.)
749     ## NOTE: Duplication seems not an error.
750     }; # $HTMLSpaceURIsAttrChecker
751    
752 wakaba 1.11 my $HTMLIntegerAttrChecker = sub {
753     my ($self, $attr) = @_;
754     my $value = $attr->value;
755     unless ($value =~ /\A-?[0-9]+\z/) {
756 wakaba 1.15 $self->{onerror}->(node => $attr, type => 'integer syntax error');
757 wakaba 1.11 }
758     }; # $HTMLIntegerAttrChecker
759    
760 wakaba 1.12 my $GetHTMLNonNegativeIntegerAttrChecker = sub {
761     my $range_check = shift;
762     return sub {
763     my ($self, $attr) = @_;
764     my $value = $attr->value;
765     if ($value =~ /\A[0-9]+\z/) {
766     unless ($range_check->($value + 0)) {
767     $self->{onerror}->(node => $attr, type => 'out of range');
768     }
769     } else {
770 wakaba 1.15 $self->{onerror}->(node => $attr,
771     type => 'non-negative integer syntax error');
772 wakaba 1.12 }
773     };
774     }; # $GetHTMLNonNegativeIntegerAttrChecker
775    
776 wakaba 1.11 my $GetHTMLFloatingPointNumberAttrChecker = sub {
777     my $range_check = shift;
778     return sub {
779     my ($self, $attr) = @_;
780     my $value = $attr->value;
781     if ($value =~ /\A-?[0-9.]+\z/ and $value =~ /[0-9]/) {
782     unless ($range_check->($value + 0)) {
783     $self->{onerror}->(node => $attr, type => 'out of range');
784     }
785     } else {
786 wakaba 1.15 $self->{onerror}->(node => $attr,
787     type => 'floating point number syntax error');
788 wakaba 1.11 }
789     };
790     }; # $GetHTMLFloatingPointNumberAttrChecker
791    
792 wakaba 1.15 ## "A valid MIME type, optionally with parameters. [RFC 2046]"
793     ## ISSUE: RFC 2046 does not define syntax of media types.
794     ## ISSUE: The definition of "a valid MIME type" is unknown.
795     ## Syntactical correctness?
796     my $HTMLIMTAttrChecker = sub {
797     my ($self, $attr) = @_;
798     my $value = $attr->value;
799     ## ISSUE: RFC 2045 Content-Type header field allows insertion
800     ## of LWS/comments between tokens. Is it allowed in HTML? Maybe no.
801     ## ISSUE: RFC 2231 extension? Maybe no.
802     my $lws0 = qr/(?>(?>\x0D\x0A)?[\x09\x20])*/;
803     my $token = qr/[\x21\x23-\x27\x2A\x2B\x2D\x2E\x30-\x39\x41-\x5A\x5E-\x7E]+/;
804     my $qs = qr/"(?>[\x00-\x0C\x0E-\x21\x23-\x5B\x5D-\x7E]|\x0D\x0A[\x09\x20]|\x5C[\x00-\x7F])*"/;
805 wakaba 1.19 if ($value =~ m#\A$lws0($token)$lws0/$lws0($token)$lws0((?>;$lws0$token$lws0=$lws0(?>$token|$qs)$lws0)*)\z#) {
806     my @type = ($1, $2);
807     my $param = $3;
808     while ($param =~ s/^;$lws0($token)$lws0=$lws0(?>($token)|($qs))$lws0//) {
809     if (defined $2) {
810     push @type, $1 => $2;
811     } else {
812     my $n = $1;
813     my $v = $2;
814     $v =~ s/\\(.)/$1/gs;
815     push @type, $n => $v;
816     }
817     }
818     require Whatpm::IMTChecker;
819     Whatpm::IMTChecker->check_imt (sub {
820     my %opt = @_;
821     $self->{onerror}->(node => $attr,
822     type => 'IMT:'.$opt{level}.':'.$opt{type});
823     }, @type);
824     } else {
825 wakaba 1.15 $self->{onerror}->(node => $attr, type => 'IMT syntax error');
826     }
827     }; # $HTMLIMTAttrChecker
828    
829 wakaba 1.17 my $HTMLLanguageTagAttrChecker = sub {
830     my ($self, $attr) = @_;
831     if ($attr->value eq '') {
832     $self->{onerror}->(node => $attr, type => 'language tag syntax error');
833     }
834     ## TODO: RFC 3066 test
835     ## ISSUE: RFC 4646 (3066bis)?
836     }; # $HTMLLanguageTagAttrChecker
837    
838     ## "A valid media query [MQ]"
839     my $HTMLMQAttrChecker = sub {
840     ## ISSUE: What is "a valid media query"?
841     }; # $HTMLMQAttrChecker
842    
843 wakaba 1.16 my $HTMLEventHandlerAttrChecker = sub {
844     ## TODO: MUST contain valid ECMAScript code matching the
845     ## ECMAScript |FunctionBody| production. [ECMA262]
846     ## ISSUE: MUST be ES3? E4X? ES4? JS1.x?
847     ## ISSUE: Automatic semicolon insertion does not apply?
848     ## ISSUE: Other script languages?
849     }; # $HTMLEventHandlerAttrChecker
850    
851 wakaba 1.17 my $HTMLUsemapAttrChecker = sub {
852     my ($self, $attr) = @_;
853     ## MUST be a valid hashed ID reference to a |map| element
854     my $value = $attr->value;
855     if ($value =~ s/^#//) {
856     ## ISSUE: Is |usemap="#"| conformant? (c.f. |id=""| is non-conformant.)
857     push @{$self->{usemap}}, [$value => $attr];
858     } else {
859     $self->{onerror}->(node => $attr, type => 'hashed idref syntax error');
860     }
861 wakaba 1.20 ## ISSUE: UA algorithm for matching is case-insensitive; IDs only different in cases should be reported
862 wakaba 1.17 }; # $HTMLUsemapAttrChecker
863    
864     my $HTMLTargetAttrChecker = sub {
865     my ($self, $attr) = @_;
866     my $value = $attr->value;
867     if ($value =~ /^_/) {
868     $value = lc $value; ## ISSUE: ASCII case-insentitive?
869     unless ({
870     _self => 1, _parent => 1, _top => 1,
871     }->{$value}) {
872     $self->{onerror}->(node => $attr,
873     type => 'reserved browsing context name');
874     }
875     } else {
876     #$ ISSUE: An empty string is conforming?
877     }
878     }; # $HTMLTargetAttrChecker
879    
880 wakaba 1.10 my $HTMLAttrChecker = {
881     id => sub {
882 wakaba 1.17 ## NOTE: |map| has its own variant of |id=""| checker
883 wakaba 1.10 my ($self, $attr) = @_;
884     my $value = $attr->value;
885 wakaba 1.17 if (length $value > 0) {
886 wakaba 1.10 if ($self->{id}->{$value}) {
887     $self->{onerror}->(node => $attr, type => 'duplicate ID');
888     } else {
889     $self->{id}->{$value} = 1;
890     }
891 wakaba 1.17 } else {
892     ## NOTE: MUST contain at least one character
893     $self->{onerror}->(node => $attr, type => 'attribute value is empty');
894 wakaba 1.10 }
895     },
896     title => sub {}, ## NOTE: No conformance creteria
897     lang => sub {
898 wakaba 1.17 ## TODO: RFC 3066 or empty test
899 wakaba 1.10 ## ISSUE: RFC 4646 (3066bis)?
900     ## TODO: HTML vs XHTML
901     },
902     dir => $GetHTMLEnumeratedAttrChecker->({ltr => 1, rtl => 1}),
903     class => $HTMLUnorderedSetOfSpaceSeparatedTokensAttrChecker,
904     irrelevant => $GetHTMLBooleanAttrChecker->('irrelevant'),
905     ## TODO: tabindex
906     };
907    
908 wakaba 1.16 for (qw/
909     onabort onbeforeunload onblur onchange onclick oncontextmenu
910     ondblclick ondrag ondragend ondragenter ondragleave ondragover
911     ondragstart ondrop onerror onfocus onkeydown onkeypress
912     onkeyup onload onmessage onmousedown onmousemove onmouseout
913     onmouseover onmouseup onmousewheel onresize onscroll onselect
914     onsubmit onunload
915     /) {
916     $HTMLAttrChecker->{$_} = $HTMLEventHandlerAttrChecker;
917     }
918    
919 wakaba 1.10 my $GetHTMLAttrsChecker = sub {
920     my $element_specific_checker = shift;
921     return sub {
922     my ($self, $todo) = @_;
923     for my $attr (@{$todo->{node}->attributes}) {
924     my $attr_ns = $attr->namespace_uri;
925     $attr_ns = '' unless defined $attr_ns;
926     my $attr_ln = $attr->manakai_local_name;
927     my $checker;
928     if ($attr_ns eq '') {
929     $checker = $element_specific_checker->{$attr_ln}
930     || $HTMLAttrChecker->{$attr_ln};
931     }
932     $checker ||= $AttrChecker->{$attr_ns}->{$attr_ln}
933     || $AttrChecker->{$attr_ns}->{''};
934     if ($checker) {
935     $checker->($self, $attr);
936     } else {
937     $self->{onerror}->(node => $attr, type => 'attribute not supported');
938     ## ISSUE: No comformance createria for unknown attributes in the spec
939     }
940     }
941     };
942     }; # $GetHTMLAttrsChecker
943 wakaba 1.9
944     $Element->{$HTML_NS}->{''} = {
945 wakaba 1.10 attrs_checker => $GetHTMLAttrsChecker->({}),
946 wakaba 1.9 checker => $ElementDefault->{checker},
947     };
948    
949 wakaba 1.1 $Element->{$HTML_NS}->{html} = {
950 wakaba 1.10 attrs_checker => $GetHTMLAttrsChecker->({
951     xmlns => sub {
952     my ($self, $attr) = @_;
953     my $value = $attr->value;
954     unless ($value eq $HTML_NS) {
955     $self->{onerror}->(node => $attr, type => 'syntax error');
956     ## TODO: only in HTML documents
957     }
958     },
959     }),
960 wakaba 1.1 checker => sub {
961 wakaba 1.4 my ($self, $todo) = @_;
962     my $el = $todo->{node};
963     my $new_todos = [];
964 wakaba 1.1 my @nodes = (@{$el->child_nodes});
965    
966     my $phase = 'before head';
967     while (@nodes) {
968     my $node = shift @nodes;
969 wakaba 1.2 $self->_remove_minuses ($node) and next if ref $node eq 'HASH';
970    
971 wakaba 1.1 my $nt = $node->node_type;
972     if ($nt == 1) {
973 wakaba 1.2 my $node_ns = $node->namespace_uri;
974     $node_ns = '' unless defined $node_ns;
975     my $node_ln = $node->manakai_local_name;
976 wakaba 1.6 my $not_allowed = $self->{minuses}->{$node_ns}->{$node_ln};
977 wakaba 1.1 if ($phase eq 'before head') {
978 wakaba 1.8 if ($node_ns eq $HTML_NS and $node_ln eq 'head') {
979 wakaba 1.1 $phase = 'after head';
980 wakaba 1.8 } elsif ($node_ns eq $HTML_NS and $node_ln eq 'body') {
981     $self->{onerror}->(node => $node, type => 'ps element missing:head');
982 wakaba 1.1 $phase = 'after body';
983     } else {
984 wakaba 1.6 $not_allowed = 1;
985 wakaba 1.1 # before head
986     }
987     } elsif ($phase eq 'after head') {
988 wakaba 1.8 if ($node_ns eq $HTML_NS and $node_ln eq 'body') {
989 wakaba 1.1 $phase = 'after body';
990     } else {
991 wakaba 1.6 $not_allowed = 1;
992 wakaba 1.1 # after head
993     }
994     } else { #elsif ($phase eq 'after body') {
995 wakaba 1.6 $not_allowed = 1;
996 wakaba 1.1 # after body
997     }
998 wakaba 1.6 $self->{onerror}->(node => $node, type => 'element not allowed')
999     if $not_allowed;
1000 wakaba 1.2 my ($sib, $ch) = $self->_check_get_children ($node);
1001     unshift @nodes, @$sib;
1002 wakaba 1.4 push @$new_todos, @$ch;
1003 wakaba 1.1 } elsif ($nt == 3 or $nt == 4) {
1004     if ($node->data =~ /[^\x09-\x0D\x20]/) {
1005 wakaba 1.2 $self->{onerror}->(node => $node, type => 'character not allowed');
1006 wakaba 1.1 }
1007     } elsif ($nt == 5) {
1008     unshift @nodes, @{$node->child_nodes};
1009     }
1010     }
1011 wakaba 1.3
1012     if ($phase eq 'before head') {
1013     $self->{onerror}->(node => $el, type => 'child element missing:head');
1014     $self->{onerror}->(node => $el, type => 'child element missing:body');
1015     } elsif ($phase eq 'after head') {
1016     $self->{onerror}->(node => $el, type => 'child element missing:body');
1017     }
1018    
1019 wakaba 1.4 return ($new_todos);
1020 wakaba 1.1 },
1021     };
1022    
1023     $Element->{$HTML_NS}->{head} = {
1024 wakaba 1.10 attrs_checker => $GetHTMLAttrsChecker->({}),
1025 wakaba 1.1 checker => sub {
1026 wakaba 1.4 my ($self, $todo) = @_;
1027     my $el = $todo->{node};
1028     my $new_todos = [];
1029 wakaba 1.1 my @nodes = (@{$el->child_nodes});
1030    
1031     my $has_title;
1032 wakaba 1.3 my $phase = 'initial'; # 'after charset', 'after base'
1033 wakaba 1.1 while (@nodes) {
1034     my $node = shift @nodes;
1035 wakaba 1.2 $self->_remove_minuses ($node) and next if ref $node eq 'HASH';
1036    
1037 wakaba 1.1 my $nt = $node->node_type;
1038     if ($nt == 1) {
1039 wakaba 1.2 my $node_ns = $node->namespace_uri;
1040     $node_ns = '' unless defined $node_ns;
1041     my $node_ln = $node->manakai_local_name;
1042 wakaba 1.6 my $not_allowed = $self->{minuses}->{$node_ns}->{$node_ln};
1043 wakaba 1.8 if ($node_ns eq $HTML_NS and $node_ln eq 'title') {
1044 wakaba 1.3 $phase = 'after base';
1045 wakaba 1.1 unless ($has_title) {
1046     $has_title = 1;
1047     } else {
1048 wakaba 1.6 $not_allowed = 1;
1049 wakaba 1.1 }
1050 wakaba 1.8 } elsif ($node_ns eq $HTML_NS and $node_ln eq 'meta') {
1051 wakaba 1.1 if ($node->has_attribute_ns (undef, 'charset')) {
1052 wakaba 1.3 if ($phase eq 'initial') {
1053     $phase = 'after charset';
1054 wakaba 1.1 } else {
1055 wakaba 1.6 $not_allowed = 1;
1056 wakaba 1.3 ## NOTE: See also |base|'s "contexts" field in the spec
1057 wakaba 1.1 }
1058     } else {
1059 wakaba 1.3 $phase = 'after base';
1060 wakaba 1.1 }
1061 wakaba 1.8 } elsif ($node_ns eq $HTML_NS and $node_ln eq 'base') {
1062 wakaba 1.3 if ($phase eq 'initial' or $phase eq 'after charset') {
1063     $phase = 'after base';
1064 wakaba 1.1 } else {
1065 wakaba 1.6 $not_allowed = 1;
1066 wakaba 1.1 }
1067 wakaba 1.7 } elsif ($HTMLMetadataElements->{$node_ns}->{$node_ln}) {
1068     $phase = 'after base';
1069 wakaba 1.1 } else {
1070 wakaba 1.7 $not_allowed = 1;
1071 wakaba 1.1 }
1072 wakaba 1.6 $self->{onerror}->(node => $node, type => 'element not allowed')
1073     if $not_allowed;
1074 wakaba 1.2 my ($sib, $ch) = $self->_check_get_children ($node);
1075     unshift @nodes, @$sib;
1076 wakaba 1.4 push @$new_todos, @$ch;
1077 wakaba 1.1 } elsif ($nt == 3 or $nt == 4) {
1078     if ($node->data =~ /[^\x09-\x0D\x20]/) {
1079 wakaba 1.2 $self->{onerror}->(node => $node, type => 'character not allowed');
1080 wakaba 1.1 }
1081     } elsif ($nt == 5) {
1082     unshift @nodes, @{$node->child_nodes};
1083     }
1084     }
1085     unless ($has_title) {
1086 wakaba 1.3 $self->{onerror}->(node => $el, type => 'child element missing:title');
1087 wakaba 1.1 }
1088 wakaba 1.4 return ($new_todos);
1089 wakaba 1.1 },
1090     };
1091    
1092     $Element->{$HTML_NS}->{title} = {
1093 wakaba 1.10 attrs_checker => $GetHTMLAttrsChecker->({}),
1094 wakaba 1.1 checker => $HTMLTextChecker,
1095     };
1096    
1097     $Element->{$HTML_NS}->{base} = {
1098 wakaba 1.10 attrs_checker => $GetHTMLAttrsChecker->({
1099 wakaba 1.11 href => $HTMLURIAttrChecker,
1100 wakaba 1.17 target => $HTMLTargetAttrChecker,
1101 wakaba 1.10 }),
1102 wakaba 1.1 checker => $HTMLEmptyChecker,
1103     };
1104    
1105     $Element->{$HTML_NS}->{link} = {
1106 wakaba 1.16 attrs_checker => sub {
1107     my ($self, $todo) = @_;
1108     $GetHTMLAttrsChecker->({
1109     href => $HTMLURIAttrChecker,
1110 wakaba 1.20 rel => sub { $HTMLLinkTypesAttrChecker->(0, @_) },
1111 wakaba 1.17 media => $HTMLMQAttrChecker,
1112     hreflang => $HTMLLanguageTagAttrChecker,
1113 wakaba 1.16 type => $HTMLIMTAttrChecker,
1114     ## NOTE: Though |title| has special semantics,
1115     ## syntactically same as the |title| as global attribute.
1116     })->($self, $todo);
1117     unless ($todo->{node}->has_attribute_ns (undef, 'href')) {
1118     $self->{onerror}->(node => $todo->{node},
1119     type => 'attribute missing:href');
1120     }
1121     unless ($todo->{node}->has_attribute_ns (undef, 'rel')) {
1122     $self->{onerror}->(node => $todo->{node},
1123     type => 'attribute missing:rel');
1124     }
1125     },
1126 wakaba 1.1 checker => $HTMLEmptyChecker,
1127     };
1128    
1129     $Element->{$HTML_NS}->{meta} = {
1130 wakaba 1.10 attrs_checker => sub {
1131     my ($self, $todo) = @_;
1132     my $name_attr;
1133     my $http_equiv_attr;
1134     my $charset_attr;
1135     my $content_attr;
1136     for my $attr (@{$todo->{node}->attributes}) {
1137     my $attr_ns = $attr->namespace_uri;
1138     $attr_ns = '' unless defined $attr_ns;
1139     my $attr_ln = $attr->manakai_local_name;
1140     my $checker;
1141     if ($attr_ns eq '') {
1142     if ($attr_ln eq 'content') {
1143     $content_attr = $attr;
1144     $checker = 1;
1145     } elsif ($attr_ln eq 'name') {
1146     $name_attr = $attr;
1147     $checker = 1;
1148     } elsif ($attr_ln eq 'http-equiv') {
1149     $http_equiv_attr = $attr;
1150     $checker = 1;
1151     } elsif ($attr_ln eq 'charset') {
1152     $charset_attr = $attr;
1153     $checker = 1;
1154     } else {
1155     $checker = $HTMLAttrChecker->{$attr_ln}
1156     || $AttrChecker->{$attr_ns}->{$attr_ln}
1157     || $AttrChecker->{$attr_ns}->{''};
1158     }
1159     } else {
1160     $checker ||= $AttrChecker->{$attr_ns}->{$attr_ln}
1161     || $AttrChecker->{$attr_ns}->{''};
1162     }
1163     if ($checker) {
1164     $checker->($self, $attr) if ref $checker;
1165     } else {
1166     $self->{onerror}->(node => $attr, type => 'attribute not supported');
1167     ## ISSUE: No comformance createria for unknown attributes in the spec
1168     }
1169     }
1170    
1171     if (defined $name_attr) {
1172     if (defined $http_equiv_attr) {
1173     $self->{onerror}->(node => $http_equiv_attr,
1174     type => 'attribute not allowed');
1175     } elsif (defined $charset_attr) {
1176     $self->{onerror}->(node => $charset_attr,
1177     type => 'attribute not allowed');
1178     }
1179     my $metadata_name = $name_attr->value;
1180     my $metadata_value;
1181     if (defined $content_attr) {
1182     $metadata_value = $content_attr->value;
1183     } else {
1184     $self->{onerror}->(node => $todo->{node},
1185     type => 'attribute missing:content');
1186     $metadata_value = '';
1187     }
1188     } elsif (defined $http_equiv_attr) {
1189     if (defined $charset_attr) {
1190     $self->{onerror}->(node => $charset_attr,
1191     type => 'attribute not allowed');
1192     }
1193     unless (defined $content_attr) {
1194     $self->{onerror}->(node => $todo->{node},
1195     type => 'attribute missing:content');
1196     }
1197     } elsif (defined $charset_attr) {
1198     if (defined $content_attr) {
1199     $self->{onerror}->(node => $content_attr,
1200     type => 'attribute not allowed');
1201     }
1202     ## TODO: Allowed only in HTML documents
1203     } else {
1204     if (defined $content_attr) {
1205     $self->{onerror}->(node => $content_attr,
1206     type => 'attribute not allowed');
1207     $self->{onerror}->(node => $todo->{node},
1208     type => 'attribute missing:name|http-equiv');
1209     } else {
1210     $self->{onerror}->(node => $todo->{node},
1211     type => 'attribute missing:name|http-equiv|charset');
1212     }
1213     }
1214    
1215     ## TODO: metadata conformance
1216    
1217     ## TODO: pragma conformance
1218     if (defined $http_equiv_attr) { ## An enumerated attribute
1219     my $keyword = lc $http_equiv_attr->value; ## TODO: ascii case?
1220     if ({
1221     'refresh' => 1,
1222     'default-style' => 1,
1223     }->{$keyword}) {
1224     #
1225     } else {
1226     $self->{onerror}->(node => $http_equiv_attr,
1227     type => 'invalid enumerated attribute value');
1228     }
1229     }
1230    
1231     ## TODO: charset
1232     },
1233 wakaba 1.1 checker => $HTMLEmptyChecker,
1234     };
1235    
1236     ## NOTE: |html:style| has no conformance creteria on content model
1237 wakaba 1.3 $Element->{$HTML_NS}->{style} = {
1238 wakaba 1.10 attrs_checker => $GetHTMLAttrsChecker->({
1239 wakaba 1.15 type => $HTMLIMTAttrChecker, ## TODO: MUST be a styling language
1240 wakaba 1.17 media => $HTMLMQAttrChecker,
1241 wakaba 1.10 scoped => $GetHTMLBooleanAttrChecker->('scoped'),
1242     ## NOTE: |title| has special semantics for |style|s, but is syntactically
1243     ## not different
1244     }),
1245 wakaba 1.3 checker => $AnyChecker,
1246     };
1247 wakaba 1.1
1248     $Element->{$HTML_NS}->{body} = {
1249 wakaba 1.10 attrs_checker => $GetHTMLAttrsChecker->({}),
1250 wakaba 1.1 checker => $HTMLBlockChecker,
1251     };
1252    
1253     $Element->{$HTML_NS}->{section} = {
1254 wakaba 1.10 attrs_checker => $GetHTMLAttrsChecker->({}),
1255 wakaba 1.1 checker => $HTMLStylableBlockChecker,
1256     };
1257    
1258     $Element->{$HTML_NS}->{nav} = {
1259 wakaba 1.10 attrs_checker => $GetHTMLAttrsChecker->({}),
1260 wakaba 1.1 checker => $HTMLBlockOrInlineChecker,
1261     };
1262    
1263     $Element->{$HTML_NS}->{article} = {
1264 wakaba 1.10 attrs_checker => $GetHTMLAttrsChecker->({}),
1265 wakaba 1.1 checker => $HTMLStylableBlockChecker,
1266     };
1267    
1268     $Element->{$HTML_NS}->{blockquote} = {
1269 wakaba 1.11 attrs_checker => $GetHTMLAttrsChecker->({
1270     cite => $HTMLURIAttrChecker,
1271     }),
1272 wakaba 1.1 checker => $HTMLBlockChecker,
1273     };
1274    
1275     $Element->{$HTML_NS}->{aside} = {
1276 wakaba 1.10 attrs_checker => $GetHTMLAttrsChecker->({}),
1277 wakaba 1.2 checker => $GetHTMLZeroOrMoreThenBlockOrInlineChecker->($HTML_NS, 'style'),
1278 wakaba 1.1 };
1279    
1280     $Element->{$HTML_NS}->{h1} = {
1281 wakaba 1.10 attrs_checker => $GetHTMLAttrsChecker->({}),
1282 wakaba 1.1 checker => $HTMLSignificantStrictlyInlineChecker,
1283     };
1284    
1285     $Element->{$HTML_NS}->{h2} = {
1286 wakaba 1.10 attrs_checker => $GetHTMLAttrsChecker->({}),
1287 wakaba 1.1 checker => $HTMLSignificantStrictlyInlineChecker,
1288     };
1289    
1290     $Element->{$HTML_NS}->{h3} = {
1291 wakaba 1.10 attrs_checker => $GetHTMLAttrsChecker->({}),
1292 wakaba 1.1 checker => $HTMLSignificantStrictlyInlineChecker,
1293     };
1294    
1295     $Element->{$HTML_NS}->{h4} = {
1296 wakaba 1.10 attrs_checker => $GetHTMLAttrsChecker->({}),
1297 wakaba 1.1 checker => $HTMLSignificantStrictlyInlineChecker,
1298     };
1299    
1300     $Element->{$HTML_NS}->{h5} = {
1301 wakaba 1.10 attrs_checker => $GetHTMLAttrsChecker->({}),
1302 wakaba 1.1 checker => $HTMLSignificantStrictlyInlineChecker,
1303     };
1304    
1305     $Element->{$HTML_NS}->{h6} = {
1306 wakaba 1.10 attrs_checker => $GetHTMLAttrsChecker->({}),
1307 wakaba 1.1 checker => $HTMLSignificantStrictlyInlineChecker,
1308     };
1309    
1310     ## TODO: header
1311    
1312 wakaba 1.2 $Element->{$HTML_NS}->{footer} = {
1313 wakaba 1.10 attrs_checker => $GetHTMLAttrsChecker->({}),
1314 wakaba 1.2 checker => sub { ## block -hn -header -footer -sectioning or inline
1315 wakaba 1.4 my ($self, $todo) = @_;
1316     my $el = $todo->{node};
1317     my $new_todos = [];
1318 wakaba 1.2 my @nodes = (@{$el->child_nodes});
1319    
1320     my $content = 'block-or-inline'; # or 'block' or 'inline'
1321     my @block_not_inline;
1322     while (@nodes) {
1323     my $node = shift @nodes;
1324     $self->_remove_minuses ($node) and next if ref $node eq 'HASH';
1325    
1326     my $nt = $node->node_type;
1327     if ($nt == 1) {
1328     my $node_ns = $node->namespace_uri;
1329     $node_ns = '' unless defined $node_ns;
1330     my $node_ln = $node->manakai_local_name;
1331 wakaba 1.6 my $not_allowed;
1332 wakaba 1.2 if ($self->{minuses}->{$node_ns}->{$node_ln}) {
1333 wakaba 1.6 $not_allowed = 1;
1334 wakaba 1.2 } elsif ($node_ns eq $HTML_NS and
1335     {
1336     qw/h1 1 h2 1 h3 1 h4 1 h5 1 h6 1 header 1 footer 1/
1337     }->{$node_ln}) {
1338 wakaba 1.6 $not_allowed = 1;
1339 wakaba 1.2 } elsif ($HTMLSectioningElements->{$node_ns}->{$node_ln}) {
1340 wakaba 1.6 $not_allowed = 1;
1341 wakaba 1.2 }
1342     if ($content eq 'block') {
1343 wakaba 1.7 $not_allowed = 1
1344     unless $HTMLBlockLevelElements->{$node_ns}->{$node_ln};
1345 wakaba 1.2 } elsif ($content eq 'inline') {
1346 wakaba 1.7 $not_allowed = 1
1347     unless $HTMLStrictlyInlineLevelElements->{$node_ns}->{$node_ln} or
1348     $HTMLStructuredInlineLevelElements->{$node_ns}->{$node_ln};
1349 wakaba 1.2 } else {
1350 wakaba 1.7 my $is_block = $HTMLBlockLevelElements->{$node_ns}->{$node_ln};
1351     my $is_inline
1352     = $HTMLStrictlyInlineLevelElements->{$node_ns}->{$node_ln} ||
1353     $HTMLStructuredInlineLevelElements->{$node_ns}->{$node_ln};
1354 wakaba 1.2
1355 wakaba 1.6 push @block_not_inline, $node
1356     if $is_block and not $is_inline and not $not_allowed;
1357 wakaba 1.2 unless ($is_block) {
1358     $content = 'inline';
1359     for (@block_not_inline) {
1360     $self->{onerror}->(node => $_, type => 'element not allowed');
1361     }
1362 wakaba 1.6 $not_allowed = 1 unless $is_inline;
1363 wakaba 1.2 }
1364     }
1365 wakaba 1.6 $self->{onerror}->(node => $node, type => 'element not allowed')
1366     if $not_allowed;
1367 wakaba 1.2 my ($sib, $ch) = $self->_check_get_children ($node);
1368     unshift @nodes, @$sib;
1369 wakaba 1.4 push @$new_todos, @$ch;
1370 wakaba 1.2 } elsif ($nt == 3 or $nt == 4) {
1371     if ($node->data =~ /[^\x09-\x0D\x20]/) {
1372     if ($content eq 'block') {
1373     $self->{onerror}->(node => $node, type => 'character not allowed');
1374     } else {
1375     $content = 'inline';
1376     for (@block_not_inline) {
1377     $self->{onerror}->(node => $_, type => 'element not allowed');
1378     }
1379     }
1380     }
1381     } elsif ($nt == 5) {
1382     unshift @nodes, @{$node->child_nodes};
1383     }
1384     }
1385    
1386     my $end = $self->_add_minuses
1387     ({$HTML_NS => {qw/h1 1 h2 1 h3 1 h4 1 h5 1 h6 1/}},
1388     $HTMLSectioningElements);
1389 wakaba 1.4 push @$new_todos, $end;
1390 wakaba 1.2
1391 wakaba 1.4 if ($content eq 'inline') {
1392     for (@$new_todos) {
1393     $_->{inline} = 1;
1394     }
1395     }
1396    
1397     return ($new_todos);
1398 wakaba 1.2 },
1399     };
1400 wakaba 1.1
1401     $Element->{$HTML_NS}->{address} = {
1402 wakaba 1.10 attrs_checker => $GetHTMLAttrsChecker->({}),
1403 wakaba 1.1 checker => $HTMLInlineChecker,
1404     };
1405    
1406     $Element->{$HTML_NS}->{p} = {
1407 wakaba 1.10 attrs_checker => $GetHTMLAttrsChecker->({}),
1408 wakaba 1.1 checker => $HTMLSignificantInlineChecker,
1409     };
1410    
1411     $Element->{$HTML_NS}->{hr} = {
1412 wakaba 1.10 attrs_checker => $GetHTMLAttrsChecker->({}),
1413 wakaba 1.1 checker => $HTMLEmptyChecker,
1414     };
1415    
1416     $Element->{$HTML_NS}->{br} = {
1417 wakaba 1.10 attrs_checker => $GetHTMLAttrsChecker->({}),
1418 wakaba 1.1 checker => $HTMLEmptyChecker,
1419     };
1420    
1421     $Element->{$HTML_NS}->{dialog} = {
1422 wakaba 1.10 attrs_checker => $GetHTMLAttrsChecker->({}),
1423 wakaba 1.1 checker => sub {
1424 wakaba 1.4 my ($self, $todo) = @_;
1425     my $el = $todo->{node};
1426     my $new_todos = [];
1427 wakaba 1.1 my @nodes = (@{$el->child_nodes});
1428    
1429     my $phase = 'before dt';
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.1 if ($phase eq 'before dt') {
1441 wakaba 1.8 if ($node_ns eq $HTML_NS and $node_ln eq 'dt') {
1442 wakaba 1.1 $phase = 'before dd';
1443 wakaba 1.8 } elsif ($node_ns eq $HTML_NS and $node_ln eq 'dd') {
1444 wakaba 1.2 $self->{onerror}
1445 wakaba 1.3 ->(node => $node, type => 'ps element missing:dt');
1446 wakaba 1.1 $phase = 'before dt';
1447     } else {
1448 wakaba 1.2 $self->{onerror}->(node => $node, type => 'element not allowed');
1449 wakaba 1.1 }
1450     } else { # before dd
1451 wakaba 1.8 if ($node_ns eq $HTML_NS and $node_ln eq 'dd') {
1452 wakaba 1.1 $phase = 'before dt';
1453 wakaba 1.8 } elsif ($node_ns eq $HTML_NS and $node_ln eq 'dt') {
1454 wakaba 1.2 $self->{onerror}
1455 wakaba 1.3 ->(node => $node, type => 'ps element missing:dd');
1456 wakaba 1.1 $phase = 'before dd';
1457     } else {
1458 wakaba 1.2 $self->{onerror}->(node => $node, type => 'element not allowed');
1459 wakaba 1.1 }
1460     }
1461 wakaba 1.2 my ($sib, $ch) = $self->_check_get_children ($node);
1462     unshift @nodes, @$sib;
1463 wakaba 1.4 push @$new_todos, @$ch;
1464 wakaba 1.1 } elsif ($nt == 3 or $nt == 4) {
1465     if ($node->data =~ /[^\x09-\x0D\x20]/) {
1466 wakaba 1.2 $self->{onerror}->(node => $node, type => 'character not allowed');
1467 wakaba 1.1 }
1468     } elsif ($nt == 5) {
1469     unshift @nodes, @{$node->child_nodes};
1470     }
1471     }
1472     if ($phase eq 'before dd') {
1473 wakaba 1.3 $self->{onerror}->(node => $el, type => 'ps element missing:dd');
1474 wakaba 1.1 }
1475 wakaba 1.4 return ($new_todos);
1476 wakaba 1.1 },
1477     };
1478    
1479     $Element->{$HTML_NS}->{pre} = {
1480 wakaba 1.10 attrs_checker => $GetHTMLAttrsChecker->({}),
1481 wakaba 1.1 checker => $HTMLStrictlyInlineChecker,
1482     };
1483    
1484     $Element->{$HTML_NS}->{ol} = {
1485 wakaba 1.11 attrs_checker => $GetHTMLAttrsChecker->({
1486     start => $HTMLIntegerAttrChecker,
1487     }),
1488 wakaba 1.1 checker => sub {
1489 wakaba 1.4 my ($self, $todo) = @_;
1490     my $el = $todo->{node};
1491     my $new_todos = [];
1492 wakaba 1.1 my @nodes = (@{$el->child_nodes});
1493    
1494     while (@nodes) {
1495     my $node = shift @nodes;
1496 wakaba 1.2 $self->_remove_minuses ($node) and next if ref $node eq 'HASH';
1497    
1498 wakaba 1.1 my $nt = $node->node_type;
1499     if ($nt == 1) {
1500 wakaba 1.8 my $node_ns = $node->namespace_uri;
1501     $node_ns = '' unless defined $node_ns;
1502     my $node_ln = $node->manakai_local_name;
1503 wakaba 1.2 ## NOTE: |minuses| list is not checked since redundant
1504 wakaba 1.8 unless ($node_ns eq $HTML_NS and $node_ln eq 'li') {
1505 wakaba 1.2 $self->{onerror}->(node => $node, type => 'element not allowed');
1506 wakaba 1.1 }
1507 wakaba 1.2 my ($sib, $ch) = $self->_check_get_children ($node);
1508     unshift @nodes, @$sib;
1509 wakaba 1.4 push @$new_todos, @$ch;
1510 wakaba 1.1 } elsif ($nt == 3 or $nt == 4) {
1511     if ($node->data =~ /[^\x09-\x0D\x20]/) {
1512 wakaba 1.2 $self->{onerror}->(node => $node, type => 'character not allowed');
1513 wakaba 1.1 }
1514     } elsif ($nt == 5) {
1515     unshift @nodes, @{$node->child_nodes};
1516     }
1517     }
1518 wakaba 1.4
1519     if ($todo->{inline}) {
1520     for (@$new_todos) {
1521     $_->{inline} = 1;
1522     }
1523     }
1524     return ($new_todos);
1525 wakaba 1.1 },
1526     };
1527    
1528     $Element->{$HTML_NS}->{ul} = {
1529 wakaba 1.10 attrs_checker => $GetHTMLAttrsChecker->({}),
1530 wakaba 1.1 checker => $Element->{$HTML_NS}->{ol}->{checker},
1531     };
1532    
1533 wakaba 1.5
1534     $Element->{$HTML_NS}->{li} = {
1535 wakaba 1.11 attrs_checker => $GetHTMLAttrsChecker->({
1536     start => sub {
1537     my ($self, $attr) = @_;
1538     my $parent = $attr->owner_element->manakai_parent_element;
1539     if (defined $parent) {
1540     my $parent_ns = $parent->namespace_uri;
1541     $parent_ns = '' unless defined $parent_ns;
1542     my $parent_ln = $parent->manakai_local_name;
1543     unless ($parent_ns eq $HTML_NS and $parent_ln eq 'ol') {
1544     $self->{onerror}->(node => $attr, type => 'attribute not supported');
1545     }
1546     }
1547     $HTMLIntegerAttrChecker->($self, $attr);
1548     },
1549     }),
1550 wakaba 1.5 checker => sub {
1551     my ($self, $todo) = @_;
1552     if ($todo->{inline}) {
1553     return $HTMLInlineChecker->($self, $todo);
1554     } else {
1555     return $HTMLBlockOrInlineChecker->($self, $todo);
1556     }
1557     },
1558     };
1559 wakaba 1.1
1560     $Element->{$HTML_NS}->{dl} = {
1561 wakaba 1.10 attrs_checker => $GetHTMLAttrsChecker->({}),
1562 wakaba 1.1 checker => sub {
1563 wakaba 1.4 my ($self, $todo) = @_;
1564     my $el = $todo->{node};
1565     my $new_todos = [];
1566 wakaba 1.1 my @nodes = (@{$el->child_nodes});
1567    
1568     my $phase = 'before dt';
1569     while (@nodes) {
1570     my $node = shift @nodes;
1571 wakaba 1.2 $self->_remove_minuses ($node) and next if ref $node eq 'HASH';
1572    
1573 wakaba 1.1 my $nt = $node->node_type;
1574     if ($nt == 1) {
1575 wakaba 1.8 my $node_ns = $node->namespace_uri;
1576     $node_ns = '' unless defined $node_ns;
1577     my $node_ln = $node->manakai_local_name;
1578 wakaba 1.2 ## NOTE: |minuses| list is not checked since redundant
1579 wakaba 1.1 if ($phase eq 'in dds') {
1580 wakaba 1.8 if ($node_ns eq $HTML_NS and $node_ln eq 'dd') {
1581 wakaba 1.1 #$phase = 'in dds';
1582 wakaba 1.8 } elsif ($node_ns eq $HTML_NS and $node_ln eq 'dt') {
1583 wakaba 1.1 $phase = 'in dts';
1584     } else {
1585 wakaba 1.2 $self->{onerror}->(node => $node, type => 'element not allowed');
1586 wakaba 1.1 }
1587     } elsif ($phase eq 'in dts') {
1588 wakaba 1.8 if ($node_ns eq $HTML_NS and $node_ln eq 'dt') {
1589 wakaba 1.1 #$phase = 'in dts';
1590 wakaba 1.8 } elsif ($node_ns eq $HTML_NS and $node_ln eq 'dd') {
1591 wakaba 1.1 $phase = 'in dds';
1592     } else {
1593 wakaba 1.2 $self->{onerror}->(node => $node, type => 'element not allowed');
1594 wakaba 1.1 }
1595     } else { # before dt
1596 wakaba 1.8 if ($node_ns eq $HTML_NS and $node_ln eq 'dt') {
1597 wakaba 1.1 $phase = 'in dts';
1598 wakaba 1.8 } elsif ($node_ns eq $HTML_NS and $node_ln eq 'dd') {
1599 wakaba 1.2 $self->{onerror}
1600 wakaba 1.3 ->(node => $node, type => 'ps element missing:dt');
1601 wakaba 1.1 $phase = 'in dds';
1602     } else {
1603 wakaba 1.2 $self->{onerror}->(node => $node, type => 'element not allowed');
1604 wakaba 1.1 }
1605     }
1606 wakaba 1.2 my ($sib, $ch) = $self->_check_get_children ($node);
1607     unshift @nodes, @$sib;
1608 wakaba 1.4 push @$new_todos, @$ch;
1609 wakaba 1.1 } elsif ($nt == 3 or $nt == 4) {
1610     if ($node->data =~ /[^\x09-\x0D\x20]/) {
1611 wakaba 1.2 $self->{onerror}->(node => $node, type => 'character not allowed');
1612 wakaba 1.1 }
1613     } elsif ($nt == 5) {
1614     unshift @nodes, @{$node->child_nodes};
1615     }
1616     }
1617     if ($phase eq 'in dts') {
1618 wakaba 1.3 $self->{onerror}->(node => $el, type => 'ps element missing:dd');
1619 wakaba 1.1 }
1620 wakaba 1.4
1621     if ($todo->{inline}) {
1622     for (@$new_todos) {
1623     $_->{inline} = 1;
1624     }
1625     }
1626     return ($new_todos);
1627 wakaba 1.1 },
1628     };
1629    
1630     $Element->{$HTML_NS}->{dt} = {
1631 wakaba 1.10 attrs_checker => $GetHTMLAttrsChecker->({}),
1632 wakaba 1.1 checker => $HTMLStrictlyInlineChecker,
1633     };
1634    
1635 wakaba 1.4 $Element->{$HTML_NS}->{dd} = {
1636 wakaba 1.10 attrs_checker => $GetHTMLAttrsChecker->({}),
1637 wakaba 1.5 checker => $Element->{$HTML_NS}->{li}->{checker},
1638 wakaba 1.4 };
1639 wakaba 1.1
1640 wakaba 1.6 $Element->{$HTML_NS}->{a} = {
1641 wakaba 1.17 attrs_checker => sub {
1642     my ($self, $todo) = @_;
1643 wakaba 1.15 my %attr;
1644 wakaba 1.17 for my $attr (@{$todo->{node}->attributes}) {
1645     my $attr_ns = $attr->namespace_uri;
1646     $attr_ns = '' unless defined $attr_ns;
1647     my $attr_ln = $attr->manakai_local_name;
1648     my $checker;
1649     if ($attr_ns eq '') {
1650     $checker = {
1651     target => $HTMLTargetAttrChecker,
1652     href => $HTMLURIAttrChecker,
1653     ping => $HTMLSpaceURIsAttrChecker,
1654 wakaba 1.20 rel => sub { $HTMLLinkTypesAttrChecker->(1, @_) },
1655 wakaba 1.17 media => $HTMLMQAttrChecker,
1656     hreflang => $HTMLLanguageTagAttrChecker,
1657     type => $HTMLIMTAttrChecker,
1658     }->{$attr_ln};
1659     if ($checker) {
1660     $attr{$attr_ln} = $attr;
1661     } else {
1662     $checker = $HTMLAttrChecker->{$attr_ln};
1663     }
1664     }
1665     $checker ||= $AttrChecker->{$attr_ns}->{$attr_ln}
1666     || $AttrChecker->{$attr_ns}->{''};
1667     if ($checker) {
1668     $checker->($self, $attr) if ref $checker;
1669     } else {
1670     $self->{onerror}->(node => $attr, type => 'attribute not supported');
1671     ## ISSUE: No comformance createria for unknown attributes in the spec
1672     }
1673     }
1674    
1675     unless (defined $attr{href}) {
1676     for (qw/target ping rel media hreflang type/) {
1677     if (defined $attr{$_}) {
1678     $self->{onerror}->(node => $attr{$_},
1679     type => 'attribute not allowed');
1680 wakaba 1.15 }
1681     }
1682 wakaba 1.17 }
1683 wakaba 1.15 },
1684 wakaba 1.6 checker => sub {
1685     my ($self, $todo) = @_;
1686    
1687     my $end = $self->_add_minuses ($HTMLInteractiveElements);
1688     my ($sib, $ch)
1689     = $HTMLSignificantInlineOrStrictlyInlineChecker->($self, $todo);
1690     push @$sib, $end;
1691     return ($sib, $ch);
1692     },
1693     };
1694 wakaba 1.1
1695 wakaba 1.4 $Element->{$HTML_NS}->{q} = {
1696 wakaba 1.11 attrs_checker => $GetHTMLAttrsChecker->({
1697     cite => $HTMLURIAttrChecker,
1698     }),
1699 wakaba 1.4 checker => $HTMLInlineOrStrictlyInlineChecker,
1700     };
1701 wakaba 1.1
1702     $Element->{$HTML_NS}->{cite} = {
1703 wakaba 1.10 attrs_checker => $GetHTMLAttrsChecker->({}),
1704 wakaba 1.1 checker => $HTMLStrictlyInlineChecker,
1705     };
1706    
1707 wakaba 1.4 $Element->{$HTML_NS}->{em} = {
1708 wakaba 1.10 attrs_checker => $GetHTMLAttrsChecker->({}),
1709 wakaba 1.4 checker => $HTMLInlineOrStrictlyInlineChecker,
1710     };
1711    
1712     $Element->{$HTML_NS}->{strong} = {
1713 wakaba 1.10 attrs_checker => $GetHTMLAttrsChecker->({}),
1714 wakaba 1.4 checker => $HTMLInlineOrStrictlyInlineChecker,
1715     };
1716 wakaba 1.1
1717 wakaba 1.4 $Element->{$HTML_NS}->{small} = {
1718 wakaba 1.10 attrs_checker => $GetHTMLAttrsChecker->({}),
1719 wakaba 1.4 checker => $HTMLInlineOrStrictlyInlineChecker,
1720     };
1721    
1722     $Element->{$HTML_NS}->{m} = {
1723 wakaba 1.10 attrs_checker => $GetHTMLAttrsChecker->({}),
1724 wakaba 1.4 checker => $HTMLInlineOrStrictlyInlineChecker,
1725     };
1726    
1727 wakaba 1.11 $Element->{$HTML_NS}->{dfn} = { ## TODO: term duplication
1728 wakaba 1.10 attrs_checker => $GetHTMLAttrsChecker->({}),
1729 wakaba 1.4 checker => sub {
1730     my ($self, $todo) = @_;
1731    
1732     my $end = $self->_add_minuses ({$HTML_NS => {dfn => 1}});
1733     my ($sib, $ch) = $HTMLStrictlyInlineChecker->($self, $todo);
1734     push @$sib, $end;
1735     return ($sib, $ch);
1736     },
1737     };
1738 wakaba 1.1
1739     $Element->{$HTML_NS}->{abbr} = {
1740 wakaba 1.11 attrs_checker => $GetHTMLAttrsChecker->({
1741     ## NOTE: |title| has special semantics for |abbr|s, but is syntactically
1742     ## not different. The spec says that the |title| MAY be omitted
1743     ## if there is a |dfn| whose defining term is the abbreviation,
1744     ## but it does not prohibit |abbr| w/o |title| in other cases.
1745     }),
1746 wakaba 1.1 checker => $HTMLStrictlyInlineChecker,
1747     };
1748    
1749 wakaba 1.11 $Element->{$HTML_NS}->{time} = { ## TODO: validate content
1750     attrs_checker => $GetHTMLAttrsChecker->({}), ## TODO: datetime
1751 wakaba 1.1 checker => $HTMLStrictlyInlineChecker,
1752     };
1753    
1754 wakaba 1.11 $Element->{$HTML_NS}->{meter} = { ## TODO: "The recommended way of giving the value is to include it as contents of the element"
1755     attrs_checker => $GetHTMLAttrsChecker->({
1756     value => $GetHTMLFloatingPointNumberAttrChecker->(sub { 1 }),
1757     min => $GetHTMLFloatingPointNumberAttrChecker->(sub { 1 }),
1758     low => $GetHTMLFloatingPointNumberAttrChecker->(sub { 1 }),
1759     high => $GetHTMLFloatingPointNumberAttrChecker->(sub { 1 }),
1760     max => $GetHTMLFloatingPointNumberAttrChecker->(sub { 1 }),
1761     optimum => $GetHTMLFloatingPointNumberAttrChecker->(sub { 1 }),
1762     }),
1763 wakaba 1.1 checker => $HTMLStrictlyInlineChecker,
1764     };
1765    
1766 wakaba 1.11 $Element->{$HTML_NS}->{progress} = { ## TODO: recommended to use content
1767     attrs_checker => $GetHTMLAttrsChecker->({
1768     value => $GetHTMLFloatingPointNumberAttrChecker->(sub { shift >= 0 }),
1769     max => $GetHTMLFloatingPointNumberAttrChecker->(sub { shift > 0 }),
1770     }),
1771 wakaba 1.1 checker => $HTMLStrictlyInlineChecker,
1772     };
1773    
1774 wakaba 1.4 $Element->{$HTML_NS}->{code} = {
1775 wakaba 1.10 attrs_checker => $GetHTMLAttrsChecker->({}),
1776 wakaba 1.12 ## NOTE: Though |title| has special semantics,
1777     ## syntatically same as the |title| as global attribute.
1778 wakaba 1.4 checker => $HTMLInlineOrStrictlyInlineChecker,
1779     };
1780 wakaba 1.1
1781     $Element->{$HTML_NS}->{var} = {
1782 wakaba 1.10 attrs_checker => $GetHTMLAttrsChecker->({}),
1783 wakaba 1.12 ## NOTE: Though |title| has special semantics,
1784     ## syntatically same as the |title| as global attribute.
1785 wakaba 1.1 checker => $HTMLStrictlyInlineChecker,
1786     };
1787    
1788 wakaba 1.4 $Element->{$HTML_NS}->{samp} = {
1789 wakaba 1.10 attrs_checker => $GetHTMLAttrsChecker->({}),
1790 wakaba 1.12 ## NOTE: Though |title| has special semantics,
1791     ## syntatically same as the |title| as global attribute.
1792 wakaba 1.4 checker => $HTMLInlineOrStrictlyInlineChecker,
1793     };
1794 wakaba 1.1
1795     $Element->{$HTML_NS}->{kbd} = {
1796 wakaba 1.10 attrs_checker => $GetHTMLAttrsChecker->({}),
1797 wakaba 1.1 checker => $HTMLStrictlyInlineChecker,
1798     };
1799    
1800     $Element->{$HTML_NS}->{sub} = {
1801 wakaba 1.10 attrs_checker => $GetHTMLAttrsChecker->({}),
1802 wakaba 1.1 checker => $HTMLStrictlyInlineChecker,
1803     };
1804    
1805     $Element->{$HTML_NS}->{sup} = {
1806 wakaba 1.10 attrs_checker => $GetHTMLAttrsChecker->({}),
1807 wakaba 1.1 checker => $HTMLStrictlyInlineChecker,
1808     };
1809    
1810 wakaba 1.4 $Element->{$HTML_NS}->{span} = {
1811 wakaba 1.10 attrs_checker => $GetHTMLAttrsChecker->({}),
1812 wakaba 1.12 ## NOTE: Though |title| has special semantics,
1813     ## syntatically same as the |title| as global attribute.
1814 wakaba 1.4 checker => $HTMLInlineOrStrictlyInlineChecker,
1815     };
1816 wakaba 1.1
1817     $Element->{$HTML_NS}->{i} = {
1818 wakaba 1.10 attrs_checker => $GetHTMLAttrsChecker->({}),
1819 wakaba 1.12 ## NOTE: Though |title| has special semantics,
1820     ## syntatically same as the |title| as global attribute.
1821 wakaba 1.1 checker => $HTMLStrictlyInlineChecker,
1822     };
1823    
1824     $Element->{$HTML_NS}->{b} = {
1825 wakaba 1.10 attrs_checker => $GetHTMLAttrsChecker->({}),
1826 wakaba 1.1 checker => $HTMLStrictlyInlineChecker,
1827     };
1828    
1829     $Element->{$HTML_NS}->{bdo} = {
1830 wakaba 1.12 attrs_checker => sub {
1831     my ($self, $todo) = @_;
1832     $GetHTMLAttrsChecker->({})->($self, $todo);
1833     unless ($todo->{node}->has_attribute_ns (undef, 'dir')) {
1834     $self->{onerror}->(node => $todo->{node}, type => 'attribute missing:dir');
1835     }
1836     },
1837     ## ISSUE: The spec does not directly say that |dir| is a enumerated attr.
1838 wakaba 1.1 checker => $HTMLStrictlyInlineChecker,
1839     };
1840    
1841     $Element->{$HTML_NS}->{ins} = {
1842 wakaba 1.12 attrs_checker => $GetHTMLAttrsChecker->({
1843     cite => $HTMLURIAttrChecker,
1844     ## TODO: datetime
1845     }),
1846 wakaba 1.1 checker => $HTMLTransparentChecker,
1847     };
1848    
1849     $Element->{$HTML_NS}->{del} = {
1850 wakaba 1.12 attrs_checker => $GetHTMLAttrsChecker->({
1851     cite => $HTMLURIAttrChecker,
1852     ## TODO: datetime
1853     }),
1854 wakaba 1.1 checker => sub {
1855 wakaba 1.4 my ($self, $todo) = @_;
1856 wakaba 1.1
1857 wakaba 1.4 my $parent = $todo->{node}->manakai_parent_element;
1858 wakaba 1.1 if (defined $parent) {
1859     my $nsuri = $parent->namespace_uri;
1860     $nsuri = '' unless defined $nsuri;
1861     my $ln = $parent->manakai_local_name;
1862     my $eldef = $Element->{$nsuri}->{$ln} ||
1863     $Element->{$nsuri}->{''} ||
1864     $ElementDefault;
1865 wakaba 1.4 return $eldef->{checker}->($self, $todo);
1866 wakaba 1.1 } else {
1867 wakaba 1.4 return $HTMLBlockOrInlineChecker->($self, $todo);
1868 wakaba 1.1 }
1869     },
1870     };
1871    
1872     ## TODO: figure
1873    
1874     $Element->{$HTML_NS}->{img} = {
1875 wakaba 1.17 attrs_checker => sub {
1876     my ($self, $todo) = @_;
1877     $GetHTMLAttrsChecker->({
1878     alt => sub { }, ## NOTE: No syntactical requirement
1879     src => $HTMLURIAttrChecker,
1880     usemap => $HTMLUsemapAttrChecker,
1881     ismap => $GetHTMLBooleanAttrChecker->('ismap'), ## TODO: MUST ancestor <a>
1882     ## TODO: height
1883     ## TODO: width
1884     })->($self, $todo);
1885     unless ($todo->{node}->has_attribute_ns (undef, 'alt')) {
1886     $self->{onerror}->(node => $todo->{node}, type => 'attribute missing:alt');
1887     }
1888     unless ($todo->{node}->has_attribute_ns (undef, 'src')) {
1889     $self->{onerror}->(node => $todo->{node}, type => 'attribute missing:src');
1890     }
1891     },
1892 wakaba 1.1 checker => $HTMLEmptyChecker,
1893     };
1894    
1895     $Element->{$HTML_NS}->{iframe} = {
1896 wakaba 1.12 attrs_checker => $GetHTMLAttrsChecker->({
1897     src => $HTMLURIAttrChecker,
1898     }),
1899 wakaba 1.1 checker => $HTMLTextChecker,
1900     };
1901    
1902     $Element->{$HTML_NS}->{embed} = {
1903 wakaba 1.16 attrs_checker => sub {
1904     my ($self, $todo) = @_;
1905     my $has_src;
1906     for my $attr (@{$todo->{node}->attributes}) {
1907     my $attr_ns = $attr->namespace_uri;
1908     $attr_ns = '' unless defined $attr_ns;
1909     my $attr_ln = $attr->manakai_local_name;
1910     my $checker;
1911     if ($attr_ns eq '') {
1912     if ($attr_ln eq 'src') {
1913     $checker = $HTMLURIAttrChecker;
1914     $has_src = 1;
1915     } elsif ($attr_ln eq 'type') {
1916     $checker = $HTMLIMTAttrChecker;
1917     } else {
1918     ## TODO: height
1919     ## TODO: width
1920     $checker = $HTMLAttrChecker->{$attr_ln}
1921     || sub { }; ## NOTE: Any local attribute is ok.
1922     }
1923     }
1924     $checker ||= $AttrChecker->{$attr_ns}->{$attr_ln}
1925     || $AttrChecker->{$attr_ns}->{''};
1926     if ($checker) {
1927     $checker->($self, $attr);
1928     } else {
1929     $self->{onerror}->(node => $attr, type => 'attribute not supported');
1930     ## ISSUE: No comformance createria for global attributes in the spec
1931     }
1932     }
1933    
1934     unless ($has_src) {
1935     $self->{onerror}->(node => $todo->{node},
1936     type => 'attribute missing:src');
1937     }
1938     },
1939 wakaba 1.1 checker => $HTMLEmptyChecker,
1940     };
1941    
1942 wakaba 1.15 $Element->{$HTML_NS}->{object} = {
1943 wakaba 1.17 attrs_checker => sub {
1944     my ($self, $todo) = @_;
1945     $GetHTMLAttrsChecker->({
1946     data => $HTMLURIAttrChecker,
1947     type => $HTMLIMTAttrChecker,
1948     usemap => $HTMLUsemapAttrChecker,
1949     ## TODO: width
1950     ## TODO: height
1951     })->($self, $todo);
1952     unless ($todo->{node}->has_attribute_ns (undef, 'data')) {
1953     unless ($todo->{node}->has_attribute_ns (undef, 'type')) {
1954     $self->{onerror}->(node => $todo->{node},
1955     type => 'attribute missing:data|type');
1956     }
1957     }
1958     },
1959 wakaba 1.15 checker => $ElementDefault->{checker}, ## TODO
1960     };
1961    
1962 wakaba 1.1 $Element->{$HTML_NS}->{param} = {
1963 wakaba 1.12 attrs_checker => sub {
1964     my ($self, $todo) = @_;
1965     $GetHTMLAttrsChecker->({
1966     name => sub { },
1967     value => sub { },
1968     })->($self, $todo);
1969     unless ($todo->{node}->has_attribute_ns (undef, 'name')) {
1970     $self->{onerror}->(node => $todo->{node},
1971     type => 'attribute missing:name');
1972     }
1973     unless ($todo->{node}->has_attribute_ns (undef, 'value')) {
1974     $self->{onerror}->(node => $todo->{node},
1975     type => 'attribute missing:value');
1976     }
1977     },
1978 wakaba 1.1 checker => $HTMLEmptyChecker,
1979     };
1980    
1981 wakaba 1.2 $Element->{$HTML_NS}->{video} = {
1982 wakaba 1.12 attrs_checker => $GetHTMLAttrsChecker->({
1983     src => $HTMLURIAttrChecker,
1984     ## TODO: start, loopstart, loopend, end
1985     ## ISSUE: they MUST be "value time offset"s. Value?
1986     ## ISSUE: loopcount has no conformance creteria
1987     autoplay => $GetHTMLBooleanAttrChecker->('autoplay'),
1988     controls => $GetHTMLBooleanAttrChecker->('controls'),
1989     }),
1990 wakaba 1.2 checker => sub {
1991 wakaba 1.4 my ($self, $todo) = @_;
1992 wakaba 1.2
1993 wakaba 1.4 if ($todo->{node}->has_attribute_ns (undef, 'src')) {
1994     return $HTMLBlockOrInlineChecker->($self, $todo);
1995 wakaba 1.2 } else {
1996     return $GetHTMLZeroOrMoreThenBlockOrInlineChecker->($HTML_NS, 'source')
1997 wakaba 1.4 ->($self, $todo);
1998 wakaba 1.2 }
1999     },
2000     };
2001    
2002     $Element->{$HTML_NS}->{audio} = {
2003 wakaba 1.12 attrs_checker => $Element->{$HTML_NS}->{video}->{attrs_checker},
2004     checker => $Element->{$HTML_NS}->{video}->{checker},
2005 wakaba 1.2 };
2006 wakaba 1.1
2007     $Element->{$HTML_NS}->{source} = {
2008 wakaba 1.17 attrs_checker => sub {
2009     my ($self, $todo) = @_;
2010     $GetHTMLAttrsChecker->({
2011     src => $HTMLURIAttrChecker,
2012     type => $HTMLIMTAttrChecker,
2013     media => $HTMLMQAttrChecker,
2014     })->($self, $todo);
2015     unless ($todo->{node}->has_attribute_ns (undef, 'src')) {
2016     $self->{onerror}->(node => $todo->{node},
2017     type => 'attribute missing:src');
2018     }
2019     },
2020 wakaba 1.1 checker => $HTMLEmptyChecker,
2021     };
2022    
2023     $Element->{$HTML_NS}->{canvas} = {
2024 wakaba 1.12 attrs_checker => $GetHTMLAttrsChecker->({
2025     height => $GetHTMLNonNegativeIntegerAttrChecker->(sub { 1 }),
2026     width => $GetHTMLNonNegativeIntegerAttrChecker->(sub { 1 }),
2027     }),
2028 wakaba 1.1 checker => $HTMLInlineChecker,
2029     };
2030    
2031     $Element->{$HTML_NS}->{map} = {
2032 wakaba 1.17 attrs_checker => $GetHTMLAttrsChecker->({
2033     id => sub {
2034     ## NOTE: same as global |id=""|, with |$self->{map}| registeration
2035     my ($self, $attr) = @_;
2036     my $value = $attr->value;
2037     if (length $value > 0) {
2038     if ($self->{id}->{$value}) {
2039     $self->{onerror}->(node => $attr, type => 'duplicate ID');
2040     } else {
2041     $self->{id}->{$value} = 1;
2042     }
2043     } else {
2044     ## NOTE: MUST contain at least one character
2045     $self->{onerror}->(node => $attr, type => 'attribute value is empty');
2046     }
2047     $self->{map}->{$value} ||= $attr;
2048     },
2049     }),
2050 wakaba 1.1 checker => $HTMLBlockChecker,
2051     };
2052    
2053     $Element->{$HTML_NS}->{area} = {
2054 wakaba 1.15 attrs_checker => sub {
2055     my ($self, $todo) = @_;
2056     my %attr;
2057     my $coords;
2058     for my $attr (@{$todo->{node}->attributes}) {
2059     my $attr_ns = $attr->namespace_uri;
2060     $attr_ns = '' unless defined $attr_ns;
2061     my $attr_ln = $attr->manakai_local_name;
2062     my $checker;
2063     if ($attr_ns eq '') {
2064     $checker = {
2065     alt => sub { },
2066     ## NOTE: |alt| value has no conformance creteria.
2067     shape => $GetHTMLEnumeratedAttrChecker->({
2068     circ => -1, circle => 1,
2069     default => 1,
2070     poly => 1, polygon => -1,
2071     rect => 1, rectangle => -1,
2072     }),
2073     coords => sub {
2074     my ($self, $attr) = @_;
2075     my $value = $attr->value;
2076     if ($value =~ /\A-?[0-9]+(?>,-?[0-9]+)*\z/) {
2077     $coords = [split /,/, $value];
2078     } else {
2079     $self->{onerror}->(node => $attr,
2080     type => 'syntax error');
2081     }
2082     },
2083 wakaba 1.17 target => $HTMLTargetAttrChecker,
2084 wakaba 1.15 href => $HTMLURIAttrChecker,
2085     ping => $HTMLSpaceURIsAttrChecker,
2086 wakaba 1.20 rel => sub { $HTMLLinkTypesAttrChecker->(1, @_) },
2087 wakaba 1.17 media => $HTMLMQAttrChecker,
2088     hreflang => $HTMLLanguageTagAttrChecker,
2089 wakaba 1.15 type => $HTMLIMTAttrChecker,
2090     }->{$attr_ln};
2091     if ($checker) {
2092     $attr{$attr_ln} = $attr;
2093     } else {
2094     $checker = $HTMLAttrChecker->{$attr_ln};
2095     }
2096     }
2097     $checker ||= $AttrChecker->{$attr_ns}->{$attr_ln}
2098     || $AttrChecker->{$attr_ns}->{''};
2099     if ($checker) {
2100     $checker->($self, $attr) if ref $checker;
2101     } else {
2102     $self->{onerror}->(node => $attr, type => 'attribute not supported');
2103     ## ISSUE: No comformance createria for unknown attributes in the spec
2104     }
2105     }
2106    
2107     if (defined $attr{href}) {
2108     unless (defined $attr{alt}) {
2109     $self->{onerror}->(node => $todo->{node},
2110     type => 'attribute missing:alt');
2111     }
2112     } else {
2113     for (qw/target ping rel media hreflang type alt/) {
2114     if (defined $attr{$_}) {
2115     $self->{onerror}->(node => $attr{$_},
2116     type => 'attribute not allowed');
2117     }
2118     }
2119     }
2120    
2121     my $shape = 'rectangle';
2122     if (defined $attr{shape}) {
2123     $shape = {
2124     circ => 'circle', circle => 'circle',
2125     default => 'default',
2126     poly => 'polygon', polygon => 'polygon',
2127     rect => 'rectangle', rectangle => 'rectangle',
2128     }->{lc $attr{shape}->value} || 'rectangle';
2129     ## TODO: ASCII lowercase?
2130     }
2131    
2132     if ($shape eq 'circle') {
2133     if (defined $attr{coords}) {
2134     if (defined $coords) {
2135     if (@$coords == 3) {
2136     if ($coords->[2] < 0) {
2137     $self->{onerror}->(node => $attr{coords},
2138     type => 'out of range:2');
2139     }
2140     } else {
2141     $self->{onerror}->(node => $attr{coords},
2142     type => 'list item number:3:'.@$coords);
2143     }
2144     } else {
2145     ## NOTE: A syntax error has been reported.
2146     }
2147     } else {
2148     $self->{onerror}->(node => $todo->{node},
2149     type => 'attribute missing:coords');
2150     }
2151     } elsif ($shape eq 'default') {
2152     if (defined $attr{coords}) {
2153     $self->{onerror}->(node => $attr{coords},
2154     type => 'attribute not allowed');
2155     }
2156     } elsif ($shape eq 'polygon') {
2157     if (defined $attr{coords}) {
2158     if (defined $coords) {
2159     if (@$coords >= 6) {
2160     unless (@$coords % 2 == 0) {
2161     $self->{onerror}->(node => $attr{coords},
2162     type => 'list item number:even:'.@$coords);
2163     }
2164     } else {
2165     $self->{onerror}->(node => $attr{coords},
2166     type => 'list item number:>=6:'.@$coords);
2167     }
2168     } else {
2169     ## NOTE: A syntax error has been reported.
2170     }
2171     } else {
2172     $self->{onerror}->(node => $todo->{node},
2173     type => 'attribute missing:coords');
2174     }
2175     } elsif ($shape eq 'rectangle') {
2176     if (defined $attr{coords}) {
2177     if (defined $coords) {
2178     if (@$coords == 4) {
2179     unless ($coords->[0] < $coords->[2]) {
2180     $self->{onerror}->(node => $attr{coords},
2181     type => 'out of range:0');
2182     }
2183     unless ($coords->[1] < $coords->[3]) {
2184     $self->{onerror}->(node => $attr{coords},
2185     type => 'out of range:1');
2186     }
2187     } else {
2188     $self->{onerror}->(node => $attr{coords},
2189     type => 'list item number:4:'.@$coords);
2190     }
2191     } else {
2192     ## NOTE: A syntax error has been reported.
2193     }
2194     } else {
2195     $self->{onerror}->(node => $todo->{node},
2196     type => 'attribute missing:coords');
2197     }
2198     }
2199     },
2200 wakaba 1.1 checker => $HTMLEmptyChecker,
2201     };
2202     ## TODO: only in map
2203    
2204     $Element->{$HTML_NS}->{table} = {
2205 wakaba 1.10 attrs_checker => $GetHTMLAttrsChecker->({}),
2206 wakaba 1.1 checker => sub {
2207 wakaba 1.4 my ($self, $todo) = @_;
2208     my $el = $todo->{node};
2209     my $new_todos = [];
2210 wakaba 1.1 my @nodes = (@{$el->child_nodes});
2211    
2212     my $phase = 'before caption';
2213     my $has_tfoot;
2214     while (@nodes) {
2215     my $node = shift @nodes;
2216 wakaba 1.2 $self->_remove_minuses ($node) and next if ref $node eq 'HASH';
2217    
2218 wakaba 1.1 my $nt = $node->node_type;
2219     if ($nt == 1) {
2220 wakaba 1.8 my $node_ns = $node->namespace_uri;
2221     $node_ns = '' unless defined $node_ns;
2222     my $node_ln = $node->manakai_local_name;
2223 wakaba 1.2 ## NOTE: |minuses| list is not checked since redundant
2224 wakaba 1.1 if ($phase eq 'in tbodys') {
2225 wakaba 1.8 if ($node_ns eq $HTML_NS and $node_ln eq 'tbody') {
2226 wakaba 1.1 #$phase = 'in tbodys';
2227     } elsif (not $has_tfoot and
2228 wakaba 1.8 $node_ns eq $HTML_NS and $node_ln eq 'tfoot') {
2229 wakaba 1.1 $phase = 'after tfoot';
2230     $has_tfoot = 1;
2231     } else {
2232 wakaba 1.2 $self->{onerror}->(node => $node, type => 'element not allowed');
2233 wakaba 1.1 }
2234     } elsif ($phase eq 'in trs') {
2235 wakaba 1.8 if ($node_ns eq $HTML_NS and $node_ln eq 'tr') {
2236 wakaba 1.1 #$phase = 'in trs';
2237     } elsif (not $has_tfoot and
2238 wakaba 1.8 $node_ns eq $HTML_NS and $node_ln eq 'tfoot') {
2239 wakaba 1.1 $phase = 'after tfoot';
2240     $has_tfoot = 1;
2241     } else {
2242 wakaba 1.2 $self->{onerror}->(node => $node, type => 'element not allowed');
2243 wakaba 1.1 }
2244     } elsif ($phase eq 'after thead') {
2245 wakaba 1.8 if ($node_ns eq $HTML_NS and $node_ln eq 'tbody') {
2246 wakaba 1.1 $phase = 'in tbodys';
2247 wakaba 1.8 } elsif ($node_ns eq $HTML_NS and $node_ln eq 'tr') {
2248 wakaba 1.1 $phase = 'in trs';
2249 wakaba 1.8 } elsif ($node_ns eq $HTML_NS and $node_ln eq 'tfoot') {
2250 wakaba 1.1 $phase = 'in tbodys';
2251     $has_tfoot = 1;
2252     } else {
2253 wakaba 1.2 $self->{onerror}->(node => $node, type => 'element not allowed');
2254 wakaba 1.1 }
2255     } elsif ($phase eq 'in colgroup') {
2256 wakaba 1.8 if ($node_ns eq $HTML_NS and $node_ln eq 'colgroup') {
2257 wakaba 1.1 $phase = 'in colgroup';
2258 wakaba 1.8 } elsif ($node_ns eq $HTML_NS and $node_ln eq 'thead') {
2259 wakaba 1.1 $phase = 'after thead';
2260 wakaba 1.8 } elsif ($node_ns eq $HTML_NS and $node_ln eq 'tbody') {
2261 wakaba 1.1 $phase = 'in tbodys';
2262 wakaba 1.8 } elsif ($node_ns eq $HTML_NS and $node_ln eq 'tr') {
2263 wakaba 1.1 $phase = 'in trs';
2264 wakaba 1.8 } elsif ($node_ns eq $HTML_NS and $node_ln eq 'tfoot') {
2265 wakaba 1.1 $phase = 'in tbodys';
2266     $has_tfoot = 1;
2267     } else {
2268 wakaba 1.2 $self->{onerror}->(node => $node, type => 'element not allowed');
2269 wakaba 1.1 }
2270     } elsif ($phase eq 'before caption') {
2271 wakaba 1.8 if ($node_ns eq $HTML_NS and $node_ln eq 'caption') {
2272 wakaba 1.1 $phase = 'in colgroup';
2273 wakaba 1.8 } elsif ($node_ns eq $HTML_NS and $node_ln eq 'colgroup') {
2274 wakaba 1.1 $phase = 'in colgroup';
2275 wakaba 1.8 } elsif ($node_ns eq $HTML_NS and $node_ln eq 'thead') {
2276 wakaba 1.1 $phase = 'after thead';
2277 wakaba 1.8 } elsif ($node_ns eq $HTML_NS and $node_ln eq 'tbody') {
2278 wakaba 1.1 $phase = 'in tbodys';
2279 wakaba 1.8 } elsif ($node_ns eq $HTML_NS and $node_ln eq 'tr') {
2280 wakaba 1.1 $phase = 'in trs';
2281 wakaba 1.8 } elsif ($node_ns eq $HTML_NS and $node_ln eq 'tfoot') {
2282 wakaba 1.1 $phase = 'in tbodys';
2283     $has_tfoot = 1;
2284     } else {
2285 wakaba 1.2 $self->{onerror}->(node => $node, type => 'element not allowed');
2286 wakaba 1.1 }
2287     } else { # after tfoot
2288 wakaba 1.2 $self->{onerror}->(node => $node, type => 'element not allowed');
2289 wakaba 1.1 }
2290 wakaba 1.2 my ($sib, $ch) = $self->_check_get_children ($node);
2291     unshift @nodes, @$sib;
2292 wakaba 1.4 push @$new_todos, @$ch;
2293 wakaba 1.1 } elsif ($nt == 3 or $nt == 4) {
2294     if ($node->data =~ /[^\x09-\x0D\x20]/) {
2295 wakaba 1.2 $self->{onerror}->(node => $node, type => 'character not allowed');
2296 wakaba 1.1 }
2297     } elsif ($nt == 5) {
2298     unshift @nodes, @{$node->child_nodes};
2299     }
2300     }
2301 wakaba 1.4 return ($new_todos);
2302 wakaba 1.1 },
2303     };
2304    
2305     $Element->{$HTML_NS}->{caption} = {
2306 wakaba 1.10 attrs_checker => $GetHTMLAttrsChecker->({}),
2307 wakaba 1.1 checker => $HTMLSignificantStrictlyInlineChecker,
2308     };
2309    
2310     $Element->{$HTML_NS}->{colgroup} = {
2311 wakaba 1.17 attrs_checker => $GetHTMLAttrsChecker->({
2312     span => $GetHTMLNonNegativeIntegerAttrChecker->(sub { shift > 0 }),
2313     ## NOTE: Defined only if "the |colgroup| element contains no |col| elements"
2314     ## TODO: "attribute not supported" if |col|.
2315     ## ISSUE: MUST NOT if any |col|?
2316     ## ISSUE: MUST NOT for |<colgroup span="1"><any><col/></any></colgroup>| (though non-conforming)?
2317     }),
2318 wakaba 1.1 checker => sub {
2319 wakaba 1.4 my ($self, $todo) = @_;
2320     my $el = $todo->{node};
2321     my $new_todos = [];
2322 wakaba 1.1 my @nodes = (@{$el->child_nodes});
2323    
2324     while (@nodes) {
2325     my $node = shift @nodes;
2326 wakaba 1.2 $self->_remove_minuses ($node) and next if ref $node eq 'HASH';
2327    
2328 wakaba 1.1 my $nt = $node->node_type;
2329     if ($nt == 1) {
2330 wakaba 1.8 my $node_ns = $node->namespace_uri;
2331     $node_ns = '' unless defined $node_ns;
2332     my $node_ln = $node->manakai_local_name;
2333 wakaba 1.2 ## NOTE: |minuses| list is not checked since redundant
2334 wakaba 1.8 unless ($node_ns eq $HTML_NS and $node_ln eq 'col') {
2335 wakaba 1.2 $self->{onerror}->(node => $node, type => 'element not allowed');
2336 wakaba 1.1 }
2337 wakaba 1.2 my ($sib, $ch) = $self->_check_get_children ($node);
2338     unshift @nodes, @$sib;
2339 wakaba 1.4 push @$new_todos, @$ch;
2340 wakaba 1.1 } elsif ($nt == 3 or $nt == 4) {
2341     if ($node->data =~ /[^\x09-\x0D\x20]/) {
2342 wakaba 1.2 $self->{onerror}->(node => $node, type => 'character not allowed');
2343 wakaba 1.1 }
2344     } elsif ($nt == 5) {
2345     unshift @nodes, @{$node->child_nodes};
2346     }
2347     }
2348 wakaba 1.4 return ($new_todos);
2349 wakaba 1.1 },
2350     };
2351    
2352     $Element->{$HTML_NS}->{col} = {
2353 wakaba 1.12 attrs_checker => $GetHTMLAttrsChecker->({
2354     span => $GetHTMLNonNegativeIntegerAttrChecker->(sub { shift > 0 }),
2355     }),
2356 wakaba 1.1 checker => $HTMLEmptyChecker,
2357     };
2358    
2359     $Element->{$HTML_NS}->{tbody} = {
2360 wakaba 1.10 attrs_checker => $GetHTMLAttrsChecker->({}),
2361 wakaba 1.1 checker => sub {
2362 wakaba 1.4 my ($self, $todo) = @_;
2363     my $el = $todo->{node};
2364     my $new_todos = [];
2365 wakaba 1.1 my @nodes = (@{$el->child_nodes});
2366    
2367     my $has_tr;
2368     while (@nodes) {
2369     my $node = shift @nodes;
2370 wakaba 1.2 $self->_remove_minuses ($node) and next if ref $node eq 'HASH';
2371    
2372 wakaba 1.1 my $nt = $node->node_type;
2373     if ($nt == 1) {
2374 wakaba 1.8 my $node_ns = $node->namespace_uri;
2375     $node_ns = '' unless defined $node_ns;
2376     my $node_ln = $node->manakai_local_name;
2377 wakaba 1.2 ## NOTE: |minuses| list is not checked since redundant
2378 wakaba 1.8 if ($node_ns eq $HTML_NS and $node_ln eq 'tr') {
2379 wakaba 1.1 $has_tr = 1;
2380     } else {
2381 wakaba 1.2 $self->{onerror}->(node => $node, type => 'element not allowed');
2382 wakaba 1.1 }
2383 wakaba 1.2 my ($sib, $ch) = $self->_check_get_children ($node);
2384     unshift @nodes, @$sib;
2385 wakaba 1.4 push @$new_todos, @$ch;
2386 wakaba 1.1 } elsif ($nt == 3 or $nt == 4) {
2387     if ($node->data =~ /[^\x09-\x0D\x20]/) {
2388 wakaba 1.2 $self->{onerror}->(node => $node, type => 'character not allowed');
2389 wakaba 1.1 }
2390     } elsif ($nt == 5) {
2391     unshift @nodes, @{$node->child_nodes};
2392     }
2393     }
2394     unless ($has_tr) {
2395 wakaba 1.3 $self->{onerror}->(node => $el, type => 'child element missing:tr');
2396 wakaba 1.1 }
2397 wakaba 1.4 return ($new_todos);
2398 wakaba 1.1 },
2399     };
2400    
2401     $Element->{$HTML_NS}->{thead} = {
2402 wakaba 1.10 attrs_checker => $GetHTMLAttrsChecker->({}),
2403 wakaba 1.1 checker => $Element->{$HTML_NS}->{tbody},
2404     };
2405    
2406     $Element->{$HTML_NS}->{tfoot} = {
2407 wakaba 1.10 attrs_checker => $GetHTMLAttrsChecker->({}),
2408 wakaba 1.1 checker => $Element->{$HTML_NS}->{tbody},
2409     };
2410    
2411     $Element->{$HTML_NS}->{tr} = {
2412 wakaba 1.10 attrs_checker => $GetHTMLAttrsChecker->({}),
2413 wakaba 1.1 checker => sub {
2414 wakaba 1.4 my ($self, $todo) = @_;
2415     my $el = $todo->{node};
2416     my $new_todos = [];
2417 wakaba 1.1 my @nodes = (@{$el->child_nodes});
2418    
2419     my $has_td;
2420     while (@nodes) {
2421     my $node = shift @nodes;
2422 wakaba 1.2 $self->_remove_minuses ($node) and next if ref $node eq 'HASH';
2423    
2424 wakaba 1.1 my $nt = $node->node_type;
2425     if ($nt == 1) {
2426 wakaba 1.8 my $node_ns = $node->namespace_uri;
2427     $node_ns = '' unless defined $node_ns;
2428     my $node_ln = $node->manakai_local_name;
2429 wakaba 1.2 ## NOTE: |minuses| list is not checked since redundant
2430 wakaba 1.8 if ($node_ns eq $HTML_NS and ($node_ln eq 'td' or $node_ln eq 'th')) {
2431 wakaba 1.1 $has_td = 1;
2432     } else {
2433 wakaba 1.2 $self->{onerror}->(node => $node, type => 'element not allowed');
2434 wakaba 1.1 }
2435 wakaba 1.2 my ($sib, $ch) = $self->_check_get_children ($node);
2436     unshift @nodes, @$sib;
2437 wakaba 1.4 push @$new_todos, @$ch;
2438 wakaba 1.1 } elsif ($nt == 3 or $nt == 4) {
2439     if ($node->data =~ /[^\x09-\x0D\x20]/) {
2440 wakaba 1.2 $self->{onerror}->(node => $node, type => 'character not allowed');
2441 wakaba 1.1 }
2442     } elsif ($nt == 5) {
2443     unshift @nodes, @{$node->child_nodes};
2444     }
2445     }
2446     unless ($has_td) {
2447 wakaba 1.3 $self->{onerror}->(node => $el, type => 'child element missing:td|th');
2448 wakaba 1.1 }
2449 wakaba 1.4 return ($new_todos);
2450 wakaba 1.1 },
2451     };
2452    
2453     $Element->{$HTML_NS}->{td} = {
2454 wakaba 1.12 attrs_checker => $GetHTMLAttrsChecker->({
2455     colspan => $GetHTMLNonNegativeIntegerAttrChecker->(sub { shift > 0 }),
2456     rowspan => $GetHTMLNonNegativeIntegerAttrChecker->(sub { shift > 0 }),
2457     }),
2458 wakaba 1.1 checker => $HTMLBlockOrInlineChecker,
2459     };
2460    
2461     $Element->{$HTML_NS}->{th} = {
2462 wakaba 1.12 attrs_checker => $GetHTMLAttrsChecker->({
2463     colspan => $GetHTMLNonNegativeIntegerAttrChecker->(sub { shift > 0 }),
2464     rowspan => $GetHTMLNonNegativeIntegerAttrChecker->(sub { shift > 0 }),
2465     scope => $GetHTMLEnumeratedAttrChecker
2466     ->({row => 1, col => 1, rowgroup => 1, colgroup => 1}),
2467     }),
2468 wakaba 1.1 checker => $HTMLBlockOrInlineChecker,
2469     };
2470    
2471 wakaba 1.12 ## TODO: table model error checking
2472    
2473 wakaba 1.1 ## TODO: forms
2474    
2475 wakaba 1.2 $Element->{$HTML_NS}->{script} = {
2476 wakaba 1.15 attrs_checker => $GetHTMLAttrsChecker->({
2477     src => $HTMLURIAttrChecker,
2478     defer => $GetHTMLBooleanAttrChecker->('defer'), ## TODO: if src ## ISSUE: no MUST NOT
2479     async => $GetHTMLBooleanAttrChecker->('async'), ## TODO: if src ## ISSUE: no MUST NOT
2480     type => $HTMLIMTAttrChecker,
2481     }),
2482 wakaba 1.2 checker => sub {
2483 wakaba 1.4 my ($self, $todo) = @_;
2484 wakaba 1.2
2485 wakaba 1.4 if ($todo->{node}->has_attribute_ns (undef, 'src')) {
2486     return $HTMLEmptyChecker->($self, $todo);
2487 wakaba 1.2 } else {
2488     ## NOTE: No content model conformance in HTML5 spec.
2489 wakaba 1.4 return $AnyChecker->($self, $todo);
2490 wakaba 1.2 }
2491     },
2492     };
2493    
2494     ## NOTE: When script is disabled.
2495     $Element->{$HTML_NS}->{noscript} = {
2496 wakaba 1.10 attrs_checker => $GetHTMLAttrsChecker->({}),
2497 wakaba 1.2 checker => sub {
2498 wakaba 1.4 my ($self, $todo) = @_;
2499 wakaba 1.1
2500 wakaba 1.2 my $end = $self->_add_minuses ({$HTML_NS => {noscript => 1}});
2501 wakaba 1.4 my ($sib, $ch) = $HTMLBlockOrInlineChecker->($self, $todo);
2502 wakaba 1.2 push @$sib, $end;
2503     return ($sib, $ch);
2504     },
2505     };
2506 wakaba 1.1
2507     $Element->{$HTML_NS}->{'event-source'} = {
2508 wakaba 1.12 attrs_checker => $GetHTMLAttrsChecker->({
2509     src => $HTMLURIAttrChecker,
2510     }),
2511 wakaba 1.1 checker => $HTMLEmptyChecker,
2512     };
2513    
2514     $Element->{$HTML_NS}->{details} = {
2515 wakaba 1.12 attrs_checker => $GetHTMLAttrsChecker->({
2516     open => $GetHTMLBooleanAttrChecker->('open'),
2517     }),
2518 wakaba 1.6 checker => sub {
2519     my ($self, $todo) = @_;
2520    
2521     my $end = $self->_add_minuses ({$HTML_NS => {a => 1, datagrid => 1}});
2522     my ($sib, $ch)
2523     = $GetHTMLZeroOrMoreThenBlockOrInlineChecker->($HTML_NS, 'legend')
2524     ->($self, $todo);
2525     push @$sib, $end;
2526     return ($sib, $ch);
2527     },
2528 wakaba 1.1 };
2529    
2530     $Element->{$HTML_NS}->{datagrid} = {
2531 wakaba 1.12 attrs_checker => $GetHTMLAttrsChecker->({
2532     disabled => $GetHTMLBooleanAttrChecker->('disabled'),
2533     multiple => $GetHTMLBooleanAttrChecker->('multiple'),
2534     }),
2535 wakaba 1.6 checker => sub {
2536     my ($self, $todo) = @_;
2537    
2538     my $end = $self->_add_minuses ({$HTML_NS => {a => 1, datagrid => 1}});
2539     my ($sib, $ch) = $HTMLBlockChecker->($self, $todo);
2540     push @$sib, $end;
2541     return ($sib, $ch);
2542     },
2543 wakaba 1.1 };
2544    
2545     $Element->{$HTML_NS}->{command} = {
2546 wakaba 1.12 attrs_checker => $GetHTMLAttrsChecker->({}), ## TODO
2547 wakaba 1.1 checker => $HTMLEmptyChecker,
2548     };
2549    
2550     $Element->{$HTML_NS}->{menu} = {
2551 wakaba 1.12 attrs_checker => $GetHTMLAttrsChecker->({}), ## TODO
2552 wakaba 1.1 checker => sub {
2553 wakaba 1.4 my ($self, $todo) = @_;
2554     my $el = $todo->{node};
2555     my $new_todos = [];
2556 wakaba 1.1 my @nodes = (@{$el->child_nodes});
2557    
2558     my $content = 'li or inline';
2559     while (@nodes) {
2560     my $node = shift @nodes;
2561 wakaba 1.2 $self->_remove_minuses ($node) and next if ref $node eq 'HASH';
2562    
2563 wakaba 1.1 my $nt = $node->node_type;
2564     if ($nt == 1) {
2565 wakaba 1.2 my $node_ns = $node->namespace_uri;
2566     $node_ns = '' unless defined $node_ns;
2567     my $node_ln = $node->manakai_local_name;
2568 wakaba 1.6 my $not_allowed = $self->{minuses}->{$node_ns}->{$node_ln};
2569 wakaba 1.8 if ($node_ns eq $HTML_NS and $node_ln eq 'li') {
2570 wakaba 1.1 if ($content eq 'inline') {
2571 wakaba 1.6 $not_allowed = 1;
2572 wakaba 1.1 } elsif ($content eq 'li or inline') {
2573     $content = 'li';
2574     }
2575     } else {
2576 wakaba 1.7 if ($HTMLStrictlyInlineLevelElements->{$node_ns}->{$node_ln} or
2577     $HTMLStructuredInlineLevelElements->{$node_ns}->{$node_ln}) {
2578     $content = 'inline';
2579     } else {
2580 wakaba 1.6 $not_allowed = 1;
2581 wakaba 1.7 }
2582 wakaba 1.1 }
2583 wakaba 1.6 $self->{onerror}->(node => $node, type => 'element not allowed')
2584     if $not_allowed;
2585 wakaba 1.2 my ($sib, $ch) = $self->_check_get_children ($node);
2586     unshift @nodes, @$sib;
2587 wakaba 1.4 push @$new_todos, @$ch;
2588 wakaba 1.1 } elsif ($nt == 3 or $nt == 4) {
2589     if ($node->data =~ /[^\x09-\x0D\x20]/) {
2590     if ($content eq 'li') {
2591 wakaba 1.2 $self->{onerror}->(node => $node, type => 'character not allowed');
2592 wakaba 1.1 } elsif ($content eq 'li or inline') {
2593     $content = 'inline';
2594     }
2595     }
2596     } elsif ($nt == 5) {
2597     unshift @nodes, @{$node->child_nodes};
2598     }
2599     }
2600 wakaba 1.4
2601     for (@$new_todos) {
2602     $_->{inline} = 1;
2603     }
2604     return ($new_todos);
2605 wakaba 1.1 },
2606     };
2607    
2608 wakaba 1.6 $Element->{$HTML_NS}->{legend} = {
2609 wakaba 1.10 attrs_checker => $GetHTMLAttrsChecker->({}),
2610 wakaba 1.6 checker => sub {
2611     my ($self, $todo) = @_;
2612    
2613     my $parent = $todo->{node}->manakai_parent_element;
2614     if (defined $parent) {
2615     my $nsuri = $parent->namespace_uri;
2616     $nsuri = '' unless defined $nsuri;
2617     my $ln = $parent->manakai_local_name;
2618     if ($nsuri eq $HTML_NS and $ln eq 'figure') {
2619     return $HTMLInlineChecker->($self, $todo);
2620     } else {
2621     return $HTMLSignificantStrictlyInlineChecker->($self, $todo);
2622     }
2623     } else {
2624     return $HTMLInlineChecker->($self, $todo);
2625     }
2626    
2627     ## ISSUE: Content model is defined only for fieldset/legend,
2628     ## details/legend, and figure/legend.
2629     },
2630     };
2631 wakaba 1.1
2632     $Element->{$HTML_NS}->{div} = {
2633 wakaba 1.10 attrs_checker => $GetHTMLAttrsChecker->({}),
2634 wakaba 1.2 checker => $GetHTMLZeroOrMoreThenBlockOrInlineChecker->($HTML_NS, 'style'),
2635 wakaba 1.1 };
2636    
2637     $Element->{$HTML_NS}->{font} = {
2638 wakaba 1.12 attrs_checker => $GetHTMLAttrsChecker->({}), ## TODO
2639 wakaba 1.1 checker => $HTMLTransparentChecker,
2640     };
2641    
2642 wakaba 1.2 sub new ($) {
2643     return bless {}, shift;
2644     } # new
2645    
2646 wakaba 1.1 sub check_element ($$$) {
2647     my ($self, $el, $onerror) = @_;
2648    
2649 wakaba 1.2 $self->{minuses} = {};
2650     $self->{onerror} = $onerror;
2651 wakaba 1.10 $self->{id} = {};
2652 wakaba 1.17 $self->{usemap} = [];
2653     $self->{map} = {};
2654 wakaba 1.20 $self->{has_link_type} = {};
2655 wakaba 1.2
2656 wakaba 1.4 my @todo = ({type => 'element', node => $el});
2657     while (@todo) {
2658     my $todo = shift @todo;
2659     if ($todo->{type} eq 'element') {
2660 wakaba 1.13 my $prefix = $todo->{node}->prefix;
2661     if (defined $prefix and $prefix eq 'xmlns') {
2662     $self->{onerror}
2663     ->(node => $todo->{node},
2664     type => 'NC:Reserved Prefixes and Namespace Names:<xmlns:>');
2665     }
2666 wakaba 1.4 my $nsuri = $todo->{node}->namespace_uri;
2667     $nsuri = '' unless defined $nsuri;
2668     my $ln = $todo->{node}->manakai_local_name;
2669     my $eldef = $Element->{$nsuri}->{$ln} ||
2670     $Element->{$nsuri}->{''} ||
2671     $ElementDefault;
2672 wakaba 1.9 $eldef->{attrs_checker}->($self, $todo);
2673 wakaba 1.4 my ($new_todos) = $eldef->{checker}->($self, $todo);
2674 wakaba 1.14 unshift @todo, @$new_todos;
2675 wakaba 1.9 } elsif ($todo->{type} eq 'element-attributes') {
2676 wakaba 1.13 my $prefix = $todo->{node}->prefix;
2677     if (defined $prefix and $prefix eq 'xmlns') {
2678     $self->{onerror}
2679     ->(node => $todo->{node},
2680     type => 'NC:Reserved Prefixes and Namespace Names:<xmlns:>');
2681     }
2682 wakaba 1.9 my $nsuri = $todo->{node}->namespace_uri;
2683     $nsuri = '' unless defined $nsuri;
2684     my $ln = $todo->{node}->manakai_local_name;
2685     my $eldef = $Element->{$nsuri}->{$ln} ||
2686     $Element->{$nsuri}->{''} ||
2687     $ElementDefault;
2688     $eldef->{attrs_checker}->($self, $todo);
2689 wakaba 1.4 } elsif ($todo->{type} eq 'plus') {
2690     $self->_remove_minuses ($todo);
2691     }
2692 wakaba 1.1 }
2693 wakaba 1.17
2694     for (@{$self->{usemap}}) {
2695     unless ($self->{map}->{$_->[0]}) {
2696     $self->{onerror}->(node => $_->[1], type => 'no referenced map');
2697     }
2698     }
2699    
2700     delete $self->{minuses};
2701     delete $self->{onerror};
2702     delete $self->{id};
2703     delete $self->{usemap};
2704     delete $self->{map};
2705 wakaba 1.1 } # check_element
2706    
2707 wakaba 1.2 sub _add_minuses ($@) {
2708     my $self = shift;
2709     my $r = {};
2710     for my $list (@_) {
2711     for my $ns (keys %$list) {
2712     for my $ln (keys %{$list->{$ns}}) {
2713     unless ($self->{minuses}->{$ns}->{$ln}) {
2714     $self->{minuses}->{$ns}->{$ln} = 1;
2715     $r->{$ns}->{$ln} = 1;
2716     }
2717     }
2718     }
2719     }
2720 wakaba 1.4 return {type => 'plus', list => $r};
2721 wakaba 1.2 } # _add_minuses
2722    
2723     sub _remove_minuses ($$) {
2724 wakaba 1.4 my ($self, $todo) = @_;
2725     for my $ns (keys %{$todo->{list}}) {
2726     for my $ln (keys %{$todo->{list}->{$ns}}) {
2727     delete $self->{minuses}->{$ns}->{$ln} if $todo->{list}->{$ns}->{$ln};
2728 wakaba 1.2 }
2729     }
2730     1;
2731     } # _remove_minuses
2732    
2733     sub _check_get_children ($$) {
2734     my ($self, $node) = @_;
2735 wakaba 1.4 my $new_todos = [];
2736 wakaba 1.2 my $sib = [];
2737     TP: {
2738     my $node_ns = $node->namespace_uri;
2739     $node_ns = '' unless defined $node_ns;
2740     my $node_ln = $node->manakai_local_name;
2741     if ($node_ns eq $HTML_NS) {
2742     if ($node_ln eq 'noscript') {
2743     my $end = $self->_add_minuses ({$HTML_NS, {noscript => 1}});
2744     push @$sib, $end;
2745     }
2746     }
2747 wakaba 1.7 if ($HTMLTransparentElements->{$node_ns}->{$node_ln}) {
2748     unshift @$sib, @{$node->child_nodes};
2749 wakaba 1.9 push @$new_todos, {type => 'element-attributes', node => $node};
2750 wakaba 1.7 last TP;
2751 wakaba 1.2 }
2752 wakaba 1.8 if ($node_ns eq $HTML_NS and ($node_ln eq 'video' or $node_ln eq 'audio')) {
2753 wakaba 1.2 if ($node->has_attribute_ns (undef, 'src')) {
2754     unshift @$sib, @{$node->child_nodes};
2755 wakaba 1.9 push @$new_todos, {type => 'element-attributes', node => $node};
2756 wakaba 1.2 last TP;
2757     } else {
2758     my @cn = @{$node->child_nodes};
2759     CN: while (@cn) {
2760     my $cn = shift @cn;
2761     my $cnt = $cn->node_type;
2762     if ($cnt == 1) {
2763 wakaba 1.8 my $cn_nsuri = $cn->namespace_uri;
2764     $cn_nsuri = '' unless defined $cn_nsuri;
2765     if ($cn_nsuri eq $HTML_NS and $cn->manakai_local_name eq 'source') {
2766 wakaba 1.2 #
2767     } else {
2768     last CN;
2769     }
2770     } elsif ($cnt == 3 or $cnt == 4) {
2771     if ($cn->data =~ /[^\x09-\x0D\x20]/) {
2772     last CN;
2773     }
2774     }
2775     } # CN
2776     unshift @$sib, @cn;
2777     }
2778     }
2779 wakaba 1.4 push @$new_todos, {type => 'element', node => $node};
2780 wakaba 1.2 } # TP
2781 wakaba 1.4 return ($sib, $new_todos);
2782 wakaba 1.2 } # _check_get_children
2783    
2784 wakaba 1.1 1;
2785 wakaba 1.20 # $Date: 2007/05/26 08:12:34 $

[email protected]
ViewVC Help
Powered by ViewVC 1.1.24