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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.29 - (hide annotations) (download)
Sun Feb 17 06:36:28 2008 UTC (18 years, 7 months ago) by wakaba
Branch: MAIN
Changes since 1.28: +414 -227 lines
++ whatpm/t/ChangeLog	17 Feb 2008 06:35:24 -0000
2008-02-17  Wakaba  <wakaba@suika.fam.cx>

	* content-model-1.dat, content-model-2.dat, content-model-5.dat:
	Test results are updated; new tests are added.

++ whatpm/Whatpm/ChangeLog	17 Feb 2008 06:34:11 -0000
2008-02-17  Wakaba  <wakaba@suika.fam.cx>

	* ContenteChecker.pm ($HTMLTransparentElements): More
	elements are added.
	(_get_children): HTML |object| elements are now semi-transparent.

	* NanoDOM.pm (manakai_html, manakai_head): New methods.

++ whatpm/Whatpm/ContentChecker/ChangeLog	17 Feb 2008 06:32:44 -0000
2008-02-17  Wakaba  <wakaba@suika.fam.cx>

	* HTML.pm: Most part of December 2007 Content Model is implemented.

1 wakaba 1.1 package Whatpm::ContentChecker;
2     use strict;
3     require Whatpm::ContentChecker;
4    
5     my $HTML_NS = q<http://www.w3.org/1999/xhtml>;
6    
7 wakaba 1.29 ## December 2007 HTML5 Classification
8    
9     my $HTMLMetadataContent = {
10     $HTML_NS => {
11     title => 1, base => 1, link => 1, style => 1, script => 1, noscript => 1,
12     'event-source' => 1, command => 1, datatemplate => 1,
13     ## NOTE: A |meta| with no |name| element is not allowed as
14     ## a metadata content other than |head| element.
15     meta => 1,
16     },
17     ## NOTE: RDF is mentioned in the HTML5 spec.
18     ## TODO: Other RDF elements?
19     q<http://www.w3.org/1999/02/22-rdf-syntax-ns#> => {RDF => 1},
20     };
21    
22     my $HTMLProseContent = {
23     $HTML_NS => {
24     section => 1, nav => 1, article => 1, blockquote => 1, aside => 1,
25     h1 => 1, h2 => 1, h3 => 1, h4 => 1, h5 => 1, h6 => 1, header => 1,
26     footer => 1, address => 1, p => 1, hr => 1, dialog => 1, pre => 1,
27     ol => 1, ul => 1, dl => 1, figure => 1, map => 1, table => 1,
28     details => 1, ## ISSUE: "Prose element" in spec.
29     datagrid => 1, ## ISSUE: "Prose element" in spec.
30     datatemplate => 1,
31     div => 1, ## ISSUE: No category in spec.
32     ## NOTE: |style| is only allowed if |scoped| attribute is specified.
33     ## Additionally, it must be before any other element or
34     ## non-inter-element-whitespace text node.
35     style => 1,
36    
37     br => 1, q => 1, cite => 1, em => 1, strong => 1, small => 1, m => 1,
38     dfn => 1, abbr => 1, time => 1, progress => 1, meter => 1, code => 1,
39     var => 1, samp => 1, kbd => 1, sub => 1, sup => 1, span => 1, i => 1,
40     b => 1, bdo => 1, script => 1, noscript => 1, 'event-source' => 1,
41     command => 1, font => 1,
42     a => 1,
43     datagrid => 1, ## ISSUE: "Interactive element" in the spec.
44     ## NOTE: |area| is allowed only as a descendant of |map|.
45     area => 1,
46    
47     ins => 1, del => 1,
48    
49     ## NOTE: If there is a |menu| ancestor, phrasing. Otherwise, prose.
50     menu => 1,
51    
52     img => 1, iframe => 1, embed => 1, object => 1, video => 1, audio => 1,
53     canvas => 1,
54     },
55    
56     ## NOTE: Embedded
57     q<http://www.w3.org/1998/Math/MathML> => {math => 1},
58     q<http://www.w3.org/2000/svg> => {svg => 1},
59     };
60    
61     my $HTMLSectioningContent = {
62     $HTML_NS => {
63     section => 1, nav => 1, article => 1, blockquote => 1, aside => 1,
64     ## NOTE: |body| is only allowed in |html| element.
65     body => 1,
66     },
67     };
68    
69     my $HTMLHeadingContent = {
70     $HTML_NS => {
71     h1 => 1, h2 => 1, h3 => 1, h4 => 1, h5 => 1, h6 => 1, header => 1,
72     },
73     };
74    
75     my $HTMLPhrasingContent = {
76     ## NOTE: All phrasing content is also prose content.
77     $HTML_NS => {
78     br => 1, q => 1, cite => 1, em => 1, strong => 1, small => 1, m => 1,
79     dfn => 1, abbr => 1, time => 1, progress => 1, meter => 1, code => 1,
80     var => 1, samp => 1, kbd => 1, sub => 1, sup => 1, span => 1, i => 1,
81     b => 1, bdo => 1, script => 1, noscript => 1, 'event-source' => 1,
82     command => 1, font => 1,
83     a => 1,
84     datagrid => 1, ## ISSUE: "Interactive element" in the spec.
85     ## NOTE: |area| is allowed only as a descendant of |map|.
86     area => 1,
87    
88     ## NOTE: Transparent.
89     ins => 1, del => 1,
90    
91     ## NOTE: If there is a |menu| ancestor, phrasing. Otherwise, prose.
92     menu => 1,
93    
94     img => 1, iframe => 1, embed => 1, object => 1, video => 1, audio => 1,
95     canvas => 1,
96     },
97    
98     ## NOTE: Embedded
99     q<http://www.w3.org/1998/Math/MathML> => {math => 1},
100     q<http://www.w3.org/2000/svg> => {svg => 1},
101    
102     ## NOTE: And non-inter-element-whitespace text nodes.
103     };
104    
105     my $HTMLEmbeddedContent = {
106     ## NOTE: All embedded content is also phrasing content.
107     $HTML_NS => {
108     img => 1, iframe => 1, embed => 1, object => 1, video => 1, audio => 1,
109     canvas => 1,
110     },
111     ## NOTE: MathML is mentioned in the HTML5 spec.
112     q<http://www.w3.org/1998/Math/MathML> => {math => 1},
113     ## NOTE: SVG is mentioned in the HTML5 spec.
114     q<http://www.w3.org/2000/svg> => {svg => 1},
115     ## NOTE: Foreign elements with content (but no metadata) are
116     ## embedded content.
117     };
118    
119     my $HTMLInteractiveContent = {
120     $HTML_NS => {
121     a => 1,
122     },
123     };
124    
125     ## Old HTML5 categories
126    
127 wakaba 1.1 my $HTMLMetadataElements = {
128     $HTML_NS => {
129     qw/link 1 meta 1 style 1 script 1 event-source 1 command 1 base 1 title 1
130 wakaba 1.8 noscript 1 datatemplate 1
131 wakaba 1.1 /,
132     },
133     };
134    
135     my $HTMLSectioningElements = {
136     $HTML_NS => {qw/body 1 section 1 nav 1 article 1 blockquote 1 aside 1/},
137     };
138    
139     my $HTMLBlockLevelElements = {
140     $HTML_NS => {
141     qw/
142     section 1 nav 1 article 1 blockquote 1 aside 1
143     h1 1 h2 1 h3 1 h4 1 h5 1 h6 1 header 1 footer 1
144     address 1 p 1 hr 1 dialog 1 pre 1 ol 1 ul 1 dl 1
145     ins 1 del 1 figure 1 map 1 table 1 script 1 noscript 1
146     event-source 1 details 1 datagrid 1 menu 1 div 1 font 1
147 wakaba 1.8 datatemplate 1
148 wakaba 1.1 /,
149     },
150     };
151    
152     my $HTMLStrictlyInlineLevelElements = {
153     $HTML_NS => {
154     qw/
155     br 1 a 1 q 1 cite 1 em 1 strong 1 small 1 m 1 dfn 1 abbr 1
156     time 1 meter 1 progress 1 code 1 var 1 samp 1 kbd 1
157     sub 1 sup 1 span 1 i 1 b 1 bdo 1 ins 1 del 1 img 1
158     iframe 1 embed 1 object 1 video 1 audio 1 canvas 1 area 1
159     script 1 noscript 1 event-source 1 command 1 font 1
160     /,
161     },
162     };
163    
164     my $HTMLStructuredInlineLevelElements = {
165     $HTML_NS => {qw/blockquote 1 pre 1 ol 1 ul 1 dl 1 table 1 menu 1/},
166     };
167    
168     my $HTMLInteractiveElements = {
169     $HTML_NS => {a => 1, details => 1, datagrid => 1},
170     };
171     ## NOTE: |html:a| and |html:datagrid| are not allowed as a descendant
172     ## of interactive elements
173    
174     # my $HTMLTransparentElements : in |Whatpm/ContentChecker.pm|.
175    
176     #my $HTMLSemiTransparentElements = {
177     # $HTML_NS => {qw/video 1 audio 1/},
178     #};
179    
180     my $HTMLEmbededElements = {
181     $HTML_NS => {qw/img 1 iframe 1 embed 1 object 1 video 1 audio 1 canvas 1/},
182     };
183 wakaba 1.25 ## NOTE: When an element is added to this list, make sure that
184     ## the element's checker set |has_descendant| flag for |significant| content
185     ## as true.
186    
187 wakaba 1.26 my $HTMLSignificantContentErrors = {
188     significant => sub {
189     my ($self, $todo) = @_;
190     $self->{onerror}->(node => $todo->{node},
191     level => $self->{should_level},
192     type => 'no significant content');
193     },
194     }; # $HTMLSignificantContentErrors
195    
196 wakaba 1.29 ## TODO:
197    
198     =pod
199    
200     As a general rule, elements whose content model allows any
201     + <span>prose content</span> should have either at least one
202     + descendant text node that is not <span>inter-element
203     + whitespace</span>, or at least one descendant element node that is
204     + <span>embedded content</span>. For the purposes of this requirement,
205     + <code>del</code> elements and their descendants must not be
206     + counted as contributing to the ancestors of the <code>del</code>
207     + element.
208    
209     =cut
210    
211 wakaba 1.25 our $AnyChecker;
212     my $HTMLAnyChecker = sub {
213     my ($self, $todo) = @_;
214    
215     my $old_values = {significant =>
216     $todo->{flag}->{has_descendant}->{significant}};
217     $todo->{flag}->{has_descendant}->{significant} = 0;
218    
219     my ($new_todos) = $AnyChecker->($self, $todo);
220    
221     push @$new_todos, {
222     type => 'descendant', node => $todo->{node}, flag => $todo->{flag},
223     old_values => $old_values,
224 wakaba 1.26 errors => $HTMLSignificantContentErrors,
225 wakaba 1.25 };
226    
227     return ($new_todos);
228     }; # $HTMLAnyChecker
229 wakaba 1.1
230     ## Empty
231     my $HTMLEmptyChecker = sub {
232     my ($self, $todo) = @_;
233     my $el = $todo->{node};
234     my $new_todos = [];
235     my @nodes = (@{$el->child_nodes});
236    
237     while (@nodes) {
238     my $node = shift @nodes;
239     $self->_remove_minuses ($node) and next if ref $node eq 'HASH';
240    
241     my $nt = $node->node_type;
242     if ($nt == 1) {
243 wakaba 1.8 my $node_ns = $node->namespace_uri;
244     $node_ns = '' unless defined $node_ns;
245     my $node_ln = $node->manakai_local_name;
246     if ($self->{pluses}->{$node_ns}->{$node_ln}) {
247     #
248     } else {
249     ## NOTE: |minuses| list is not checked since redundant
250     $self->{onerror}->(node => $node, type => 'element not allowed');
251     }
252 wakaba 1.1 my ($sib, $ch) = $self->_check_get_children ($node, $todo);
253     unshift @nodes, @$sib;
254     push @$new_todos, @$ch;
255     } elsif ($nt == 3 or $nt == 4) {
256     if ($node->data =~ /[^\x09-\x0D\x20]/) {
257     $self->{onerror}->(node => $node, type => 'character not allowed');
258 wakaba 1.25 $todo->{flag}->{has_descendant}->{significant} = 1;
259 wakaba 1.1 }
260     } elsif ($nt == 5) {
261     unshift @nodes, @{$node->child_nodes};
262     }
263     }
264     return ($new_todos);
265     };
266    
267     ## Text
268     my $HTMLTextChecker = sub {
269     my ($self, $todo) = @_;
270     my $el = $todo->{node};
271     my $new_todos = [];
272     my @nodes = (@{$el->child_nodes});
273    
274 wakaba 1.25 my $old_values = {significant =>
275     $todo->{flag}->{has_descendant}->{significant}};
276     $todo->{flag}->{has_descendant}->{significant} = 0;
277    
278 wakaba 1.1 while (@nodes) {
279     my $node = shift @nodes;
280     $self->_remove_minuses ($node) and next if ref $node eq 'HASH';
281    
282     my $nt = $node->node_type;
283     if ($nt == 1) {
284 wakaba 1.8 my $node_ns = $node->namespace_uri;
285     $node_ns = '' unless defined $node_ns;
286     my $node_ln = $node->manakai_local_name;
287     if ($self->{pluses}->{$node_ns}->{$node_ln}) {
288     #
289     } else {
290     ## NOTE: |minuses| list is not checked since redundant
291     $self->{onerror}->(node => $node, type => 'element not allowed');
292     }
293 wakaba 1.1 my ($sib, $ch) = $self->_check_get_children ($node, $todo);
294     unshift @nodes, @$sib;
295     push @$new_todos, @$ch;
296 wakaba 1.25 } elsif ($nt == 3 or $nt == 4) {
297     if ($node->data =~ /[^\x09-\x0D\x20]/) {
298     $todo->{flag}->{has_descendant}->{significant} = 1;
299     }
300 wakaba 1.1 } elsif ($nt == 5) {
301     unshift @nodes, @{$node->child_nodes};
302     }
303     }
304 wakaba 1.25
305     push @$new_todos, {
306     type => 'descendant', node => $todo->{node}, flag => $todo->{flag},
307     old_values => $old_values,
308 wakaba 1.26 errors => $HTMLSignificantContentErrors,
309 wakaba 1.25 };
310    
311 wakaba 1.1 return ($new_todos);
312     };
313    
314     ## Zero or more |html:style| elements,
315     ## followed by zero or more block-level elements
316     my $HTMLStylableBlockChecker = sub {
317     my ($self, $todo) = @_;
318     my $el = $todo->{node};
319     my $new_todos = [];
320     my @nodes = (@{$el->child_nodes});
321 wakaba 1.25
322     my $old_values = {significant =>
323     $todo->{flag}->{has_descendant}->{significant}};
324     $todo->{flag}->{has_descendant}->{significant} = 0;
325 wakaba 1.1
326     my $has_non_style;
327     while (@nodes) {
328     my $node = shift @nodes;
329     $self->_remove_minuses ($node) and next if ref $node eq 'HASH';
330    
331     my $nt = $node->node_type;
332     if ($nt == 1) {
333     my $node_ns = $node->namespace_uri;
334     $node_ns = '' unless defined $node_ns;
335     my $node_ln = $node->manakai_local_name;
336     my $not_allowed = $self->{minuses}->{$node_ns}->{$node_ln};
337     if ($node_ns eq $HTML_NS and $node_ln eq 'style') {
338     $not_allowed = 1 if $has_non_style or
339     not $node->has_attribute_ns (undef, 'scoped');
340     } elsif ($HTMLBlockLevelElements->{$node_ns}->{$node_ln}) {
341     $has_non_style = 1;
342 wakaba 1.8 } elsif ($self->{pluses}->{$node_ns}->{$node_ln}) {
343     #
344 wakaba 1.1 } else {
345     $has_non_style = 1;
346     $not_allowed = 1;
347     }
348     $self->{onerror}->(node => $node, type => 'element not allowed')
349     if $not_allowed;
350     my ($sib, $ch) = $self->_check_get_children ($node, $todo);
351     unshift @nodes, @$sib;
352     push @$new_todos, @$ch;
353     } elsif ($nt == 3 or $nt == 4) {
354     if ($node->data =~ /[^\x09-\x0D\x20]/) {
355     $self->{onerror}->(node => $node, type => 'character not allowed');
356 wakaba 1.25 $todo->{flag}->{has_descendant}->{significant} = 1;
357 wakaba 1.1 }
358     } elsif ($nt == 5) {
359     unshift @nodes, @{$node->child_nodes};
360     }
361     }
362 wakaba 1.25
363     push @$new_todos, {
364     type => 'descendant', node => $todo->{node}, flag => $todo->{flag},
365     old_values => $old_values,
366 wakaba 1.26 errors => $HTMLSignificantContentErrors,
367 wakaba 1.25 };
368    
369 wakaba 1.1 return ($new_todos);
370     }; # $HTMLStylableBlockChecker
371    
372 wakaba 1.29 my $HTMLProseContentChecker = sub {
373     my ($self, $todo) = @_;
374     my $el = $todo->{node};
375     my $new_todos = [];
376     my @nodes = (@{$el->child_nodes});
377    
378     my $old_values = {significant =>
379     $todo->{flag}->{has_descendant}->{significant}};
380     $todo->{flag}->{has_descendant}->{significant} = 0;
381    
382     my $has_non_style;
383     while (@nodes) {
384     my $node = shift @nodes;
385     $self->_remove_minuses ($node) and next if ref $node eq 'HASH';
386    
387     my $nt = $node->node_type;
388     if ($nt == 1) {
389     my $node_ns = $node->namespace_uri;
390     $node_ns = '' unless defined $node_ns;
391     my $node_ln = $node->manakai_local_name;
392     my $not_allowed = $self->{minuses}->{$node_ns}->{$node_ln};
393     if ($node_ns eq $HTML_NS and $node_ln eq 'style') {
394     $not_allowed = 2 if $has_non_style or
395     not $node->has_attribute_ns (undef, 'scoped');
396     } elsif ($HTMLProseContent->{$node_ns}->{$node_ln}) {
397     $has_non_style = 1;
398     if ($HTMLEmbeddedContent->{$node_ns}->{$node_ln}) {
399     $todo->{flag}->{has_descendant}->{significant} = 1;
400     }
401     } elsif ($self->{pluses}->{$node_ns}->{$node_ln}) {
402     #
403     } else {
404     $has_non_style = 1;
405     $not_allowed = 1;
406     }
407     if ($not_allowed) {
408     if ($not_allowed == 2) {
409     $self->{onerror}->(node => $node,
410     type => 'element not allowed:prose style')
411     } else {
412     $self->{onerror}->(node => $node,
413     type => 'element not allowed:prose')
414     }
415     }
416     my ($sib, $ch) = $self->_check_get_children ($node, $todo);
417     unshift @nodes, @$sib;
418     push @$new_todos, @$ch;
419     } elsif ($nt == 3 or $nt == 4) {
420     if ($node->data =~ /[^\x09-\x0D\x20]/) {
421     $has_non_style = 1;
422     $todo->{flag}->{has_descendant}->{significant} = 1;
423     }
424     } elsif ($nt == 5) {
425     unshift @nodes, @{$node->child_nodes};
426     }
427     }
428    
429     push @$new_todos, {
430     type => 'descendant', node => $todo->{node}, flag => $todo->{flag},
431     old_values => $old_values,
432     errors => $HTMLSignificantContentErrors,
433     };
434    
435     return ($new_todos);
436     }; # $HTMLProseContentChecker
437    
438 wakaba 1.1 ## Zero or more block-level elements
439     my $HTMLBlockChecker = sub {
440     my ($self, $todo) = @_;
441     my $el = $todo->{node};
442     my $new_todos = [];
443     my @nodes = (@{$el->child_nodes});
444    
445 wakaba 1.25 my $old_values = {significant =>
446     $todo->{flag}->{has_descendant}->{significant}};
447     $todo->{flag}->{has_descendant}->{significant} = 0;
448    
449 wakaba 1.1 while (@nodes) {
450     my $node = shift @nodes;
451     $self->_remove_minuses ($node) and next if ref $node eq 'HASH';
452    
453     my $nt = $node->node_type;
454     if ($nt == 1) {
455     my $node_ns = $node->namespace_uri;
456     $node_ns = '' unless defined $node_ns;
457     my $node_ln = $node->manakai_local_name;
458     my $not_allowed = $self->{minuses}->{$node_ns}->{$node_ln};
459     $not_allowed = 1
460 wakaba 1.8 unless $HTMLBlockLevelElements->{$node_ns}->{$node_ln} or
461     $self->{pluses}->{$node_ns}->{$node_ln};
462 wakaba 1.1 $self->{onerror}->(node => $node, type => 'element not allowed')
463     if $not_allowed;
464     my ($sib, $ch) = $self->_check_get_children ($node, $todo);
465     unshift @nodes, @$sib;
466     push @$new_todos, @$ch;
467     } elsif ($nt == 3 or $nt == 4) {
468     if ($node->data =~ /[^\x09-\x0D\x20]/) {
469     $self->{onerror}->(node => $node, type => 'character not allowed');
470 wakaba 1.25 $todo->{flag}->{has_descendant}->{significant} = 1;
471 wakaba 1.1 }
472     } elsif ($nt == 5) {
473     unshift @nodes, @{$node->child_nodes};
474     }
475     }
476 wakaba 1.25
477     push @$new_todos, {
478     type => 'descendant', node => $todo->{node}, flag => $todo->{flag},
479     old_values => $old_values,
480 wakaba 1.26 errors => $HTMLSignificantContentErrors,
481 wakaba 1.25 };
482    
483 wakaba 1.1 return ($new_todos);
484     }; # $HTMLBlockChecker
485    
486     ## Inline-level content
487     my $HTMLInlineChecker = sub {
488     my ($self, $todo) = @_;
489     my $el = $todo->{node};
490     my $new_todos = [];
491     my @nodes = (@{$el->child_nodes});
492    
493 wakaba 1.25 my $old_values = {significant =>
494     $todo->{flag}->{has_descendant}->{significant}};
495     $todo->{flag}->{has_descendant}->{significant} = 0;
496    
497 wakaba 1.1 while (@nodes) {
498     my $node = shift @nodes;
499     $self->_remove_minuses ($node) and next if ref $node eq 'HASH';
500    
501     my $nt = $node->node_type;
502     if ($nt == 1) {
503     my $node_ns = $node->namespace_uri;
504     $node_ns = '' unless defined $node_ns;
505     my $node_ln = $node->manakai_local_name;
506     my $not_allowed = $self->{minuses}->{$node_ns}->{$node_ln};
507     $not_allowed = 1
508     unless $HTMLStrictlyInlineLevelElements->{$node_ns}->{$node_ln} or
509 wakaba 1.8 $HTMLStructuredInlineLevelElements->{$node_ns}->{$node_ln} or
510     $self->{pluses}->{$node_ns}->{$node_ln};
511 wakaba 1.1 $self->{onerror}->(node => $node, type => 'element not allowed')
512     if $not_allowed;
513     my ($sib, $ch) = $self->_check_get_children ($node, $todo);
514     unshift @nodes, @$sib;
515     push @$new_todos, @$ch;
516 wakaba 1.25 } elsif ($nt == 3 or $nt == 4) {
517     if ($node->data =~ /[^\x09-\x0D\x20]/) {
518     $todo->{flag}->{has_descendant}->{significant} = 1;
519     }
520 wakaba 1.1 } elsif ($nt == 5) {
521     unshift @nodes, @{$node->child_nodes};
522     }
523     }
524    
525     for (@$new_todos) {
526     $_->{inline} = 1;
527     }
528 wakaba 1.25
529     push @$new_todos, {
530     type => 'descendant', node => $todo->{node}, flag => $todo->{flag},
531     old_values => $old_values,
532 wakaba 1.26 errors => $HTMLSignificantContentErrors,
533 wakaba 1.25 };
534    
535 wakaba 1.1 return ($new_todos);
536     }; # $HTMLInlineChecker
537    
538     ## Strictly inline-level content
539     my $HTMLStrictlyInlineChecker = sub {
540     my ($self, $todo) = @_;
541     my $el = $todo->{node};
542     my $new_todos = [];
543     my @nodes = (@{$el->child_nodes});
544 wakaba 1.25
545     my $old_values = {significant =>
546     $todo->{flag}->{has_descendant}->{significant}};
547     $todo->{flag}->{has_descendant}->{significant} = 0;
548 wakaba 1.1
549     while (@nodes) {
550     my $node = shift @nodes;
551     $self->_remove_minuses ($node) and next if ref $node eq 'HASH';
552    
553     my $nt = $node->node_type;
554     if ($nt == 1) {
555     my $node_ns = $node->namespace_uri;
556     $node_ns = '' unless defined $node_ns;
557     my $node_ln = $node->manakai_local_name;
558     my $not_allowed = $self->{minuses}->{$node_ns}->{$node_ln};
559     $not_allowed = 1
560 wakaba 1.8 unless $HTMLStrictlyInlineLevelElements->{$node_ns}->{$node_ln} or
561     $self->{pluses}->{$node_ns}->{$node_ln};
562 wakaba 1.1 $self->{onerror}->(node => $node, type => 'element not allowed')
563     if $not_allowed;
564     my ($sib, $ch) = $self->_check_get_children ($node, $todo);
565     unshift @nodes, @$sib;
566     push @$new_todos, @$ch;
567 wakaba 1.25 } elsif ($nt == 3 or $nt == 4) {
568     if ($node->data =~ /[^\x09-\x0D\x20]/) {
569     $todo->{flag}->{has_descendant}->{significant} = 1;
570     }
571 wakaba 1.1 } elsif ($nt == 5) {
572     unshift @nodes, @{$node->child_nodes};
573     }
574     }
575    
576     for (@$new_todos) {
577     $_->{inline} = 1;
578     $_->{strictly_inline} = 1;
579     }
580 wakaba 1.25
581     push @$new_todos, {
582     type => 'descendant', node => $todo->{node}, flag => $todo->{flag},
583     old_values => $old_values,
584 wakaba 1.26 errors => $HTMLSignificantContentErrors,
585 wakaba 1.25 };
586    
587 wakaba 1.1 return ($new_todos);
588     }; # $HTMLStrictlyInlineChecker
589    
590 wakaba 1.8 ## Inline-level or strictly inline-level content
591 wakaba 1.1 my $HTMLInlineOrStrictlyInlineChecker = sub {
592     my ($self, $todo) = @_;
593     my $el = $todo->{node};
594     my $new_todos = [];
595     my @nodes = (@{$el->child_nodes});
596 wakaba 1.25
597     my $old_values = {significant =>
598     $todo->{flag}->{has_descendant}->{significant}};
599     $todo->{flag}->{has_descendant}->{significant} = 0;
600 wakaba 1.1
601     while (@nodes) {
602     my $node = shift @nodes;
603     $self->_remove_minuses ($node) and next if ref $node eq 'HASH';
604    
605     my $nt = $node->node_type;
606     if ($nt == 1) {
607     my $node_ns = $node->namespace_uri;
608     $node_ns = '' unless defined $node_ns;
609     my $node_ln = $node->manakai_local_name;
610     my $not_allowed = $self->{minuses}->{$node_ns}->{$node_ln};
611     if ($todo->{strictly_inline}) {
612     $not_allowed = 1
613 wakaba 1.8 unless $HTMLStrictlyInlineLevelElements->{$node_ns}->{$node_ln} or
614     $self->{pluses}->{$node_ns}->{$node_ln};
615 wakaba 1.1 } else {
616     $not_allowed = 1
617     unless $HTMLStrictlyInlineLevelElements->{$node_ns}->{$node_ln} or
618 wakaba 1.8 $HTMLStructuredInlineLevelElements->{$node_ns}->{$node_ln} or
619     $self->{pluses}->{$node_ns}->{$node_ln};
620 wakaba 1.1 }
621     $self->{onerror}->(node => $node, type => 'element not allowed')
622     if $not_allowed;
623     my ($sib, $ch) = $self->_check_get_children ($node, $todo);
624     unshift @nodes, @$sib;
625     push @$new_todos, @$ch;
626 wakaba 1.25 } elsif ($nt == 3 or $nt == 4) {
627     if ($node->data =~ /[^\x09-\x0D\x20]/) {
628     $todo->{flag}->{has_descendant}->{significant} = 1;
629     }
630 wakaba 1.1 } elsif ($nt == 5) {
631     unshift @nodes, @{$node->child_nodes};
632     }
633     }
634    
635     for (@$new_todos) {
636     $_->{inline} = 1;
637     $_->{strictly_inline} = 1;
638     }
639 wakaba 1.25
640     push @$new_todos, {
641     type => 'descendant', node => $todo->{node}, flag => $todo->{flag},
642     old_values => $old_values,
643 wakaba 1.26 errors => $HTMLSignificantContentErrors,
644 wakaba 1.25 };
645    
646 wakaba 1.1 return ($new_todos);
647     }; # $HTMLInlineOrStrictlyInlineChecker
648    
649 wakaba 1.29 my $HTMLPhrasingContentChecker = sub {
650     my ($self, $todo) = @_;
651     my $el = $todo->{node};
652     my $new_todos = [];
653     my @nodes = (@{$el->child_nodes});
654    
655     my $old_values = {significant =>
656     $todo->{flag}->{has_descendant}->{significant}};
657     $todo->{flag}->{has_descendant}->{significant} = 0;
658    
659     while (@nodes) {
660     my $node = shift @nodes;
661     $self->_remove_minuses ($node) and next if ref $node eq 'HASH';
662    
663     my $nt = $node->node_type;
664     if ($nt == 1) {
665     my $node_ns = $node->namespace_uri;
666     $node_ns = '' unless defined $node_ns;
667     my $node_ln = $node->manakai_local_name;
668     my $not_allowed = $self->{minuses}->{$node_ns}->{$node_ln};
669     $not_allowed = 1
670     unless $HTMLPhrasingContent->{$node_ns}->{$node_ln} or
671     $self->{pluses}->{$node_ns}->{$node_ln};
672     $self->{onerror}->(node => $node, type => 'element not allowed:phrasing')
673     if $not_allowed;
674     my ($sib, $ch) = $self->_check_get_children ($node, $todo);
675     unshift @nodes, @$sib;
676     push @$new_todos, @$ch;
677     } elsif ($nt == 3 or $nt == 4) {
678     if ($node->data =~ /[^\x09-\x0D\x20]/) {
679     $todo->{flag}->{has_descendant}->{significant} = 1;
680     }
681     } elsif ($nt == 5) {
682     unshift @nodes, @{$node->child_nodes};
683     }
684     }
685    
686     push @$new_todos, {
687     type => 'descendant', node => $todo->{node}, flag => $todo->{flag},
688     old_values => $old_values,
689     errors => $HTMLSignificantContentErrors,
690     };
691    
692     return ($new_todos);
693     }; # $HTMLPhrasingContentChecker
694    
695 wakaba 1.8 ## Block-level content or inline-level content (i.e. bimorphic content model)
696 wakaba 1.1 my $HTMLBlockOrInlineChecker = sub {
697     my ($self, $todo) = @_;
698     my $el = $todo->{node};
699     my $new_todos = [];
700     my @nodes = (@{$el->child_nodes});
701 wakaba 1.25
702     my $old_values = {significant =>
703     $todo->{flag}->{has_descendant}->{significant}};
704     $todo->{flag}->{has_descendant}->{significant} = 0;
705 wakaba 1.1
706     my $content = 'block-or-inline'; # or 'block' or 'inline'
707     my @block_not_inline;
708     while (@nodes) {
709     my $node = shift @nodes;
710     $self->_remove_minuses ($node) and next if ref $node eq 'HASH';
711    
712 wakaba 1.8 ## ISSUE: It is unclear whether "<rule><div><p/><nest/></div></rule>"
713     ## is conforming or not.
714    
715 wakaba 1.1 my $nt = $node->node_type;
716     if ($nt == 1) {
717     my $node_ns = $node->namespace_uri;
718     $node_ns = '' unless defined $node_ns;
719     my $node_ln = $node->manakai_local_name;
720     my $not_allowed = $self->{minuses}->{$node_ns}->{$node_ln};
721     if ($content eq 'block') {
722     $not_allowed = 1
723 wakaba 1.8 unless $HTMLBlockLevelElements->{$node_ns}->{$node_ln} or
724     $self->{pluses}->{$node_ns}->{$node_ln};
725 wakaba 1.1 } elsif ($content eq 'inline') {
726     $not_allowed = 1
727     unless $HTMLStrictlyInlineLevelElements->{$node_ns}->{$node_ln} or
728 wakaba 1.8 $HTMLStructuredInlineLevelElements->{$node_ns}->{$node_ln} or
729     $self->{pluses}->{$node_ns}->{$node_ln};
730 wakaba 1.1 } else {
731     my $is_block = $HTMLBlockLevelElements->{$node_ns}->{$node_ln};
732     my $is_inline
733     = $HTMLStrictlyInlineLevelElements->{$node_ns}->{$node_ln} ||
734     $HTMLStructuredInlineLevelElements->{$node_ns}->{$node_ln};
735    
736     push @block_not_inline, $node
737     if $is_block and not $is_inline and not $not_allowed;
738 wakaba 1.8 if (not $is_block and not $self->{pluses}->{$node_ns}->{$node_ln}) {
739 wakaba 1.1 $content = 'inline';
740     for (@block_not_inline) {
741     $self->{onerror}->(node => $_, type => 'element not allowed');
742     }
743     $not_allowed = 1 unless $is_inline;
744     }
745     }
746     $self->{onerror}->(node => $node, type => 'element not allowed')
747     if $not_allowed;
748     my ($sib, $ch) = $self->_check_get_children ($node, $todo);
749     unshift @nodes, @$sib;
750     push @$new_todos, @$ch;
751     } elsif ($nt == 3 or $nt == 4) {
752     if ($node->data =~ /[^\x09-\x0D\x20]/) {
753     if ($content eq 'block') {
754     $self->{onerror}->(node => $node, type => 'character not allowed');
755     } else {
756     $content = 'inline';
757     for (@block_not_inline) {
758     $self->{onerror}->(node => $_, type => 'element not allowed');
759     }
760     }
761 wakaba 1.25 $todo->{flag}->{has_descendant}->{significant} = 1;
762 wakaba 1.1 }
763     } elsif ($nt == 5) {
764     unshift @nodes, @{$node->child_nodes};
765     }
766     }
767    
768     if ($content eq 'inline') {
769     for (@$new_todos) {
770     $_->{inline} = 1;
771     }
772     }
773 wakaba 1.25
774     push @$new_todos, {
775     type => 'descendant', node => $todo->{node}, flag => $todo->{flag},
776     old_values => $old_values,
777 wakaba 1.26 errors => $HTMLSignificantContentErrors,
778 wakaba 1.25 };
779    
780 wakaba 1.1 return ($new_todos);
781     };
782    
783     ## Zero or more XXX element, then either block-level or inline-level
784     my $GetHTMLZeroOrMoreThenBlockOrInlineChecker = sub ($$) {
785     my ($elnsuri, $ellname) = @_;
786     return sub {
787     my ($self, $todo) = @_;
788     my $el = $todo->{node};
789     my $new_todos = [];
790     my @nodes = (@{$el->child_nodes});
791 wakaba 1.25
792     my $old_values = {significant =>
793     $todo->{flag}->{has_descendant}->{significant}};
794     $todo->{flag}->{has_descendant}->{significant} = 0;
795 wakaba 1.1
796     my $has_non_style;
797     my $content = 'block-or-inline'; # or 'block' or 'inline'
798     my @block_not_inline;
799     while (@nodes) {
800     my $node = shift @nodes;
801     $self->_remove_minuses ($node) and next if ref $node eq 'HASH';
802    
803     my $nt = $node->node_type;
804     if ($nt == 1) {
805     my $node_ns = $node->namespace_uri;
806     $node_ns = '' unless defined $node_ns;
807     my $node_ln = $node->manakai_local_name;
808     my $not_allowed = $self->{minuses}->{$node_ns}->{$node_ln};
809     if ($node_ns eq $elnsuri and $node_ln eq $ellname) {
810     $not_allowed = 1 if $has_non_style;
811     if ($ellname eq 'style' and
812     not $node->has_attribute_ns (undef, 'scoped')) {
813     $not_allowed = 1;
814     }
815     } elsif ($content eq 'block') {
816     $has_non_style = 1;
817     $not_allowed = 1
818 wakaba 1.8 unless $HTMLBlockLevelElements->{$node_ns}->{$node_ln} or
819     $self->{pluses}->{$node_ns}->{$node_ln};
820 wakaba 1.1 } elsif ($content eq 'inline') {
821     $has_non_style = 1;
822     $not_allowed = 1
823     unless $HTMLStrictlyInlineLevelElements->{$node_ns}->{$node_ln} or
824 wakaba 1.8 $HTMLStructuredInlineLevelElements->{$node_ns}->{$node_ln} or
825     $self->{pluses}->{$node_ns}->{$node_ln};
826 wakaba 1.1 } else {
827 wakaba 1.8 $has_non_style = 1 unless $self->{pluses}->{$node_ns}->{$node_ln};
828 wakaba 1.1 my $is_block = $HTMLBlockLevelElements->{$node_ns}->{$node_ln};
829     my $is_inline
830     = $HTMLStrictlyInlineLevelElements->{$node_ns}->{$node_ln} ||
831     $HTMLStructuredInlineLevelElements->{$node_ns}->{$node_ln};
832    
833     push @block_not_inline, $node
834     if $is_block and not $is_inline and not $not_allowed;
835 wakaba 1.8 if (not $is_block and not $self->{pluses}->{$node_ns}->{$node_ln}) {
836 wakaba 1.1 $content = 'inline';
837     for (@block_not_inline) {
838     $self->{onerror}->(node => $_, type => 'element not allowed');
839     }
840     $not_allowed = 1 unless $is_inline;
841     }
842     }
843     $self->{onerror}->(node => $node, type => 'element not allowed')
844     if $not_allowed;
845     my ($sib, $ch) = $self->_check_get_children ($node, $todo);
846     unshift @nodes, @$sib;
847     push @$new_todos, @$ch;
848     } elsif ($nt == 3 or $nt == 4) {
849     if ($node->data =~ /[^\x09-\x0D\x20]/) {
850     $has_non_style = 1;
851     if ($content eq 'block') {
852     $self->{onerror}->(node => $node, type => 'character not allowed');
853     } else {
854     $content = 'inline';
855     for (@block_not_inline) {
856     $self->{onerror}->(node => $_, type => 'element not allowed');
857     }
858     }
859 wakaba 1.25 $todo->{flag}->{has_descendant}->{significant} = 1;
860 wakaba 1.1 }
861     } elsif ($nt == 5) {
862     unshift @nodes, @{$node->child_nodes};
863     }
864     }
865    
866     if ($content eq 'inline') {
867     for (@$new_todos) {
868     $_->{inline} = 1;
869     }
870     }
871 wakaba 1.25
872     push @$new_todos, {
873     type => 'descendant', node => $todo->{node}, flag => $todo->{flag},
874     old_values => $old_values,
875 wakaba 1.26 errors => $HTMLSignificantContentErrors,
876 wakaba 1.25 };
877    
878 wakaba 1.1 return ($new_todos);
879     };
880     }; # $GetHTMLZeroOrMoreThenBlockOrInlineChecker
881    
882 wakaba 1.29 my $HTMLTransparentChecker = $HTMLProseContentChecker;
883 wakaba 1.25 ## ISSUE: Significant content rule should be applied to transparent element
884     ## with parent? Currently, applied to |video| but not to others.
885 wakaba 1.1
886     our $AttrChecker;
887    
888     my $GetHTMLEnumeratedAttrChecker = sub {
889     my $states = shift; # {value => conforming ? 1 : -1}
890     return sub {
891     my ($self, $attr) = @_;
892     my $value = lc $attr->value; ## TODO: ASCII case insensitibility?
893     if ($states->{$value} > 0) {
894     #
895     } elsif ($states->{$value}) {
896     $self->{onerror}->(node => $attr, type => 'enumerated:non-conforming');
897     } else {
898     $self->{onerror}->(node => $attr, type => 'enumerated:invalid');
899     }
900     };
901     }; # $GetHTMLEnumeratedAttrChecker
902    
903     my $GetHTMLBooleanAttrChecker = sub {
904     my $local_name = shift;
905     return sub {
906     my ($self, $attr) = @_;
907     my $value = $attr->value;
908     unless ($value eq $local_name or $value eq '') {
909     $self->{onerror}->(node => $attr, type => 'boolean:invalid');
910     }
911     };
912     }; # $GetHTMLBooleanAttrChecker
913    
914 wakaba 1.8 ## Unordered set of space-separated tokens
915 wakaba 1.18 my $HTMLUnorderedUniqueSetOfSpaceSeparatedTokensAttrChecker = sub {
916 wakaba 1.8 my ($self, $attr) = @_;
917     my %word;
918     for my $word (grep {length $_} split /[\x09-\x0D\x20]/, $attr->value) {
919     unless ($word{$word}) {
920     $word{$word} = 1;
921     } else {
922     $self->{onerror}->(node => $attr, type => 'duplicate token:'.$word);
923     }
924     }
925 wakaba 1.18 }; # $HTMLUnorderedUniqueSetOfSpaceSeparatedTokensAttrChecker
926 wakaba 1.8
927 wakaba 1.1 ## |rel| attribute (unordered set of space separated tokens,
928     ## whose allowed values are defined by the section on link types)
929     my $HTMLLinkTypesAttrChecker = sub {
930 wakaba 1.4 my ($a_or_area, $todo, $self, $attr) = @_;
931 wakaba 1.1 my %word;
932     for my $word (grep {length $_} split /[\x09-\x0D\x20]/, $attr->value) {
933     unless ($word{$word}) {
934     $word{$word} = 1;
935 wakaba 1.18 } elsif ($word eq 'up') {
936     #
937 wakaba 1.1 } else {
938     $self->{onerror}->(node => $attr, type => 'duplicate token:'.$word);
939     }
940     }
941     ## NOTE: Case sensitive match (since HTML5 spec does not say link
942     ## types are case-insensitive and it says "The value should not
943     ## be confusingly similar to any other defined value (e.g.
944     ## differing only in case).").
945     ## NOTE: Though there is no explicit "MUST NOT" for undefined values,
946     ## "MAY"s and "only ... MAY" restrict non-standard non-registered
947     ## values to be used conformingly.
948     require Whatpm::_LinkTypeList;
949     our $LinkType;
950     for my $word (keys %word) {
951     my $def = $LinkType->{$word};
952     if (defined $def) {
953     if ($def->{status} eq 'accepted') {
954     if (defined $def->{effect}->[$a_or_area]) {
955     #
956     } else {
957     $self->{onerror}->(node => $attr,
958     type => 'link type:bad context:'.$word);
959     }
960     } elsif ($def->{status} eq 'proposal') {
961     $self->{onerror}->(node => $attr, level => 's',
962     type => 'link type:proposed:'.$word);
963 wakaba 1.20 if (defined $def->{effect}->[$a_or_area]) {
964     #
965     } else {
966     $self->{onerror}->(node => $attr,
967     type => 'link type:bad context:'.$word);
968     }
969 wakaba 1.1 } else { # rejected or synonym
970     $self->{onerror}->(node => $attr,
971     type => 'link type:non-conforming:'.$word);
972     }
973 wakaba 1.4 if (defined $def->{effect}->[$a_or_area]) {
974     if ($word eq 'alternate') {
975     #
976     } elsif ($def->{effect}->[$a_or_area] eq 'hyperlink') {
977     $todo->{has_hyperlink_link_type} = 1;
978     }
979     }
980 wakaba 1.1 if ($def->{unique}) {
981     unless ($self->{has_link_type}->{$word}) {
982     $self->{has_link_type}->{$word} = 1;
983     } else {
984     $self->{onerror}->(node => $attr,
985     type => 'link type:duplicate:'.$word);
986     }
987     }
988     } else {
989     $self->{onerror}->(node => $attr, level => 'unsupported',
990     type => 'link type:'.$word);
991     }
992     }
993 wakaba 1.4 $todo->{has_hyperlink_link_type} = 1
994     if $word{alternate} and not $word{stylesheet};
995 wakaba 1.1 ## TODO: The Pingback 1.0 specification, which is referenced by HTML5,
996     ## says that using both X-Pingback: header field and HTML
997     ## <link rel=pingback> is deprecated and if both appears they
998     ## SHOULD contain exactly the same value.
999     ## ISSUE: Pingback 1.0 specification defines the exact representation
1000     ## of its link element, which cannot be tested by the current arch.
1001     ## ISSUE: Pingback 1.0 specification says that the document MUST NOT
1002     ## include any string that matches to the pattern for the rel=pingback link,
1003     ## which again inpossible to test.
1004     ## ISSUE: rel=pingback href MUST NOT include entities other than predefined 4.
1005 wakaba 1.12
1006     ## NOTE: <link rel="up index"><link rel="up up index"> is not an error.
1007 wakaba 1.17 ## NOTE: We can't check "If the page is part of multiple hierarchies,
1008     ## then they SHOULD be described in different paragraphs.".
1009 wakaba 1.1 }; # $HTMLLinkTypesAttrChecker
1010 wakaba 1.20
1011     ## TODO: "When an author uses a new type not defined by either this specification or the Wiki page, conformance checkers should offer to add the value to the Wiki, with the details described above, with the "proposal" status."
1012 wakaba 1.1
1013     ## URI (or IRI)
1014     my $HTMLURIAttrChecker = sub {
1015     my ($self, $attr) = @_;
1016     ## ISSUE: Relative references are allowed? (RFC 3987 "IRI" is an absolute reference with optional fragment identifier.)
1017     my $value = $attr->value;
1018     Whatpm::URIChecker->check_iri_reference ($value, sub {
1019     my %opt = @_;
1020     $self->{onerror}->(node => $attr, level => $opt{level},
1021     type => 'URI::'.$opt{type}.
1022     (defined $opt{position} ? ':'.$opt{position} : ''));
1023     });
1024 wakaba 1.17 $self->{has_uri_attr} = 1; ## TODO: <html manifest>
1025 wakaba 1.1 }; # $HTMLURIAttrChecker
1026    
1027     ## A space separated list of one or more URIs (or IRIs)
1028     my $HTMLSpaceURIsAttrChecker = sub {
1029     my ($self, $attr) = @_;
1030     my $i = 0;
1031     for my $value (split /[\x09-\x0D\x20]+/, $attr->value) {
1032     Whatpm::URIChecker->check_iri_reference ($value, sub {
1033     my %opt = @_;
1034     $self->{onerror}->(node => $attr, level => $opt{level},
1035 wakaba 1.2 type => 'URIs:'.':'.
1036     $opt{type}.':'.$i.
1037 wakaba 1.1 (defined $opt{position} ? ':'.$opt{position} : ''));
1038     });
1039     $i++;
1040     }
1041     ## ISSUE: Relative references?
1042     ## ISSUE: Leading or trailing white spaces are conformant?
1043     ## ISSUE: A sequence of white space characters are conformant?
1044     ## ISSUE: A zero-length string is conformant? (It does contain a relative reference, i.e. same as base URI.)
1045     ## NOTE: Duplication seems not an error.
1046 wakaba 1.4 $self->{has_uri_attr} = 1;
1047 wakaba 1.1 }; # $HTMLSpaceURIsAttrChecker
1048    
1049     my $HTMLDatetimeAttrChecker = sub {
1050     my ($self, $attr) = @_;
1051     my $value = $attr->value;
1052     ## ISSUE: "space", not "space character" (in parsing algorihtm, "space character")
1053     if ($value =~ /\A([0-9]{4})-([0-9]{2})-([0-9]{2})(?>[\x09-\x0D\x20]+(?>T[\x09-\x0D\x20]*)?|T[\x09-\x0D\x20]*)([0-9]{2}):([0-9]{2})(?>:([0-9]{2}))?(?>\.([0-9]+))?[\x09-\x0D\x20]*(?>Z|[+-]([0-9]{2}):([0-9]{2}))\z/) {
1054     my ($y, $M, $d, $h, $m, $s, $f, $zh, $zm)
1055     = ($1, $2, $3, $4, $5, $6, $7, $8, $9);
1056     if (0 < $M and $M < 13) { ## ISSUE: This is not explicitly specified (though in parsing algorithm)
1057     $self->{onerror}->(node => $attr, type => 'datetime:bad day')
1058     if $d < 1 or
1059     $d > [0, 31, 29, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31]->[$M];
1060     $self->{onerror}->(node => $attr, type => 'datetime:bad day')
1061     if $M == 2 and $d == 29 and
1062     not ($y % 400 == 0 or ($y % 4 == 0 and $y % 100 != 0));
1063     } else {
1064     $self->{onerror}->(node => $attr, type => 'datetime:bad month');
1065     }
1066     $self->{onerror}->(node => $attr, type => 'datetime:bad hour') if $h > 23;
1067     $self->{onerror}->(node => $attr, type => 'datetime:bad minute') if $m > 59;
1068     $self->{onerror}->(node => $attr, type => 'datetime:bad second')
1069     if defined $s and $s > 59;
1070     $self->{onerror}->(node => $attr, type => 'datetime:bad timezone hour')
1071     if $zh > 23;
1072     $self->{onerror}->(node => $attr, type => 'datetime:bad timezone minute')
1073     if $zm > 59;
1074     ## ISSUE: Maybe timezone -00:00 should have same semantics as in RFC 3339.
1075     } else {
1076     $self->{onerror}->(node => $attr, type => 'datetime:syntax error');
1077     }
1078     }; # $HTMLDatetimeAttrChecker
1079    
1080     my $HTMLIntegerAttrChecker = sub {
1081     my ($self, $attr) = @_;
1082     my $value = $attr->value;
1083     unless ($value =~ /\A-?[0-9]+\z/) {
1084     $self->{onerror}->(node => $attr, type => 'integer:syntax error');
1085     }
1086     }; # $HTMLIntegerAttrChecker
1087    
1088     my $GetHTMLNonNegativeIntegerAttrChecker = sub {
1089     my $range_check = shift;
1090     return sub {
1091     my ($self, $attr) = @_;
1092     my $value = $attr->value;
1093     if ($value =~ /\A[0-9]+\z/) {
1094     unless ($range_check->($value + 0)) {
1095     $self->{onerror}->(node => $attr, type => 'nninteger:out of range');
1096     }
1097     } else {
1098     $self->{onerror}->(node => $attr,
1099     type => 'nninteger:syntax error');
1100     }
1101     };
1102     }; # $GetHTMLNonNegativeIntegerAttrChecker
1103    
1104     my $GetHTMLFloatingPointNumberAttrChecker = sub {
1105     my $range_check = shift;
1106     return sub {
1107     my ($self, $attr) = @_;
1108     my $value = $attr->value;
1109     if ($value =~ /\A-?[0-9.]+\z/ and $value =~ /[0-9]/) {
1110     unless ($range_check->($value + 0)) {
1111     $self->{onerror}->(node => $attr, type => 'float:out of range');
1112     }
1113     } else {
1114     $self->{onerror}->(node => $attr,
1115     type => 'float:syntax error');
1116     }
1117     };
1118     }; # $GetHTMLFloatingPointNumberAttrChecker
1119    
1120     ## "A valid MIME type, optionally with parameters. [RFC 2046]"
1121     ## ISSUE: RFC 2046 does not define syntax of media types.
1122     ## ISSUE: The definition of "a valid MIME type" is unknown.
1123     ## Syntactical correctness?
1124     my $HTMLIMTAttrChecker = sub {
1125     my ($self, $attr) = @_;
1126     my $value = $attr->value;
1127     ## ISSUE: RFC 2045 Content-Type header field allows insertion
1128     ## of LWS/comments between tokens. Is it allowed in HTML? Maybe no.
1129     ## ISSUE: RFC 2231 extension? Maybe no.
1130     my $lws0 = qr/(?>(?>\x0D\x0A)?[\x09\x20])*/;
1131     my $token = qr/[\x21\x23-\x27\x2A\x2B\x2D\x2E\x30-\x39\x41-\x5A\x5E-\x7E]+/;
1132     my $qs = qr/"(?>[\x00-\x0C\x0E-\x21\x23-\x5B\x5D-\x7E]|\x0D\x0A[\x09\x20]|\x5C[\x00-\x7F])*"/;
1133     if ($value =~ m#\A$lws0($token)$lws0/$lws0($token)$lws0((?>;$lws0$token$lws0=$lws0(?>$token|$qs)$lws0)*)\z#) {
1134     my @type = ($1, $2);
1135     my $param = $3;
1136     while ($param =~ s/^;$lws0($token)$lws0=$lws0(?>($token)|($qs))$lws0//) {
1137     if (defined $2) {
1138     push @type, $1 => $2;
1139     } else {
1140     my $n = $1;
1141     my $v = $2;
1142     $v =~ s/\\(.)/$1/gs;
1143     push @type, $n => $v;
1144     }
1145     }
1146     require Whatpm::IMTChecker;
1147     Whatpm::IMTChecker->check_imt (sub {
1148     my %opt = @_;
1149     $self->{onerror}->(node => $attr, level => $opt{level},
1150     type => 'IMT:'.$opt{type});
1151     }, @type);
1152     } else {
1153     $self->{onerror}->(node => $attr, type => 'IMT:syntax error');
1154     }
1155     }; # $HTMLIMTAttrChecker
1156    
1157     my $HTMLLanguageTagAttrChecker = sub {
1158 wakaba 1.7 ## NOTE: See also $AtomLanguageTagAttrChecker in Atom.pm.
1159    
1160 wakaba 1.1 my ($self, $attr) = @_;
1161 wakaba 1.6 my $value = $attr->value;
1162     require Whatpm::LangTag;
1163     Whatpm::LangTag->check_rfc3066_language_tag ($value, sub {
1164     my %opt = @_;
1165     my $type = 'LangTag:'.$opt{type};
1166     $type .= ':' . $opt{subtag} if defined $opt{subtag};
1167     $self->{onerror}->(node => $attr, type => $type, value => $opt{value},
1168     level => $opt{level});
1169     });
1170 wakaba 1.1 ## ISSUE: RFC 4646 (3066bis)?
1171 wakaba 1.6
1172     ## TODO: testdata
1173 wakaba 1.1 }; # $HTMLLanguageTagAttrChecker
1174    
1175     ## "A valid media query [MQ]"
1176     my $HTMLMQAttrChecker = sub {
1177     my ($self, $attr) = @_;
1178     $self->{onerror}->(node => $attr, level => 'unsupported',
1179     type => 'media query');
1180     ## ISSUE: What is "a valid media query"?
1181     }; # $HTMLMQAttrChecker
1182    
1183     my $HTMLEventHandlerAttrChecker = sub {
1184     my ($self, $attr) = @_;
1185     $self->{onerror}->(node => $attr, level => 'unsupported',
1186     type => 'event handler');
1187     ## TODO: MUST contain valid ECMAScript code matching the
1188     ## ECMAScript |FunctionBody| production. [ECMA262]
1189     ## ISSUE: MUST be ES3? E4X? ES4? JS1.x?
1190     ## ISSUE: Automatic semicolon insertion does not apply?
1191     ## ISSUE: Other script languages?
1192     }; # $HTMLEventHandlerAttrChecker
1193    
1194     my $HTMLUsemapAttrChecker = sub {
1195     my ($self, $attr) = @_;
1196     ## MUST be a valid hashed ID reference to a |map| element
1197     my $value = $attr->value;
1198     if ($value =~ s/^#//) {
1199     ## ISSUE: Is |usemap="#"| conformant? (c.f. |id=""| is non-conformant.)
1200     push @{$self->{usemap}}, [$value => $attr];
1201     } else {
1202     $self->{onerror}->(node => $attr, type => '#idref:syntax error');
1203     }
1204     ## NOTE: Space characters in hashed ID references are conforming.
1205     ## ISSUE: UA algorithm for matching is case-insensitive; IDs only different in cases should be reported
1206     }; # $HTMLUsemapAttrChecker
1207    
1208     my $HTMLTargetAttrChecker = sub {
1209     my ($self, $attr) = @_;
1210     my $value = $attr->value;
1211     if ($value =~ /^_/) {
1212     $value = lc $value; ## ISSUE: ASCII case-insentitive?
1213     unless ({
1214     _self => 1, _parent => 1, _top => 1,
1215     }->{$value}) {
1216     $self->{onerror}->(node => $attr,
1217     type => 'reserved browsing context name');
1218     }
1219     } else {
1220 wakaba 1.29 ## NOTE: An empty string is a valid browsing context name (same as _self).
1221 wakaba 1.1 }
1222     }; # $HTMLTargetAttrChecker
1223    
1224 wakaba 1.23 my $HTMLSelectorsAttrChecker = sub {
1225     my ($self, $attr) = @_;
1226    
1227     ## ISSUE: Namespace resolution?
1228    
1229     my $value = $attr->value;
1230    
1231     require Whatpm::CSS::SelectorsParser;
1232     my $p = Whatpm::CSS::SelectorsParser->new;
1233     $p->{pseudo_class}->{$_} = 1 for qw/
1234     active checked disabled empty enabled first-child first-of-type
1235     focus hover indeterminate last-child last-of-type link only-child
1236     only-of-type root target visited
1237     lang nth-child nth-last-child nth-of-type nth-last-of-type not
1238     -manakai-contains -manakai-current
1239     /;
1240    
1241     $p->{pseudo_element}->{$_} = 1 for qw/
1242     after before first-letter first-line
1243     /;
1244    
1245     $p->{must_level} = $self->{must_level};
1246     $p->{onerror} = sub {
1247     my %opt = @_;
1248     $opt{type} = 'selectors:'.$opt{type};
1249     $self->{onerror}->(%opt, node => $attr);
1250     };
1251     $p->parse_string ($value);
1252     }; # $HTMLSelectorsAttrChecker
1253    
1254 wakaba 1.1 my $HTMLAttrChecker = {
1255     id => sub {
1256     ## NOTE: |map| has its own variant of |id=""| checker
1257     my ($self, $attr) = @_;
1258     my $value = $attr->value;
1259     if (length $value > 0) {
1260     if ($self->{id}->{$value}) {
1261     $self->{onerror}->(node => $attr, type => 'duplicate ID');
1262     push @{$self->{id}->{$value}}, $attr;
1263     } else {
1264     $self->{id}->{$value} = [$attr];
1265     }
1266     if ($value =~ /[\x09-\x0D\x20]/) {
1267     $self->{onerror}->(node => $attr, type => 'space in ID');
1268     }
1269     } else {
1270     ## NOTE: MUST contain at least one character
1271     $self->{onerror}->(node => $attr, type => 'empty attribute value');
1272     }
1273     },
1274     title => sub {}, ## NOTE: No conformance creteria
1275     lang => sub {
1276     my ($self, $attr) = @_;
1277 wakaba 1.6 my $value = $attr->value;
1278     if ($value eq '') {
1279     #
1280     } else {
1281     require Whatpm::LangTag;
1282     Whatpm::LangTag->check_rfc3066_language_tag ($value, sub {
1283     my %opt = @_;
1284     my $type = 'LangTag:'.$opt{type};
1285     $type .= ':' . $opt{subtag} if defined $opt{subtag};
1286     $self->{onerror}->(node => $attr, type => $type, value => $opt{value},
1287     level => $opt{level});
1288     });
1289     }
1290 wakaba 1.1 ## ISSUE: RFC 4646 (3066bis)?
1291     unless ($attr->owner_document->manakai_is_html) {
1292     $self->{onerror}->(node => $attr, type => 'in XML:lang');
1293     }
1294 wakaba 1.6
1295     ## TODO: test data
1296 wakaba 1.1 },
1297     dir => $GetHTMLEnumeratedAttrChecker->({ltr => 1, rtl => 1}),
1298     class => sub {
1299     my ($self, $attr) = @_;
1300     my %word;
1301     for my $word (grep {length $_} split /[\x09-\x0D\x20]/, $attr->value) {
1302     unless ($word{$word}) {
1303     $word{$word} = 1;
1304     push @{$self->{return}->{class}->{$word}||=[]}, $attr;
1305     } else {
1306     $self->{onerror}->(node => $attr, type => 'duplicate token:'.$word);
1307     }
1308     }
1309     },
1310     contextmenu => sub {
1311     my ($self, $attr) = @_;
1312     my $value = $attr->value;
1313     push @{$self->{contextmenu}}, [$value => $attr];
1314     ## ISSUE: "The value must be the ID of a menu element in the DOM."
1315     ## What is "in the DOM"? A menu Element node that is not part
1316     ## of the Document tree is in the DOM? A menu Element node that
1317     ## belong to another Document tree is in the DOM?
1318     },
1319     irrelevant => $GetHTMLBooleanAttrChecker->('irrelevant'),
1320 wakaba 1.8 tabindex => $HTMLIntegerAttrChecker
1321     ## TODO: ref, template, registrationmark
1322 wakaba 1.1 };
1323    
1324     for (qw/
1325     onabort onbeforeunload onblur onchange onclick oncontextmenu
1326     ondblclick ondrag ondragend ondragenter ondragleave ondragover
1327     ondragstart ondrop onerror onfocus onkeydown onkeypress
1328     onkeyup onload onmessage onmousedown onmousemove onmouseout
1329     onmouseover onmouseup onmousewheel onresize onscroll onselect
1330     onsubmit onunload
1331     /) {
1332     $HTMLAttrChecker->{$_} = $HTMLEventHandlerAttrChecker;
1333     }
1334    
1335     my $GetHTMLAttrsChecker = sub {
1336     my $element_specific_checker = shift;
1337     return sub {
1338     my ($self, $todo) = @_;
1339     for my $attr (@{$todo->{node}->attributes}) {
1340     my $attr_ns = $attr->namespace_uri;
1341     $attr_ns = '' unless defined $attr_ns;
1342     my $attr_ln = $attr->manakai_local_name;
1343     my $checker;
1344     if ($attr_ns eq '') {
1345     $checker = $element_specific_checker->{$attr_ln}
1346     || $HTMLAttrChecker->{$attr_ln};
1347     }
1348     $checker ||= $AttrChecker->{$attr_ns}->{$attr_ln}
1349     || $AttrChecker->{$attr_ns}->{''};
1350     if ($checker) {
1351     $checker->($self, $attr, $todo);
1352     } else {
1353     $self->{onerror}->(node => $attr, level => 'unsupported',
1354     type => 'attribute');
1355     ## ISSUE: No comformance createria for unknown attributes in the spec
1356     }
1357     }
1358     };
1359     }; # $GetHTMLAttrsChecker
1360    
1361     our $Element;
1362     our $ElementDefault;
1363    
1364     $Element->{$HTML_NS}->{''} = {
1365     attrs_checker => $GetHTMLAttrsChecker->({}),
1366     checker => $ElementDefault->{checker},
1367     };
1368    
1369     $Element->{$HTML_NS}->{html} = {
1370     is_root => 1,
1371     attrs_checker => $GetHTMLAttrsChecker->({
1372 wakaba 1.16 manifest => $HTMLURIAttrChecker,
1373 wakaba 1.1 xmlns => sub {
1374     my ($self, $attr) = @_;
1375     my $value = $attr->value;
1376     unless ($value eq $HTML_NS) {
1377     $self->{onerror}->(node => $attr, type => 'invalid attribute value');
1378     }
1379     unless ($attr->owner_document->manakai_is_html) {
1380     $self->{onerror}->(node => $attr, type => 'in XML:xmlns');
1381     ## TODO: Test
1382     }
1383     },
1384     }),
1385     checker => sub {
1386     my ($self, $todo) = @_;
1387     my $el = $todo->{node};
1388     my $new_todos = [];
1389     my @nodes = (@{$el->child_nodes});
1390    
1391 wakaba 1.25 my $old_values = {significant =>
1392     $todo->{flag}->{has_descendant}->{significant}};
1393     $todo->{flag}->{has_descendant}->{significant} = 0;
1394    
1395 wakaba 1.1 my $phase = 'before head';
1396     while (@nodes) {
1397     my $node = shift @nodes;
1398     $self->_remove_minuses ($node) and next if ref $node eq 'HASH';
1399    
1400     my $nt = $node->node_type;
1401     if ($nt == 1) {
1402     my $node_ns = $node->namespace_uri;
1403     $node_ns = '' unless defined $node_ns;
1404     my $node_ln = $node->manakai_local_name;
1405     my $not_allowed = $self->{minuses}->{$node_ns}->{$node_ln};
1406 wakaba 1.8 if ($self->{pluses}->{$node_ns}->{$node_ln}) {
1407     #
1408     } elsif ($phase eq 'before head') {
1409 wakaba 1.1 if ($node_ns eq $HTML_NS and $node_ln eq 'head') {
1410     $phase = 'after head';
1411     } elsif ($node_ns eq $HTML_NS and $node_ln eq 'body') {
1412     $self->{onerror}->(node => $node, type => 'ps element missing:head');
1413     $phase = 'after body';
1414     } else {
1415     $not_allowed = 1;
1416     # before head
1417     }
1418     } elsif ($phase eq 'after head') {
1419     if ($node_ns eq $HTML_NS and $node_ln eq 'body') {
1420     $phase = 'after body';
1421     } else {
1422     $not_allowed = 1;
1423     # after head
1424     }
1425     } else { #elsif ($phase eq 'after body') {
1426     $not_allowed = 1;
1427     # after body
1428     }
1429     $self->{onerror}->(node => $node, type => 'element not allowed')
1430     if $not_allowed;
1431     my ($sib, $ch) = $self->_check_get_children ($node, $todo);
1432     unshift @nodes, @$sib;
1433     push @$new_todos, @$ch;
1434     } elsif ($nt == 3 or $nt == 4) {
1435     if ($node->data =~ /[^\x09-\x0D\x20]/) {
1436     $self->{onerror}->(node => $node, type => 'character not allowed');
1437 wakaba 1.25 $todo->{flag}->{has_descendant}->{significant} = 1;
1438 wakaba 1.1 }
1439     } elsif ($nt == 5) {
1440     unshift @nodes, @{$node->child_nodes};
1441     }
1442     }
1443    
1444     if ($phase eq 'before head') {
1445     $self->{onerror}->(node => $el, type => 'child element missing:head');
1446     $self->{onerror}->(node => $el, type => 'child element missing:body');
1447     } elsif ($phase eq 'after head') {
1448     $self->{onerror}->(node => $el, type => 'child element missing:body');
1449     }
1450    
1451 wakaba 1.25 ## NOTE: Significant content check - this is performed here since
1452     ## |html| content model allows a block-level element - |body|.
1453     push @$new_todos, {
1454     type => 'descendant', node => $todo->{node}, flag => $todo->{flag},
1455     old_values => $old_values,
1456 wakaba 1.26 errors => $HTMLSignificantContentErrors,
1457 wakaba 1.25 };
1458    
1459 wakaba 1.1 return ($new_todos);
1460     },
1461     };
1462    
1463     $Element->{$HTML_NS}->{head} = {
1464     attrs_checker => $GetHTMLAttrsChecker->({}),
1465     checker => sub {
1466     my ($self, $todo) = @_;
1467     my $el = $todo->{node};
1468     my $new_todos = [];
1469     my @nodes = (@{$el->child_nodes});
1470    
1471     my $has_title;
1472     while (@nodes) {
1473     my $node = shift @nodes;
1474     $self->_remove_minuses ($node) and next if ref $node eq 'HASH';
1475    
1476     my $nt = $node->node_type;
1477     if ($nt == 1) {
1478     my $node_ns = $node->namespace_uri;
1479     $node_ns = '' unless defined $node_ns;
1480     my $node_ln = $node->manakai_local_name;
1481     my $not_allowed = $self->{minuses}->{$node_ns}->{$node_ln};
1482 wakaba 1.8 if ($self->{pluses}->{$node_ns}->{$node_ln}) {
1483     #
1484     } elsif ($node_ns eq $HTML_NS and $node_ln eq 'title') {
1485 wakaba 1.1 unless ($has_title) {
1486     $has_title = 1;
1487     } else {
1488     $not_allowed = 1;
1489     }
1490 wakaba 1.29 } elsif ($HTMLMetadataContent->{$node_ns}->{$node_ln}) {
1491     #
1492    
1493     ## NOTE: |meta| is a metadata content. However, strictly speaking,
1494     ## a |meta| element with none of |charset|, |name|,
1495     ## or |http-equiv| attribute is not allowed. It is non-conforming
1496     ## anyway.
1497 wakaba 1.1 } else {
1498     $not_allowed = 1;
1499     }
1500     $self->{onerror}->(node => $node, type => 'element not allowed')
1501     if $not_allowed;
1502 wakaba 1.3 local $todo->{flag}->{in_head} = 1;
1503 wakaba 1.1 my ($sib, $ch) = $self->_check_get_children ($node, $todo);
1504     unshift @nodes, @$sib;
1505     push @$new_todos, @$ch;
1506     } elsif ($nt == 3 or $nt == 4) {
1507     if ($node->data =~ /[^\x09-\x0D\x20]/) {
1508     $self->{onerror}->(node => $node, type => 'character not allowed');
1509 wakaba 1.25 $todo->{flag}->{has_descendant}->{significant} = 1;
1510 wakaba 1.1 }
1511     } elsif ($nt == 5) {
1512     unshift @nodes, @{$node->child_nodes};
1513     }
1514     }
1515     unless ($has_title) {
1516     $self->{onerror}->(node => $el, type => 'child element missing:title');
1517     }
1518     return ($new_todos);
1519     },
1520     };
1521    
1522     $Element->{$HTML_NS}->{title} = {
1523     attrs_checker => $GetHTMLAttrsChecker->({}),
1524     checker => $HTMLTextChecker,
1525     };
1526    
1527     $Element->{$HTML_NS}->{base} = {
1528 wakaba 1.4 attrs_checker => sub {
1529     my ($self, $todo) = @_;
1530    
1531 wakaba 1.29 if ($self->{has_base}) {
1532     $self->{onerror}->(node => $todo->{node},
1533     type => 'element not allowed:base');
1534     } else {
1535     $self->{has_base} = 1;
1536     }
1537    
1538 wakaba 1.14 my $has_href = $todo->{node}->has_attribute_ns (undef, 'href');
1539     my $has_target = $todo->{node}->has_attribute_ns (undef, 'target');
1540    
1541     if ($self->{has_uri_attr} and $has_href) {
1542 wakaba 1.4 ## ISSUE: Are these examples conforming?
1543     ## <head profile="a b c"><base href> (except for |profile|'s
1544     ## non-conformance)
1545     ## <title xml:base="relative"/><base href/> (maybe it should be)
1546     ## <unknown xmlns="relative"/><base href/> (assuming that
1547     ## |{relative}:unknown| is allowed before XHTML |base| (unlikely, though))
1548     ## <style>@import 'relative';</style><base href>
1549     ## <script>location.href = 'relative';</script><base href>
1550 wakaba 1.14 ## NOTE: <html manifest=".."><head><base href=""/> is conforming as
1551     ## an exception.
1552 wakaba 1.4 $self->{onerror}->(node => $todo->{node},
1553     type => 'basehref after URI attribute');
1554     }
1555 wakaba 1.14 if ($self->{has_hyperlink_element} and $has_target) {
1556 wakaba 1.4 ## ISSUE: Are these examples conforming?
1557     ## <head><title xlink:href=""/><base target="name"/></head>
1558     ## <xbl:xbl>...<svg:a href=""/>...</xbl:xbl><base target="name"/>
1559     ## (assuming that |xbl:xbl| is allowed before |base|)
1560     ## NOTE: These are non-conformant anyway because of |head|'s content model:
1561     ## <link href=""/><base target="name"/>
1562     ## <link rel=unknown href=""><base target=name>
1563     $self->{onerror}->(node => $todo->{node},
1564     type => 'basetarget after hyperlink');
1565     }
1566    
1567 wakaba 1.14 if (not $has_href and not $has_target) {
1568     $self->{onerror}->(node => $todo->{node},
1569     type => 'attribute missing:href|target');
1570     }
1571    
1572 wakaba 1.4 return $GetHTMLAttrsChecker->({
1573     href => $HTMLURIAttrChecker,
1574     target => $HTMLTargetAttrChecker,
1575     })->($self, $todo);
1576     },
1577 wakaba 1.1 checker => $HTMLEmptyChecker,
1578     };
1579    
1580     $Element->{$HTML_NS}->{link} = {
1581     attrs_checker => sub {
1582     my ($self, $todo) = @_;
1583     $GetHTMLAttrsChecker->({
1584     href => $HTMLURIAttrChecker,
1585 wakaba 1.4 rel => sub { $HTMLLinkTypesAttrChecker->(0, $todo, @_) },
1586 wakaba 1.1 media => $HTMLMQAttrChecker,
1587     hreflang => $HTMLLanguageTagAttrChecker,
1588     type => $HTMLIMTAttrChecker,
1589     ## NOTE: Though |title| has special semantics,
1590     ## syntactically same as the |title| as global attribute.
1591     })->($self, $todo);
1592 wakaba 1.4 if ($todo->{node}->has_attribute_ns (undef, 'href')) {
1593     $self->{has_hyperlink_element} = 1 if $todo->{has_hyperlink_link_type};
1594     } else {
1595 wakaba 1.1 $self->{onerror}->(node => $todo->{node},
1596     type => 'attribute missing:href');
1597     }
1598     unless ($todo->{node}->has_attribute_ns (undef, 'rel')) {
1599     $self->{onerror}->(node => $todo->{node},
1600     type => 'attribute missing:rel');
1601     }
1602     },
1603     checker => $HTMLEmptyChecker,
1604     };
1605    
1606     $Element->{$HTML_NS}->{meta} = {
1607     attrs_checker => sub {
1608     my ($self, $todo) = @_;
1609     my $name_attr;
1610     my $http_equiv_attr;
1611     my $charset_attr;
1612     my $content_attr;
1613     for my $attr (@{$todo->{node}->attributes}) {
1614     my $attr_ns = $attr->namespace_uri;
1615     $attr_ns = '' unless defined $attr_ns;
1616     my $attr_ln = $attr->manakai_local_name;
1617     my $checker;
1618     if ($attr_ns eq '') {
1619     if ($attr_ln eq 'content') {
1620     $content_attr = $attr;
1621     $checker = 1;
1622     } elsif ($attr_ln eq 'name') {
1623     $name_attr = $attr;
1624     $checker = 1;
1625     } elsif ($attr_ln eq 'http-equiv') {
1626     $http_equiv_attr = $attr;
1627     $checker = 1;
1628     } elsif ($attr_ln eq 'charset') {
1629     $charset_attr = $attr;
1630     $checker = 1;
1631     } else {
1632     $checker = $HTMLAttrChecker->{$attr_ln}
1633     || $AttrChecker->{$attr_ns}->{$attr_ln}
1634     || $AttrChecker->{$attr_ns}->{''};
1635     }
1636     } else {
1637     $checker ||= $AttrChecker->{$attr_ns}->{$attr_ln}
1638     || $AttrChecker->{$attr_ns}->{''};
1639     }
1640     if ($checker) {
1641     $checker->($self, $attr) if ref $checker;
1642     } else {
1643     $self->{onerror}->(node => $attr, level => 'unsupported',
1644     type => 'attribute');
1645     ## ISSUE: No comformance createria for unknown attributes in the spec
1646     }
1647     }
1648    
1649     if (defined $name_attr) {
1650     if (defined $http_equiv_attr) {
1651     $self->{onerror}->(node => $http_equiv_attr,
1652     type => 'attribute not allowed');
1653     } elsif (defined $charset_attr) {
1654     $self->{onerror}->(node => $charset_attr,
1655     type => 'attribute not allowed');
1656     }
1657     my $metadata_name = $name_attr->value;
1658     my $metadata_value;
1659     if (defined $content_attr) {
1660     $metadata_value = $content_attr->value;
1661     } else {
1662     $self->{onerror}->(node => $todo->{node},
1663     type => 'attribute missing:content');
1664     $metadata_value = '';
1665     }
1666     } elsif (defined $http_equiv_attr) {
1667     if (defined $charset_attr) {
1668     $self->{onerror}->(node => $charset_attr,
1669     type => 'attribute not allowed');
1670     }
1671     unless (defined $content_attr) {
1672     $self->{onerror}->(node => $todo->{node},
1673     type => 'attribute missing:content');
1674     }
1675     } elsif (defined $charset_attr) {
1676     if (defined $content_attr) {
1677     $self->{onerror}->(node => $content_attr,
1678     type => 'attribute not allowed');
1679     }
1680     } else {
1681     if (defined $content_attr) {
1682     $self->{onerror}->(node => $content_attr,
1683     type => 'attribute not allowed');
1684     $self->{onerror}->(node => $todo->{node},
1685     type => 'attribute missing:name|http-equiv');
1686     } else {
1687     $self->{onerror}->(node => $todo->{node},
1688     type => 'attribute missing:name|http-equiv|charset');
1689     }
1690     }
1691    
1692     ## TODO: metadata conformance
1693    
1694     ## TODO: pragma conformance
1695     if (defined $http_equiv_attr) { ## An enumerated attribute
1696     my $keyword = lc $http_equiv_attr->value; ## TODO: ascii case?
1697     if ({
1698     'refresh' => 1,
1699     'default-style' => 1,
1700     }->{$keyword}) {
1701     #
1702 wakaba 1.19 } elsif ($keyword eq 'content-type') {
1703     $self->{onerror}
1704     ->(node => $http_equiv_attr,
1705     type => 'enumerated:invalid:http-equiv:content-type');
1706 wakaba 1.1 } else {
1707     $self->{onerror}->(node => $http_equiv_attr,
1708     type => 'enumerated:invalid');
1709     }
1710     }
1711    
1712     if (defined $charset_attr) {
1713 wakaba 1.29 my $parent = $todo->{node}->manakai_parent_element;
1714     if ($parent and $parent eq $parent->owner_document->manakai_head) {
1715     for my $el (@{$parent->child_nodes}) {
1716     next unless $el->node_type == 1; # ELEMENT_NODE
1717     unless ($el eq $todo->{node}) {
1718     ## NOTE: Not the first child element.
1719     $self->{onerror}->(node => $todo->{node},
1720     type => 'element not allowed:meta charset');
1721     }
1722     last;
1723     ## NOTE: Entity references are not supported.
1724     }
1725     } else {
1726     $self->{onerror}->(node => $todo->{node},
1727     type => 'element not allowed:meta charset');
1728     }
1729    
1730 wakaba 1.1 unless ($todo->{node}->owner_document->manakai_is_html) {
1731     $self->{onerror}->(node => $charset_attr,
1732     type => 'in XML:charset');
1733     }
1734 wakaba 1.21
1735     my $charset_value = $charset_attr->value;
1736     ## NOTE: Though the case-sensitivility of |charset| attribute value
1737     ## is not explicitly spelled in the HTML5 spec, the Character Set
1738     ## registry of IANA, which is referenced from HTML5 spec, says that
1739     ## charset name is case-insensitive.
1740     $charset_value =~ tr/A-Z/a-z/; ## NOTE: ASCII Case-insensitive.
1741    
1742     require Message::Charset::Info;
1743     my $charset = $Message::Charset::Info::IANACharset->{$charset_value};
1744     my $ic = $todo->{node}->owner_document->input_encoding;
1745     if (defined $ic) {
1746     ## TODO: Test for this case
1747     my $ic_charset = $Message::Charset::Info::IANACharset->{$ic};
1748     if ($charset ne $ic_charset) {
1749     $self->{onerror}->(node => $charset_attr,
1750     type => 'mismatched charset name:'.$ic.
1751     ':'.$charset_value,
1752     level => 'm');
1753     }
1754     } else {
1755     ## NOTE: MUST, but not checkable, since the document is not originally
1756     ## in serialized form (or the parser does not preserve the input
1757     ## encoding information).
1758     $self->{onerror}->(node => $charset_attr,
1759     type => 'mismatched charset name::'.$charset_value,
1760     level => 'unsupported');
1761     }
1762    
1763     ## ISSUE: What is "valid character encoding name"? Syntactically valid?
1764     ## Syntactically valid and registered? What about x-charset names?
1765     unless (Message::Charset::Info::is_syntactically_valid_iana_charset_name
1766     ($charset_value)) {
1767     $self->{onerror}->(node => $charset_attr,
1768     type => 'charset:syntax error:'.$charset_value,
1769     level => 'm');
1770     }
1771    
1772     if ($charset) {
1773     ## ISSUE: What is "the preferred name for that encoding" (for a charset
1774     ## with no "preferred MIME name" label)?
1775     my $charset_status = $charset->{iana_names}->{$charset_value} || 0;
1776     if (($charset_status &
1777     Message::Charset::Info::PREFERRED_CHARSET_NAME ())
1778     != Message::Charset::Info::PREFERRED_CHARSET_NAME ()) {
1779     $self->{onerror}->(node => $charset_attr,
1780     type => 'charset:not preferred:'.
1781     $charset_value,
1782     level => 'm');
1783     }
1784     if (($charset_status &
1785     Message::Charset::Info::REGISTERED_CHARSET_NAME ())
1786     != Message::Charset::Info::REGISTERED_CHARSET_NAME ()) {
1787     if ($charset_value =~ /^x-/) {
1788     $self->{onerror}->(node => $charset_attr,
1789     type => 'charset:private:'.$charset_value,
1790     level => $self->{good_level});
1791     } else {
1792     $self->{onerror}->(node => $charset_attr,
1793     type => 'charset:not registered:'.
1794     $charset_value,
1795     level => $self->{good_level});
1796     }
1797     }
1798     } elsif ($charset_value =~ /^x-/) {
1799     $self->{onerror}->(node => $charset_attr,
1800     type => 'charset:private:'.$charset_value,
1801     level => $self->{good_level});
1802     } else {
1803     $self->{onerror}->(node => $charset_attr,
1804     type => 'charset:not registered:'.$charset_value,
1805     level => $self->{good_level});
1806     }
1807    
1808 wakaba 1.22 if ($charset_attr->get_user_data ('manakai_has_reference')) {
1809     $self->{onerror}->(node => $charset_attr,
1810     type => 'character reference in charset',
1811     level => $self->{must_level});
1812     }
1813 wakaba 1.1 }
1814     },
1815     checker => $HTMLEmptyChecker,
1816     };
1817    
1818     $Element->{$HTML_NS}->{style} = {
1819     attrs_checker => $GetHTMLAttrsChecker->({
1820     type => $HTMLIMTAttrChecker, ## TODO: MUST be a styling language
1821     media => $HTMLMQAttrChecker,
1822     scoped => $GetHTMLBooleanAttrChecker->('scoped'),
1823     ## NOTE: |title| has special semantics for |style|s, but is syntactically
1824     ## not different
1825     }),
1826     checker => sub {
1827 wakaba 1.27 ## NOTE: |html:style| itself has no conformance creteria on content model.
1828 wakaba 1.1 my ($self, $todo) = @_;
1829     my $type = $todo->{node}->get_attribute_ns (undef, 'type');
1830 wakaba 1.27 if (not defined $type or
1831     $type =~ m[\A(?>(?>\x0D\x0A)?[\x09\x20])*[Tt][Ee][Xx][Tt](?>(?>\x0D\x0A)?[\x09\x20])*/(?>(?>\x0D\x0A)?[\x09\x20])*[Cc][Ss][Ss](?>(?>\x0D\x0A)?[\x09\x20])*\z]) {
1832     my $el = $todo->{node};
1833     my $new_todos = [];
1834     my @nodes = (@{$el->child_nodes});
1835    
1836     my $ss_text = '';
1837     while (@nodes) {
1838     my $node = shift @nodes;
1839     $self->_remove_minuses ($node) and next if ref $node eq 'HASH';
1840    
1841     my $nt = $node->node_type;
1842     if ($nt == 1) {
1843 wakaba 1.29 my $node_ns = $node->namespace_uri;
1844     $node_ns = '' unless defined $node_ns;
1845     my $node_ln = $node->manakai_local_name;
1846     if ($self->{pluses}->{$node_ns}->{$node_ln}) {
1847     #
1848     } else {
1849     $self->{onerror}->(node => $node, type => 'element not allowed');
1850     }
1851 wakaba 1.27 my ($sib, $ch) = $self->_check_get_children ($node, $todo);
1852     unshift @nodes, @$sib;
1853     push @$new_todos, @$ch;
1854     } elsif ($nt == 3 or $nt == 4) {
1855     $ss_text .= $node->text_content;
1856     } elsif ($nt == 5) {
1857     unshift @nodes, @{$node->child_nodes};
1858     }
1859     }
1860    
1861 wakaba 1.28 $self->{onsubdoc}->({s => $ss_text, container_node => $el,
1862     media_type => 'text/css', is_char_string => 1});
1863 wakaba 1.27 return ($new_todos);
1864     } else {
1865     $self->{onerror}->(node => $todo->{node}, level => 'unsupported',
1866     type => 'style:'.$type); ## TODO: $type normalization
1867     return $AnyChecker->($self, $todo);
1868     }
1869 wakaba 1.1 },
1870     };
1871 wakaba 1.25 ## ISSUE: Relationship to significant content check?
1872 wakaba 1.1
1873     $Element->{$HTML_NS}->{body} = {
1874     attrs_checker => $GetHTMLAttrsChecker->({}),
1875 wakaba 1.29 checker => $HTMLProseContentChecker,
1876 wakaba 1.1 };
1877    
1878     $Element->{$HTML_NS}->{section} = {
1879     attrs_checker => $GetHTMLAttrsChecker->({}),
1880 wakaba 1.29 checker => $HTMLProseContentChecker,
1881 wakaba 1.1 };
1882    
1883     $Element->{$HTML_NS}->{nav} = {
1884     attrs_checker => $GetHTMLAttrsChecker->({}),
1885 wakaba 1.29 checker => $HTMLProseContentChecker,
1886 wakaba 1.1 };
1887    
1888     $Element->{$HTML_NS}->{article} = {
1889     attrs_checker => $GetHTMLAttrsChecker->({}),
1890 wakaba 1.29 checker => $HTMLProseContentChecker,
1891 wakaba 1.1 };
1892    
1893     $Element->{$HTML_NS}->{blockquote} = {
1894     attrs_checker => $GetHTMLAttrsChecker->({
1895     cite => $HTMLURIAttrChecker,
1896     }),
1897 wakaba 1.29 checker => $HTMLProseContentChecker,
1898 wakaba 1.1 };
1899    
1900     $Element->{$HTML_NS}->{aside} = {
1901     attrs_checker => $GetHTMLAttrsChecker->({}),
1902 wakaba 1.29 checker => $HTMLProseContentChecker,
1903 wakaba 1.1 };
1904    
1905     $Element->{$HTML_NS}->{h1} = {
1906     attrs_checker => $GetHTMLAttrsChecker->({}),
1907     checker => sub {
1908     my ($self, $todo) = @_;
1909 wakaba 1.24 $todo->{flag}->{has_descendant}->{hn} = 1;
1910 wakaba 1.29 return $HTMLPhrasingContentChecker->($self, $todo);
1911 wakaba 1.1 },
1912     };
1913    
1914     $Element->{$HTML_NS}->{h2} = {
1915     attrs_checker => $GetHTMLAttrsChecker->({}),
1916     checker => $Element->{$HTML_NS}->{h1}->{checker},
1917     };
1918    
1919     $Element->{$HTML_NS}->{h3} = {
1920     attrs_checker => $GetHTMLAttrsChecker->({}),
1921     checker => $Element->{$HTML_NS}->{h1}->{checker},
1922     };
1923    
1924     $Element->{$HTML_NS}->{h4} = {
1925     attrs_checker => $GetHTMLAttrsChecker->({}),
1926     checker => $Element->{$HTML_NS}->{h1}->{checker},
1927     };
1928    
1929     $Element->{$HTML_NS}->{h5} = {
1930     attrs_checker => $GetHTMLAttrsChecker->({}),
1931     checker => $Element->{$HTML_NS}->{h1}->{checker},
1932     };
1933    
1934     $Element->{$HTML_NS}->{h6} = {
1935     attrs_checker => $GetHTMLAttrsChecker->({}),
1936     checker => $Element->{$HTML_NS}->{h1}->{checker},
1937     };
1938    
1939 wakaba 1.29 ## TODO: Explicit sectioning is "encouraged".
1940    
1941 wakaba 1.1 $Element->{$HTML_NS}->{header} = {
1942     attrs_checker => $GetHTMLAttrsChecker->({}),
1943     checker => sub {
1944     my ($self, $todo) = @_;
1945 wakaba 1.24
1946     my $old_flags = {hn => $todo->{flag}->{has_descendant}->{hn}};
1947     $todo->{flag}->{has_descendant}->{hn} = 0;
1948 wakaba 1.1
1949     my $end = $self->_add_minuses
1950     ({$HTML_NS => {qw/header 1 footer 1/}},
1951 wakaba 1.29 $HTMLSectioningContent);
1952     my ($new_todos, $ch) = $HTMLProseContentChecker->($self, $todo);
1953 wakaba 1.24 push @$new_todos, $end,
1954     {type => 'descendant', node => $todo->{node},
1955     flag => $todo->{flag}, old_values => $old_flags,
1956     errors => {
1957     hn => sub {
1958     my ($self, $todo) = @_;
1959     $self->{onerror}->(node => $todo->{node},
1960     type => 'element missing:hn');
1961     },
1962 wakaba 1.1 }};
1963     return ($new_todos, $ch);
1964 wakaba 1.24
1965     ## ISSUE: <header><del><h1>...</h1></del></header> is conforming?
1966 wakaba 1.1 },
1967     };
1968    
1969     $Element->{$HTML_NS}->{footer} = {
1970     attrs_checker => $GetHTMLAttrsChecker->({}),
1971 wakaba 1.29 checker => sub {
1972 wakaba 1.1 my ($self, $todo) = @_;
1973 wakaba 1.25
1974 wakaba 1.29 my $old_flags = {hn => $todo->{flag}->{has_descendant}->{hn}};
1975     $todo->{flag}->{has_descendant}->{hn} = 0;
1976 wakaba 1.1
1977     my $end = $self->_add_minuses
1978 wakaba 1.29 ({$HTML_NS => {footer => 1}},
1979     $HTMLSectioningContent, $HTMLHeadingContent);
1980     my ($new_todos, $ch) = $HTMLProseContentChecker->($self, $todo);
1981 wakaba 1.1 push @$new_todos, $end;
1982    
1983 wakaba 1.29 return ($new_todos, $ch);
1984 wakaba 1.1 },
1985     };
1986    
1987     $Element->{$HTML_NS}->{address} = {
1988     attrs_checker => $GetHTMLAttrsChecker->({}),
1989 wakaba 1.29 checker => sub {
1990     my ($self, $todo) = @_;
1991    
1992     my $old_flags = {hn => $todo->{flag}->{has_descendant}->{hn}};
1993     $todo->{flag}->{has_descendant}->{hn} = 0;
1994    
1995     my $end = $self->_add_minuses
1996     ({$HTML_NS => {footer => 1, address => 1}},
1997     $HTMLSectioningContent, $HTMLHeadingContent);
1998     my ($new_todos, $ch) = $HTMLProseContentChecker->($self, $todo);
1999     push @$new_todos, $end;
2000    
2001     return ($new_todos, $ch);
2002     },
2003 wakaba 1.1 };
2004    
2005     $Element->{$HTML_NS}->{p} = {
2006     attrs_checker => $GetHTMLAttrsChecker->({}),
2007 wakaba 1.29 checker => $HTMLPhrasingContentChecker,
2008 wakaba 1.1 };
2009    
2010     $Element->{$HTML_NS}->{hr} = {
2011     attrs_checker => $GetHTMLAttrsChecker->({}),
2012     checker => $HTMLEmptyChecker,
2013     };
2014    
2015     $Element->{$HTML_NS}->{br} = {
2016     attrs_checker => $GetHTMLAttrsChecker->({}),
2017     checker => $HTMLEmptyChecker,
2018 wakaba 1.29 ## NOTE: Blank line MUST NOT be used for presentation purpose.
2019     ## (This requirement is semantic so that we cannot check.)
2020 wakaba 1.1 };
2021    
2022     $Element->{$HTML_NS}->{dialog} = {
2023     attrs_checker => $GetHTMLAttrsChecker->({}),
2024     checker => sub {
2025     my ($self, $todo) = @_;
2026     my $el = $todo->{node};
2027     my $new_todos = [];
2028     my @nodes = (@{$el->child_nodes});
2029    
2030     my $phase = 'before dt';
2031     while (@nodes) {
2032     my $node = shift @nodes;
2033     $self->_remove_minuses ($node) and next if ref $node eq 'HASH';
2034    
2035     my $nt = $node->node_type;
2036     if ($nt == 1) {
2037     my $node_ns = $node->namespace_uri;
2038     $node_ns = '' unless defined $node_ns;
2039     my $node_ln = $node->manakai_local_name;
2040     ## NOTE: |minuses| list is not checked since redundant
2041 wakaba 1.8 if ($self->{pluses}->{$node_ns}->{$node_ln}) {
2042     #
2043     } elsif ($phase eq 'before dt') {
2044 wakaba 1.1 if ($node_ns eq $HTML_NS and $node_ln eq 'dt') {
2045     $phase = 'before dd';
2046     } elsif ($node_ns eq $HTML_NS and $node_ln eq 'dd') {
2047     $self->{onerror}
2048     ->(node => $node, type => 'ps element missing:dt');
2049     $phase = 'before dt';
2050     } else {
2051     $self->{onerror}->(node => $node, type => 'element not allowed');
2052     }
2053     } else { # before dd
2054     if ($node_ns eq $HTML_NS and $node_ln eq 'dd') {
2055     $phase = 'before dt';
2056     } elsif ($node_ns eq $HTML_NS and $node_ln eq 'dt') {
2057     $self->{onerror}
2058     ->(node => $node, type => 'ps element missing:dd');
2059     $phase = 'before dd';
2060     } else {
2061     $self->{onerror}->(node => $node, type => 'element not allowed');
2062     }
2063     }
2064     my ($sib, $ch) = $self->_check_get_children ($node, $todo);
2065     unshift @nodes, @$sib;
2066     push @$new_todos, @$ch;
2067     } elsif ($nt == 3 or $nt == 4) {
2068     if ($node->data =~ /[^\x09-\x0D\x20]/) {
2069     $self->{onerror}->(node => $node, type => 'character not allowed');
2070 wakaba 1.25 $todo->{flag}->{has_descendant}->{significant} = 1;
2071 wakaba 1.1 }
2072     } elsif ($nt == 5) {
2073     unshift @nodes, @{$node->child_nodes};
2074     }
2075     }
2076     if ($phase eq 'before dd') {
2077 wakaba 1.8 $self->{onerror}->(node => $el, type => 'child element missing:dd');
2078 wakaba 1.1 }
2079     return ($new_todos);
2080     },
2081     };
2082    
2083     $Element->{$HTML_NS}->{pre} = {
2084     attrs_checker => $GetHTMLAttrsChecker->({}),
2085 wakaba 1.29 checker => $HTMLPhrasingContentChecker,
2086 wakaba 1.1 };
2087    
2088     $Element->{$HTML_NS}->{ol} = {
2089     attrs_checker => $GetHTMLAttrsChecker->({
2090     start => $HTMLIntegerAttrChecker,
2091     }),
2092     checker => sub {
2093     my ($self, $todo) = @_;
2094     my $el = $todo->{node};
2095     my $new_todos = [];
2096     my @nodes = (@{$el->child_nodes});
2097    
2098     while (@nodes) {
2099     my $node = shift @nodes;
2100     $self->_remove_minuses ($node) and next if ref $node eq 'HASH';
2101    
2102     my $nt = $node->node_type;
2103     if ($nt == 1) {
2104     my $node_ns = $node->namespace_uri;
2105     $node_ns = '' unless defined $node_ns;
2106     my $node_ln = $node->manakai_local_name;
2107     ## NOTE: |minuses| list is not checked since redundant
2108 wakaba 1.8 if ($self->{pluses}->{$node_ns}->{$node_ln}) {
2109     #
2110     } elsif (not ($node_ns eq $HTML_NS and $node_ln eq 'li')) {
2111 wakaba 1.1 $self->{onerror}->(node => $node, type => 'element not allowed');
2112     }
2113     my ($sib, $ch) = $self->_check_get_children ($node, $todo);
2114     unshift @nodes, @$sib;
2115     push @$new_todos, @$ch;
2116     } elsif ($nt == 3 or $nt == 4) {
2117     if ($node->data =~ /[^\x09-\x0D\x20]/) {
2118     $self->{onerror}->(node => $node, type => 'character not allowed');
2119 wakaba 1.25 $todo->{flag}->{has_descendant}->{significant} = 1;
2120 wakaba 1.1 }
2121     } elsif ($nt == 5) {
2122     unshift @nodes, @{$node->child_nodes};
2123     }
2124     }
2125    
2126     if ($todo->{inline}) {
2127     for (@$new_todos) {
2128     $_->{inline} = 1;
2129     }
2130     }
2131     return ($new_todos);
2132     },
2133     };
2134    
2135     $Element->{$HTML_NS}->{ul} = {
2136     attrs_checker => $GetHTMLAttrsChecker->({}),
2137     checker => $Element->{$HTML_NS}->{ol}->{checker},
2138     };
2139    
2140     $Element->{$HTML_NS}->{li} = {
2141     attrs_checker => $GetHTMLAttrsChecker->({
2142     start => sub {
2143     my ($self, $attr) = @_;
2144     my $parent = $attr->owner_element->manakai_parent_element;
2145     if (defined $parent) {
2146     my $parent_ns = $parent->namespace_uri;
2147     $parent_ns = '' unless defined $parent_ns;
2148     my $parent_ln = $parent->manakai_local_name;
2149     unless ($parent_ns eq $HTML_NS and $parent_ln eq 'ol') {
2150     $self->{onerror}->(node => $attr, level => 'unsupported',
2151     type => 'attribute');
2152     }
2153     }
2154     $HTMLIntegerAttrChecker->($self, $attr);
2155     },
2156     }),
2157     checker => sub {
2158     my ($self, $todo) = @_;
2159 wakaba 1.29 if ($todo->{flag}->{in_menu}) {
2160     return $HTMLPhrasingContentChecker->($self, $todo);
2161 wakaba 1.1 } else {
2162 wakaba 1.29 return $HTMLProseContentChecker->($self, $todo);
2163 wakaba 1.1 }
2164     },
2165     };
2166    
2167     $Element->{$HTML_NS}->{dl} = {
2168     attrs_checker => $GetHTMLAttrsChecker->({}),
2169     checker => sub {
2170     my ($self, $todo) = @_;
2171     my $el = $todo->{node};
2172     my $new_todos = [];
2173     my @nodes = (@{$el->child_nodes});
2174    
2175     my $phase = 'before dt';
2176     while (@nodes) {
2177     my $node = shift @nodes;
2178     $self->_remove_minuses ($node) and next if ref $node eq 'HASH';
2179    
2180     my $nt = $node->node_type;
2181     if ($nt == 1) {
2182     my $node_ns = $node->namespace_uri;
2183     $node_ns = '' unless defined $node_ns;
2184     my $node_ln = $node->manakai_local_name;
2185     ## NOTE: |minuses| list is not checked since redundant
2186 wakaba 1.8 if ($self->{pluses}->{$node_ns}->{$node_ln}) {
2187     #
2188     } elsif ($phase eq 'in dds') {
2189 wakaba 1.1 if ($node_ns eq $HTML_NS and $node_ln eq 'dd') {
2190     #$phase = 'in dds';
2191     } elsif ($node_ns eq $HTML_NS and $node_ln eq 'dt') {
2192     $phase = 'in dts';
2193     } else {
2194     $self->{onerror}->(node => $node, type => 'element not allowed');
2195     }
2196     } elsif ($phase eq 'in dts') {
2197     if ($node_ns eq $HTML_NS and $node_ln eq 'dt') {
2198     #$phase = 'in dts';
2199     } elsif ($node_ns eq $HTML_NS and $node_ln eq 'dd') {
2200     $phase = 'in dds';
2201     } else {
2202     $self->{onerror}->(node => $node, type => 'element not allowed');
2203     }
2204     } else { # before dt
2205     if ($node_ns eq $HTML_NS and $node_ln eq 'dt') {
2206     $phase = 'in dts';
2207     } elsif ($node_ns eq $HTML_NS and $node_ln eq 'dd') {
2208     $self->{onerror}
2209     ->(node => $node, type => 'ps element missing:dt');
2210     $phase = 'in dds';
2211     } else {
2212     $self->{onerror}->(node => $node, type => 'element not allowed');
2213     }
2214     }
2215     my ($sib, $ch) = $self->_check_get_children ($node, $todo);
2216     unshift @nodes, @$sib;
2217     push @$new_todos, @$ch;
2218     } elsif ($nt == 3 or $nt == 4) {
2219     if ($node->data =~ /[^\x09-\x0D\x20]/) {
2220     $self->{onerror}->(node => $node, type => 'character not allowed');
2221 wakaba 1.25 $todo->{flag}->{has_descendant}->{significant} = 1;
2222 wakaba 1.1 }
2223     } elsif ($nt == 5) {
2224     unshift @nodes, @{$node->child_nodes};
2225     }
2226     }
2227     if ($phase eq 'in dts') {
2228 wakaba 1.8 $self->{onerror}->(node => $el, type => 'child element missing:dd');
2229 wakaba 1.1 }
2230    
2231     if ($todo->{inline}) {
2232     for (@$new_todos) {
2233     $_->{inline} = 1;
2234     }
2235     }
2236     return ($new_todos);
2237     },
2238     };
2239    
2240     $Element->{$HTML_NS}->{dt} = {
2241     attrs_checker => $GetHTMLAttrsChecker->({}),
2242 wakaba 1.29 checker => $HTMLPhrasingContentChecker,
2243 wakaba 1.1 };
2244    
2245     $Element->{$HTML_NS}->{dd} = {
2246     attrs_checker => $GetHTMLAttrsChecker->({}),
2247 wakaba 1.29 checker => $HTMLProseContentChecker,
2248 wakaba 1.1 };
2249    
2250     $Element->{$HTML_NS}->{a} = {
2251     attrs_checker => sub {
2252     my ($self, $todo) = @_;
2253     my %attr;
2254     for my $attr (@{$todo->{node}->attributes}) {
2255     my $attr_ns = $attr->namespace_uri;
2256     $attr_ns = '' unless defined $attr_ns;
2257     my $attr_ln = $attr->manakai_local_name;
2258     my $checker;
2259     if ($attr_ns eq '') {
2260     $checker = {
2261     target => $HTMLTargetAttrChecker,
2262     href => $HTMLURIAttrChecker,
2263     ping => $HTMLSpaceURIsAttrChecker,
2264 wakaba 1.4 rel => sub { $HTMLLinkTypesAttrChecker->(1, $todo, @_) },
2265 wakaba 1.1 media => $HTMLMQAttrChecker,
2266     hreflang => $HTMLLanguageTagAttrChecker,
2267     type => $HTMLIMTAttrChecker,
2268     }->{$attr_ln};
2269     if ($checker) {
2270     $attr{$attr_ln} = $attr;
2271     } else {
2272     $checker = $HTMLAttrChecker->{$attr_ln};
2273     }
2274     }
2275     $checker ||= $AttrChecker->{$attr_ns}->{$attr_ln}
2276     || $AttrChecker->{$attr_ns}->{''};
2277     if ($checker) {
2278     $checker->($self, $attr) if ref $checker;
2279     } else {
2280     $self->{onerror}->(node => $attr, level => 'unsupported',
2281     type => 'attribute');
2282     ## ISSUE: No comformance createria for unknown attributes in the spec
2283     }
2284     }
2285    
2286 wakaba 1.4 if (defined $attr{href}) {
2287     $self->{has_hyperlink_element} = 1;
2288     } else {
2289 wakaba 1.1 for (qw/target ping rel media hreflang type/) {
2290     if (defined $attr{$_}) {
2291     $self->{onerror}->(node => $attr{$_},
2292     type => 'attribute not allowed');
2293     }
2294     }
2295     }
2296     },
2297     checker => sub {
2298     my ($self, $todo) = @_;
2299    
2300     my $end = $self->_add_minuses ($HTMLInteractiveElements);
2301 wakaba 1.29 my ($new_todos, $ch) = $HTMLPhrasingContentChecker->($self, $todo);
2302 wakaba 1.1 push @$new_todos, $end;
2303    
2304 wakaba 1.15 if ($todo->{node}->has_attribute_ns (undef, 'href')) {
2305     $_->{flag}->{in_a_href} = 1 for @$new_todos;
2306     }
2307 wakaba 1.1
2308     return ($new_todos, $ch);
2309     },
2310     };
2311    
2312     $Element->{$HTML_NS}->{q} = {
2313     attrs_checker => $GetHTMLAttrsChecker->({
2314     cite => $HTMLURIAttrChecker,
2315     }),
2316 wakaba 1.29 checker => $HTMLPhrasingContentChecker,
2317 wakaba 1.1 };
2318    
2319     $Element->{$HTML_NS}->{cite} = {
2320     attrs_checker => $GetHTMLAttrsChecker->({}),
2321 wakaba 1.29 checker => $HTMLPhrasingContentChecker,
2322 wakaba 1.1 };
2323    
2324     $Element->{$HTML_NS}->{em} = {
2325     attrs_checker => $GetHTMLAttrsChecker->({}),
2326 wakaba 1.29 checker => $HTMLPhrasingContentChecker,
2327 wakaba 1.1 };
2328    
2329     $Element->{$HTML_NS}->{strong} = {
2330     attrs_checker => $GetHTMLAttrsChecker->({}),
2331 wakaba 1.29 checker => $HTMLPhrasingContentChecker,
2332 wakaba 1.1 };
2333    
2334     $Element->{$HTML_NS}->{small} = {
2335     attrs_checker => $GetHTMLAttrsChecker->({}),
2336 wakaba 1.29 checker => $HTMLPhrasingContentChecker,
2337 wakaba 1.1 };
2338    
2339     $Element->{$HTML_NS}->{m} = {
2340     attrs_checker => $GetHTMLAttrsChecker->({}),
2341 wakaba 1.29 checker => $HTMLPhrasingContentChecker,
2342 wakaba 1.1 };
2343    
2344     $Element->{$HTML_NS}->{dfn} = {
2345     attrs_checker => $GetHTMLAttrsChecker->({}),
2346     checker => sub {
2347     my ($self, $todo) = @_;
2348    
2349     my $end = $self->_add_minuses ({$HTML_NS => {dfn => 1}});
2350 wakaba 1.29 my ($sib, $ch) = $HTMLPhrasingContentChecker->($self, $todo);
2351 wakaba 1.1 push @$sib, $end;
2352    
2353     my $node = $todo->{node};
2354     my $term = $node->get_attribute_ns (undef, 'title');
2355     unless (defined $term) {
2356     for my $child (@{$node->child_nodes}) {
2357     if ($child->node_type == 1) { # ELEMENT_NODE
2358     if (defined $term) {
2359     undef $term;
2360     last;
2361     } elsif ($child->manakai_local_name eq 'abbr') {
2362     my $nsuri = $child->namespace_uri;
2363     if (defined $nsuri and $nsuri eq $HTML_NS) {
2364     my $attr = $child->get_attribute_node_ns (undef, 'title');
2365     if ($attr) {
2366     $term = $attr->value;
2367     }
2368     }
2369     }
2370     } elsif ($child->node_type == 3 or $child->node_type == 4) {
2371     ## TEXT_NODE or CDATA_SECTION_NODE
2372     if ($child->data =~ /\A[\x09-\x0D\x20]+\z/) { # Inter-element whitespace
2373     next;
2374     }
2375     undef $term;
2376     last;
2377     }
2378     }
2379     unless (defined $term) {
2380     $term = $node->text_content;
2381     }
2382     }
2383     if ($self->{term}->{$term}) {
2384     $self->{onerror}->(node => $node, type => 'duplicate term');
2385     push @{$self->{term}->{$term}}, $node;
2386     } else {
2387     $self->{term}->{$term} = [$node];
2388     }
2389     ## ISSUE: The HTML5 algorithm does not work with |ruby| unless |dfn|
2390     ## has |title|.
2391    
2392     return ($sib, $ch);
2393     },
2394     };
2395    
2396     $Element->{$HTML_NS}->{abbr} = {
2397     attrs_checker => $GetHTMLAttrsChecker->({
2398     ## NOTE: |title| has special semantics for |abbr|s, but is syntactically
2399     ## not different. The spec says that the |title| MAY be omitted
2400     ## if there is a |dfn| whose defining term is the abbreviation,
2401     ## but it does not prohibit |abbr| w/o |title| in other cases.
2402     }),
2403 wakaba 1.29 checker => $HTMLPhrasingContentChecker,
2404 wakaba 1.1 };
2405    
2406     $Element->{$HTML_NS}->{time} = {
2407     attrs_checker => $GetHTMLAttrsChecker->({
2408     datetime => sub { 1 }, # checked in |checker|
2409     }),
2410     ## TODO: Write tests
2411     checker => sub {
2412     my ($self, $todo) = @_;
2413    
2414     my $attr = $todo->{node}->get_attribute_node_ns (undef, 'datetime');
2415     my $input;
2416     my $reg_sp;
2417     my $input_node;
2418     if ($attr) {
2419     $input = $attr->value;
2420     $reg_sp = qr/[\x09-\x0D\x20]*/;
2421     $input_node = $attr;
2422     } else {
2423     $input = $todo->{node}->text_content;
2424     $reg_sp = qr/\p{Zs}*/;
2425     $input_node = $todo->{node};
2426    
2427     ## ISSUE: What is the definition for "successfully extracts a date
2428     ## or time"? If the algorithm says the string is invalid but
2429     ## return some date or time, is it "successfully"?
2430     }
2431    
2432     my $hour;
2433     my $minute;
2434     my $second;
2435     if ($input =~ /
2436     \A
2437     [\x09-\x0D\x20]*
2438     ([0-9]+) # 1
2439     (?>
2440     -([0-9]+) # 2
2441     -([0-9]+) # 3
2442     [\x09-\x0D\x20]*
2443     (?>
2444     T
2445     [\x09-\x0D\x20]*
2446     )?
2447     ([0-9]+) # 4
2448     :([0-9]+) # 5
2449     (?>
2450     :([0-9]+(?>\.[0-9]*)?|\.[0-9]*) # 6
2451     )?
2452     [\x09-\x0D\x20]*
2453     (?>
2454     Z
2455     [\x09-\x0D\x20]*
2456     |
2457     [+-]([0-9]+):([0-9]+) # 7, 8
2458     [\x09-\x0D\x20]*
2459     )?
2460     \z
2461     |
2462     :([0-9]+) # 9
2463     (?>
2464     :([0-9]+(?>\.[0-9]*)?|\.[0-9]*) # 10
2465     )?
2466     [\x09-\x0D\x20]*\z
2467     )
2468     /x) {
2469     if (defined $2) { ## YYYY-MM-DD T? hh:mm
2470     if (length $1 != 4 or length $2 != 2 or length $3 != 2 or
2471     length $4 != 2 or length $5 != 2) {
2472     $self->{onerror}->(node => $input_node,
2473     type => 'dateortime:syntax error');
2474     }
2475    
2476     if (1 <= $2 and $2 <= 12) {
2477     $self->{onerror}->(node => $input_node, type => 'datetime:bad day')
2478     if $3 < 1 or
2479     $3 > [0, 31, 29, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31]->[$2];
2480     $self->{onerror}->(node => $input_node, type => 'datetime:bad day')
2481     if $2 == 2 and $3 == 29 and
2482     not ($1 % 400 == 0 or ($1 % 4 == 0 and $1 % 100 != 0));
2483     } else {
2484     $self->{onerror}->(node => $input_node,
2485     type => 'datetime:bad month');
2486     }
2487    
2488     ($hour, $minute, $second) = ($4, $5, $6);
2489    
2490     if (defined $7) { ## [+-]hh:mm
2491     if (length $7 != 2 or length $8 != 2) {
2492     $self->{onerror}->(node => $input_node,
2493     type => 'dateortime:syntax error');
2494     }
2495    
2496     $self->{onerror}->(node => $input_node,
2497     type => 'datetime:bad timezone hour')
2498     if $7 > 23;
2499     $self->{onerror}->(node => $input_node,
2500     type => 'datetime:bad timezone minute')
2501     if $8 > 59;
2502     }
2503     } else { ## hh:mm
2504     if (length $1 != 2 or length $9 != 2) {
2505     $self->{onerror}->(node => $input_node,
2506     type => qq'dateortime:syntax error');
2507     }
2508    
2509     ($hour, $minute, $second) = ($1, $9, $10);
2510     }
2511    
2512     $self->{onerror}->(node => $input_node, type => 'datetime:bad hour')
2513     if $hour > 23;
2514     $self->{onerror}->(node => $input_node, type => 'datetime:bad minute')
2515     if $minute > 59;
2516    
2517     if (defined $second) { ## s
2518     ## NOTE: Integer part of second don't have to have length of two.
2519    
2520     if (substr ($second, 0, 1) eq '.') {
2521     $self->{onerror}->(node => $input_node,
2522     type => 'dateortime:syntax error');
2523     }
2524    
2525     $self->{onerror}->(node => $input_node, type => 'datetime:bad second')
2526     if $second >= 60;
2527     }
2528     } else {
2529     $self->{onerror}->(node => $input_node,
2530     type => 'dateortime:syntax error');
2531     }
2532    
2533 wakaba 1.29 return $HTMLPhrasingContentChecker->($self, $todo);
2534 wakaba 1.1 },
2535     };
2536    
2537     $Element->{$HTML_NS}->{meter} = { ## TODO: "The recommended way of giving the value is to include it as contents of the element"
2538     attrs_checker => $GetHTMLAttrsChecker->({
2539     value => $GetHTMLFloatingPointNumberAttrChecker->(sub { 1 }),
2540     min => $GetHTMLFloatingPointNumberAttrChecker->(sub { 1 }),
2541     low => $GetHTMLFloatingPointNumberAttrChecker->(sub { 1 }),
2542     high => $GetHTMLFloatingPointNumberAttrChecker->(sub { 1 }),
2543     max => $GetHTMLFloatingPointNumberAttrChecker->(sub { 1 }),
2544     optimum => $GetHTMLFloatingPointNumberAttrChecker->(sub { 1 }),
2545     }),
2546 wakaba 1.29 checker => $HTMLPhrasingContentChecker,
2547 wakaba 1.1 };
2548    
2549     $Element->{$HTML_NS}->{progress} = { ## TODO: recommended to use content
2550     attrs_checker => $GetHTMLAttrsChecker->({
2551     value => $GetHTMLFloatingPointNumberAttrChecker->(sub { shift >= 0 }),
2552     max => $GetHTMLFloatingPointNumberAttrChecker->(sub { shift > 0 }),
2553     }),
2554 wakaba 1.29 checker => $HTMLPhrasingContentChecker,
2555 wakaba 1.1 };
2556    
2557     $Element->{$HTML_NS}->{code} = {
2558     attrs_checker => $GetHTMLAttrsChecker->({}),
2559     ## NOTE: Though |title| has special semantics,
2560     ## syntatically same as the |title| as global attribute.
2561 wakaba 1.29 checker => $HTMLPhrasingContentChecker,
2562 wakaba 1.1 };
2563    
2564     $Element->{$HTML_NS}->{var} = {
2565     attrs_checker => $GetHTMLAttrsChecker->({}),
2566     ## NOTE: Though |title| has special semantics,
2567     ## syntatically same as the |title| as global attribute.
2568 wakaba 1.29 checker => $HTMLPhrasingContentChecker,
2569 wakaba 1.1 };
2570    
2571     $Element->{$HTML_NS}->{samp} = {
2572     attrs_checker => $GetHTMLAttrsChecker->({}),
2573     ## NOTE: Though |title| has special semantics,
2574     ## syntatically same as the |title| as global attribute.
2575 wakaba 1.29 checker => $HTMLPhrasingContentChecker,
2576 wakaba 1.1 };
2577    
2578     $Element->{$HTML_NS}->{kbd} = {
2579     attrs_checker => $GetHTMLAttrsChecker->({}),
2580 wakaba 1.29 checker => $HTMLPhrasingContentChecker,
2581 wakaba 1.1 };
2582    
2583     $Element->{$HTML_NS}->{sub} = {
2584     attrs_checker => $GetHTMLAttrsChecker->({}),
2585 wakaba 1.29 checker => $HTMLPhrasingContentChecker,
2586 wakaba 1.1 };
2587    
2588     $Element->{$HTML_NS}->{sup} = {
2589     attrs_checker => $GetHTMLAttrsChecker->({}),
2590 wakaba 1.29 checker => $HTMLPhrasingContentChecker,
2591 wakaba 1.1 };
2592    
2593     $Element->{$HTML_NS}->{span} = {
2594     attrs_checker => $GetHTMLAttrsChecker->({}),
2595     ## NOTE: Though |title| has special semantics,
2596     ## syntatically same as the |title| as global attribute.
2597 wakaba 1.29 checker => $HTMLPhrasingContentChecker,
2598 wakaba 1.1 };
2599    
2600     $Element->{$HTML_NS}->{i} = {
2601     attrs_checker => $GetHTMLAttrsChecker->({}),
2602     ## NOTE: Though |title| has special semantics,
2603     ## syntatically same as the |title| as global attribute.
2604 wakaba 1.29 checker => $HTMLPhrasingContentChecker,
2605 wakaba 1.1 };
2606    
2607     $Element->{$HTML_NS}->{b} = {
2608     attrs_checker => $GetHTMLAttrsChecker->({}),
2609 wakaba 1.29 checker => $HTMLPhrasingContentChecker,
2610 wakaba 1.1 };
2611    
2612     $Element->{$HTML_NS}->{bdo} = {
2613     attrs_checker => sub {
2614     my ($self, $todo) = @_;
2615     $GetHTMLAttrsChecker->({})->($self, $todo);
2616     unless ($todo->{node}->has_attribute_ns (undef, 'dir')) {
2617     $self->{onerror}->(node => $todo->{node}, type => 'attribute missing:dir');
2618     }
2619     },
2620     ## ISSUE: The spec does not directly say that |dir| is a enumerated attr.
2621 wakaba 1.29 checker => $HTMLPhrasingContentChecker,
2622 wakaba 1.1 };
2623    
2624 wakaba 1.29 =pod
2625    
2626     ## TODO:
2627    
2628     +
2629     + <p>Partly because of the confusion described above, authors are
2630     + strongly recommended to always mark up all paragraphs with the
2631     + <code>p</code> element, and to not have any <code>ins</code> or
2632     + <code>del</code> elements that cross across any <span
2633     + title="paragraph">implied paragraphs</span>.</p>
2634     +
2635     (An informative note)
2636    
2637     <p><code>ins</code> elements should not cross <span
2638     + title="paragraph">implied paragraph</span> boundaries.</p>
2639     (normative)
2640    
2641     + <p><code>del</code> elements should not cross <span
2642     + title="paragraph">implied paragraph</span> boundaries.</p>
2643     (normative)
2644    
2645     =cut
2646    
2647 wakaba 1.1 $Element->{$HTML_NS}->{ins} = {
2648     attrs_checker => $GetHTMLAttrsChecker->({
2649     cite => $HTMLURIAttrChecker,
2650     datetime => $HTMLDatetimeAttrChecker,
2651     }),
2652     checker => $HTMLTransparentChecker,
2653     };
2654    
2655     $Element->{$HTML_NS}->{del} = {
2656     attrs_checker => $GetHTMLAttrsChecker->({
2657     cite => $HTMLURIAttrChecker,
2658     datetime => $HTMLDatetimeAttrChecker,
2659     }),
2660     checker => sub {
2661     my ($self, $todo) = @_;
2662 wakaba 1.29 my $sig_flag = $todo->{flag}->{has_descendant}->{significant};
2663     my ($new_todos) = $HTMLTransparentChecker->($self, $todo);
2664     push @$new_todos, {type => 'code', code => sub {
2665     $todo->{flag}->{has_descendant}->{significant} = 0;
2666     }} if not $sig_flag;
2667     return $new_todos;
2668 wakaba 1.1 },
2669     };
2670    
2671     ## TODO: figure
2672 wakaba 1.8 ## TODO: Test for <nest/> in <figure/>
2673 wakaba 1.1
2674 wakaba 1.4 ## TODO: |alt|
2675 wakaba 1.1 $Element->{$HTML_NS}->{img} = {
2676     attrs_checker => sub {
2677     my ($self, $todo) = @_;
2678     $GetHTMLAttrsChecker->({
2679     alt => sub { }, ## NOTE: No syntactical requirement
2680     src => $HTMLURIAttrChecker,
2681     usemap => $HTMLUsemapAttrChecker,
2682     ismap => sub {
2683     my ($self, $attr, $parent_todo) = @_;
2684 wakaba 1.15 if (not $todo->{flag}->{in_a_href}) {
2685     $self->{onerror}->(node => $attr,
2686     type => 'attribute not allowed:ismap');
2687 wakaba 1.1 }
2688     $GetHTMLBooleanAttrChecker->('ismap')->($self, $attr, $parent_todo);
2689     },
2690     ## TODO: height
2691     ## TODO: width
2692     })->($self, $todo);
2693     unless ($todo->{node}->has_attribute_ns (undef, 'alt')) {
2694     $self->{onerror}->(node => $todo->{node}, type => 'attribute missing:alt');
2695     }
2696     unless ($todo->{node}->has_attribute_ns (undef, 'src')) {
2697     $self->{onerror}->(node => $todo->{node}, type => 'attribute missing:src');
2698     }
2699     },
2700 wakaba 1.25 checker => sub {
2701     my ($self, $todo) = @_;
2702     $todo->{flag}->{has_descendant}->{significant} = 1;
2703     return $HTMLEmptyChecker->($self, $todo);
2704     },
2705 wakaba 1.1 };
2706    
2707     $Element->{$HTML_NS}->{iframe} = {
2708     attrs_checker => $GetHTMLAttrsChecker->({
2709     src => $HTMLURIAttrChecker,
2710     }),
2711 wakaba 1.25 checker => sub {
2712     my ($self, $todo) = @_;
2713     $todo->{flag}->{has_descendant}->{significant} = 1;
2714     return $HTMLTextChecker->($self, $todo);
2715     },
2716 wakaba 1.1 };
2717    
2718     $Element->{$HTML_NS}->{embed} = {
2719     attrs_checker => sub {
2720     my ($self, $todo) = @_;
2721     my $has_src;
2722     for my $attr (@{$todo->{node}->attributes}) {
2723     my $attr_ns = $attr->namespace_uri;
2724     $attr_ns = '' unless defined $attr_ns;
2725     my $attr_ln = $attr->manakai_local_name;
2726     my $checker;
2727     if ($attr_ns eq '') {
2728     if ($attr_ln eq 'src') {
2729     $checker = $HTMLURIAttrChecker;
2730     $has_src = 1;
2731     } elsif ($attr_ln eq 'type') {
2732     $checker = $HTMLIMTAttrChecker;
2733     } else {
2734     ## TODO: height
2735     ## TODO: width
2736     $checker = $HTMLAttrChecker->{$attr_ln}
2737     || sub { }; ## NOTE: Any local attribute is ok.
2738     }
2739     }
2740     $checker ||= $AttrChecker->{$attr_ns}->{$attr_ln}
2741     || $AttrChecker->{$attr_ns}->{''};
2742     if ($checker) {
2743     $checker->($self, $attr);
2744     } else {
2745     $self->{onerror}->(node => $attr, level => 'unsupported',
2746     type => 'attribute');
2747     ## ISSUE: No comformance createria for global attributes in the spec
2748     }
2749     }
2750    
2751     unless ($has_src) {
2752     $self->{onerror}->(node => $todo->{node},
2753     type => 'attribute missing:src');
2754     }
2755     },
2756 wakaba 1.25 checker => sub {
2757     my ($self, $todo) = @_;
2758     $todo->{flag}->{has_descendant}->{significant} = 1;
2759     return $HTMLEmptyChecker->($self, $todo);
2760     },
2761 wakaba 1.1 };
2762    
2763     $Element->{$HTML_NS}->{object} = {
2764     attrs_checker => sub {
2765     my ($self, $todo) = @_;
2766     $GetHTMLAttrsChecker->({
2767     data => $HTMLURIAttrChecker,
2768     type => $HTMLIMTAttrChecker,
2769     usemap => $HTMLUsemapAttrChecker,
2770     ## TODO: width
2771     ## TODO: height
2772     })->($self, $todo);
2773     unless ($todo->{node}->has_attribute_ns (undef, 'data')) {
2774     unless ($todo->{node}->has_attribute_ns (undef, 'type')) {
2775     $self->{onerror}->(node => $todo->{node},
2776     type => 'attribute missing:data|type');
2777     }
2778     }
2779     },
2780 wakaba 1.29 ## NOTE: param*, then transparent.
2781 wakaba 1.25 checker => sub {
2782     my ($self, $todo) = @_;
2783     $todo->{flag}->{has_descendant}->{significant} = 1;
2784     return $ElementDefault->{checker}->($self, $todo); ## TODO
2785     },
2786 wakaba 1.8 ## TODO: Tests for <nest/> in <object/>
2787 wakaba 1.1 };
2788    
2789     $Element->{$HTML_NS}->{param} = {
2790     attrs_checker => sub {
2791     my ($self, $todo) = @_;
2792     $GetHTMLAttrsChecker->({
2793     name => sub { },
2794     value => sub { },
2795     })->($self, $todo);
2796     unless ($todo->{node}->has_attribute_ns (undef, 'name')) {
2797     $self->{onerror}->(node => $todo->{node},
2798     type => 'attribute missing:name');
2799     }
2800     unless ($todo->{node}->has_attribute_ns (undef, 'value')) {
2801     $self->{onerror}->(node => $todo->{node},
2802     type => 'attribute missing:value');
2803     }
2804     },
2805     checker => $HTMLEmptyChecker,
2806     };
2807    
2808     $Element->{$HTML_NS}->{video} = {
2809     attrs_checker => $GetHTMLAttrsChecker->({
2810     src => $HTMLURIAttrChecker,
2811     ## TODO: start, loopstart, loopend, end
2812     ## ISSUE: they MUST be "value time offset"s. Value?
2813 wakaba 1.11 ## ISSUE: playcount has no conformance creteria
2814 wakaba 1.1 autoplay => $GetHTMLBooleanAttrChecker->('autoplay'),
2815     controls => $GetHTMLBooleanAttrChecker->('controls'),
2816 wakaba 1.11 poster => $HTMLURIAttrChecker, ## TODO: not for audio!
2817     ## TODO: width, height (not for audio!)
2818 wakaba 1.1 }),
2819     checker => sub {
2820     my ($self, $todo) = @_;
2821 wakaba 1.25 $todo->{flag}->{has_descendant}->{significant} = 1;
2822 wakaba 1.1
2823 wakaba 1.29 ## TODO:
2824 wakaba 1.1 if ($todo->{node}->has_attribute_ns (undef, 'src')) {
2825     return $HTMLBlockOrInlineChecker->($self, $todo);
2826     } else {
2827     return $GetHTMLZeroOrMoreThenBlockOrInlineChecker->($HTML_NS, 'source')
2828     ->($self, $todo);
2829     }
2830     },
2831     };
2832    
2833     $Element->{$HTML_NS}->{audio} = {
2834     attrs_checker => $Element->{$HTML_NS}->{video}->{attrs_checker},
2835     checker => $Element->{$HTML_NS}->{video}->{checker},
2836     };
2837    
2838     $Element->{$HTML_NS}->{source} = {
2839     attrs_checker => sub {
2840     my ($self, $todo) = @_;
2841     $GetHTMLAttrsChecker->({
2842     src => $HTMLURIAttrChecker,
2843     type => $HTMLIMTAttrChecker,
2844     media => $HTMLMQAttrChecker,
2845     })->($self, $todo);
2846     unless ($todo->{node}->has_attribute_ns (undef, 'src')) {
2847     $self->{onerror}->(node => $todo->{node},
2848     type => 'attribute missing:src');
2849     }
2850     },
2851     checker => $HTMLEmptyChecker,
2852     };
2853    
2854     $Element->{$HTML_NS}->{canvas} = {
2855     attrs_checker => $GetHTMLAttrsChecker->({
2856     height => $GetHTMLNonNegativeIntegerAttrChecker->(sub { 1 }),
2857     width => $GetHTMLNonNegativeIntegerAttrChecker->(sub { 1 }),
2858     }),
2859 wakaba 1.25 checker => sub {
2860     my ($self, $todo) = @_;
2861     $todo->{flag}->{has_descendant}->{significant} = 1;
2862 wakaba 1.29 return $HTMLTransparentChecker->($self, $todo);
2863 wakaba 1.25 },
2864 wakaba 1.1 };
2865    
2866     $Element->{$HTML_NS}->{map} = {
2867 wakaba 1.4 attrs_checker => sub {
2868     my ($self, $todo) = @_;
2869     my $has_id;
2870     $GetHTMLAttrsChecker->({
2871     id => sub {
2872     ## NOTE: same as global |id=""|, with |$self->{map}| registeration
2873     my ($self, $attr) = @_;
2874     my $value = $attr->value;
2875     if (length $value > 0) {
2876     if ($self->{id}->{$value}) {
2877     $self->{onerror}->(node => $attr, type => 'duplicate ID');
2878     push @{$self->{id}->{$value}}, $attr;
2879     } else {
2880     $self->{id}->{$value} = [$attr];
2881     }
2882 wakaba 1.1 } else {
2883 wakaba 1.4 ## NOTE: MUST contain at least one character
2884     $self->{onerror}->(node => $attr, type => 'empty attribute value');
2885 wakaba 1.1 }
2886 wakaba 1.4 if ($value =~ /[\x09-\x0D\x20]/) {
2887     $self->{onerror}->(node => $attr, type => 'space in ID');
2888     }
2889     $self->{map}->{$value} ||= $attr;
2890     $has_id = 1;
2891     },
2892     })->($self, $todo);
2893     $self->{onerror}->(node => $todo->{node}, type => 'attribute missing:id')
2894     unless $has_id;
2895     },
2896 wakaba 1.29 checker => $HTMLProseContentChecker,
2897 wakaba 1.1 };
2898    
2899     $Element->{$HTML_NS}->{area} = {
2900     attrs_checker => sub {
2901     my ($self, $todo) = @_;
2902     my %attr;
2903     my $coords;
2904     for my $attr (@{$todo->{node}->attributes}) {
2905     my $attr_ns = $attr->namespace_uri;
2906     $attr_ns = '' unless defined $attr_ns;
2907     my $attr_ln = $attr->manakai_local_name;
2908     my $checker;
2909     if ($attr_ns eq '') {
2910     $checker = {
2911     alt => sub { },
2912     ## NOTE: |alt| value has no conformance creteria.
2913     shape => $GetHTMLEnumeratedAttrChecker->({
2914     circ => -1, circle => 1,
2915     default => 1,
2916     poly => 1, polygon => -1,
2917     rect => 1, rectangle => -1,
2918     }),
2919     coords => sub {
2920     my ($self, $attr) = @_;
2921     my $value = $attr->value;
2922     if ($value =~ /\A-?[0-9]+(?>,-?[0-9]+)*\z/) {
2923     $coords = [split /,/, $value];
2924     } else {
2925     $self->{onerror}->(node => $attr,
2926     type => 'coords:syntax error');
2927     }
2928     },
2929     target => $HTMLTargetAttrChecker,
2930     href => $HTMLURIAttrChecker,
2931     ping => $HTMLSpaceURIsAttrChecker,
2932 wakaba 1.4 rel => sub { $HTMLLinkTypesAttrChecker->(1, $todo, @_) },
2933 wakaba 1.1 media => $HTMLMQAttrChecker,
2934     hreflang => $HTMLLanguageTagAttrChecker,
2935     type => $HTMLIMTAttrChecker,
2936     }->{$attr_ln};
2937     if ($checker) {
2938     $attr{$attr_ln} = $attr;
2939     } else {
2940     $checker = $HTMLAttrChecker->{$attr_ln};
2941     }
2942     }
2943     $checker ||= $AttrChecker->{$attr_ns}->{$attr_ln}
2944     || $AttrChecker->{$attr_ns}->{''};
2945     if ($checker) {
2946     $checker->($self, $attr) if ref $checker;
2947     } else {
2948     $self->{onerror}->(node => $attr, level => 'unsupported',
2949     type => 'attribute');
2950     ## ISSUE: No comformance createria for unknown attributes in the spec
2951     }
2952     }
2953    
2954     if (defined $attr{href}) {
2955 wakaba 1.4 $self->{has_hyperlink_element} = 1;
2956 wakaba 1.1 unless (defined $attr{alt}) {
2957     $self->{onerror}->(node => $todo->{node},
2958     type => 'attribute missing:alt');
2959     }
2960     } else {
2961     for (qw/target ping rel media hreflang type alt/) {
2962     if (defined $attr{$_}) {
2963     $self->{onerror}->(node => $attr{$_},
2964     type => 'attribute not allowed');
2965     }
2966     }
2967     }
2968    
2969     my $shape = 'rectangle';
2970     if (defined $attr{shape}) {
2971     $shape = {
2972     circ => 'circle', circle => 'circle',
2973     default => 'default',
2974     poly => 'polygon', polygon => 'polygon',
2975     rect => 'rectangle', rectangle => 'rectangle',
2976     }->{lc $attr{shape}->value} || 'rectangle';
2977     ## TODO: ASCII lowercase?
2978     }
2979    
2980     if ($shape eq 'circle') {
2981     if (defined $attr{coords}) {
2982     if (defined $coords) {
2983     if (@$coords == 3) {
2984     if ($coords->[2] < 0) {
2985     $self->{onerror}->(node => $attr{coords},
2986     type => 'coords:out of range:2');
2987     }
2988     } else {
2989     $self->{onerror}->(node => $attr{coords},
2990     type => 'coords:number:3:'.@$coords);
2991     }
2992     } else {
2993     ## NOTE: A syntax error has been reported.
2994     }
2995     } else {
2996     $self->{onerror}->(node => $todo->{node},
2997     type => 'attribute missing:coords');
2998     }
2999     } elsif ($shape eq 'default') {
3000     if (defined $attr{coords}) {
3001     $self->{onerror}->(node => $attr{coords},
3002     type => 'attribute not allowed');
3003     }
3004     } elsif ($shape eq 'polygon') {
3005     if (defined $attr{coords}) {
3006     if (defined $coords) {
3007     if (@$coords >= 6) {
3008     unless (@$coords % 2 == 0) {
3009     $self->{onerror}->(node => $attr{coords},
3010     type => 'coords:number:even:'.@$coords);
3011     }
3012     } else {
3013     $self->{onerror}->(node => $attr{coords},
3014     type => 'coords:number:>=6:'.@$coords);
3015     }
3016     } else {
3017     ## NOTE: A syntax error has been reported.
3018     }
3019     } else {
3020     $self->{onerror}->(node => $todo->{node},
3021     type => 'attribute missing:coords');
3022     }
3023     } elsif ($shape eq 'rectangle') {
3024     if (defined $attr{coords}) {
3025     if (defined $coords) {
3026     if (@$coords == 4) {
3027     unless ($coords->[0] < $coords->[2]) {
3028     $self->{onerror}->(node => $attr{coords},
3029     type => 'coords:out of range:0');
3030     }
3031     unless ($coords->[1] < $coords->[3]) {
3032     $self->{onerror}->(node => $attr{coords},
3033     type => 'coords:out of range:1');
3034     }
3035     } else {
3036     $self->{onerror}->(node => $attr{coords},
3037     type => 'coords:number:4:'.@$coords);
3038     }
3039     } else {
3040     ## NOTE: A syntax error has been reported.
3041     }
3042     } else {
3043     $self->{onerror}->(node => $todo->{node},
3044     type => 'attribute missing:coords');
3045     }
3046     }
3047     },
3048     checker => $HTMLEmptyChecker,
3049     };
3050     ## TODO: only in map
3051    
3052     $Element->{$HTML_NS}->{table} = {
3053     attrs_checker => $GetHTMLAttrsChecker->({}),
3054     checker => sub {
3055     my ($self, $todo) = @_;
3056     my $el = $todo->{node};
3057     my $new_todos = [];
3058     my @nodes = (@{$el->child_nodes});
3059    
3060     my $phase = 'before caption';
3061     my $has_tfoot;
3062     while (@nodes) {
3063     my $node = shift @nodes;
3064     $self->_remove_minuses ($node) and next if ref $node eq 'HASH';
3065    
3066     my $nt = $node->node_type;
3067     if ($nt == 1) {
3068     my $node_ns = $node->namespace_uri;
3069     $node_ns = '' unless defined $node_ns;
3070     my $node_ln = $node->manakai_local_name;
3071     ## NOTE: |minuses| list is not checked since redundant
3072 wakaba 1.8 if ($self->{pluses}->{$node_ns}->{$node_ln}) {
3073     #
3074     } elsif ($phase eq 'in tbodys') {
3075 wakaba 1.1 if ($node_ns eq $HTML_NS and $node_ln eq 'tbody') {
3076     #$phase = 'in tbodys';
3077     } elsif (not $has_tfoot and
3078     $node_ns eq $HTML_NS and $node_ln eq 'tfoot') {
3079     $phase = 'after tfoot';
3080     $has_tfoot = 1;
3081     } else {
3082     $self->{onerror}->(node => $node, type => 'element not allowed');
3083     }
3084     } elsif ($phase eq 'in trs') {
3085     if ($node_ns eq $HTML_NS and $node_ln eq 'tr') {
3086     #$phase = 'in trs';
3087     } elsif (not $has_tfoot and
3088     $node_ns eq $HTML_NS and $node_ln eq 'tfoot') {
3089     $phase = 'after tfoot';
3090     $has_tfoot = 1;
3091     } else {
3092     $self->{onerror}->(node => $node, type => 'element not allowed');
3093     }
3094     } elsif ($phase eq 'after thead') {
3095     if ($node_ns eq $HTML_NS and $node_ln eq 'tbody') {
3096     $phase = 'in tbodys';
3097     } elsif ($node_ns eq $HTML_NS and $node_ln eq 'tr') {
3098     $phase = 'in trs';
3099     } elsif ($node_ns eq $HTML_NS and $node_ln eq 'tfoot') {
3100     $phase = 'in tbodys';
3101     $has_tfoot = 1;
3102     } else {
3103     $self->{onerror}->(node => $node, type => 'element not allowed');
3104     }
3105     } elsif ($phase eq 'in colgroup') {
3106     if ($node_ns eq $HTML_NS and $node_ln eq 'colgroup') {
3107     $phase = 'in colgroup';
3108     } elsif ($node_ns eq $HTML_NS and $node_ln eq 'thead') {
3109     $phase = 'after thead';
3110     } elsif ($node_ns eq $HTML_NS and $node_ln eq 'tbody') {
3111     $phase = 'in tbodys';
3112     } elsif ($node_ns eq $HTML_NS and $node_ln eq 'tr') {
3113     $phase = 'in trs';
3114     } elsif ($node_ns eq $HTML_NS and $node_ln eq 'tfoot') {
3115     $phase = 'in tbodys';
3116     $has_tfoot = 1;
3117     } else {
3118     $self->{onerror}->(node => $node, type => 'element not allowed');
3119     }
3120     } elsif ($phase eq 'before caption') {
3121     if ($node_ns eq $HTML_NS and $node_ln eq 'caption') {
3122     $phase = 'in colgroup';
3123     } elsif ($node_ns eq $HTML_NS and $node_ln eq 'colgroup') {
3124     $phase = 'in colgroup';
3125     } elsif ($node_ns eq $HTML_NS and $node_ln eq 'thead') {
3126     $phase = 'after thead';
3127     } elsif ($node_ns eq $HTML_NS and $node_ln eq 'tbody') {
3128     $phase = 'in tbodys';
3129     } elsif ($node_ns eq $HTML_NS and $node_ln eq 'tr') {
3130     $phase = 'in trs';
3131     } elsif ($node_ns eq $HTML_NS and $node_ln eq 'tfoot') {
3132     $phase = 'in tbodys';
3133     $has_tfoot = 1;
3134     } else {
3135     $self->{onerror}->(node => $node, type => 'element not allowed');
3136     }
3137     } else { # after tfoot
3138     $self->{onerror}->(node => $node, type => 'element not allowed');
3139     }
3140     my ($sib, $ch) = $self->_check_get_children ($node, $todo);
3141     unshift @nodes, @$sib;
3142     push @$new_todos, @$ch;
3143     } elsif ($nt == 3 or $nt == 4) {
3144     if ($node->data =~ /[^\x09-\x0D\x20]/) {
3145     $self->{onerror}->(node => $node, type => 'character not allowed');
3146 wakaba 1.25 $todo->{flag}->{has_descendant}->{significant} = 1;
3147 wakaba 1.1 }
3148     } elsif ($nt == 5) {
3149     unshift @nodes, @{$node->child_nodes};
3150     }
3151     }
3152    
3153     ## Table model errors
3154     require Whatpm::HTMLTable;
3155     Whatpm::HTMLTable->form_table ($todo->{node}, sub {
3156     my %opt = @_;
3157     $self->{onerror}->(type => 'table:'.$opt{type}, node => $opt{node});
3158     });
3159     push @{$self->{return}->{table}}, $todo->{node};
3160    
3161     return ($new_todos);
3162     },
3163     };
3164    
3165     $Element->{$HTML_NS}->{caption} = {
3166     attrs_checker => $GetHTMLAttrsChecker->({}),
3167 wakaba 1.13 checker => $HTMLStrictlyInlineChecker,
3168 wakaba 1.1 };
3169    
3170     $Element->{$HTML_NS}->{colgroup} = {
3171     attrs_checker => $GetHTMLAttrsChecker->({
3172     span => $GetHTMLNonNegativeIntegerAttrChecker->(sub { shift > 0 }),
3173     ## NOTE: Defined only if "the |colgroup| element contains no |col| elements"
3174     ## TODO: "attribute not supported" if |col|.
3175     ## ISSUE: MUST NOT if any |col|?
3176     ## ISSUE: MUST NOT for |<colgroup span="1"><any><col/></any></colgroup>| (though non-conforming)?
3177     }),
3178     checker => sub {
3179     my ($self, $todo) = @_;
3180     my $el = $todo->{node};
3181     my $new_todos = [];
3182     my @nodes = (@{$el->child_nodes});
3183    
3184     while (@nodes) {
3185     my $node = shift @nodes;
3186     $self->_remove_minuses ($node) and next if ref $node eq 'HASH';
3187    
3188     my $nt = $node->node_type;
3189     if ($nt == 1) {
3190     my $node_ns = $node->namespace_uri;
3191     $node_ns = '' unless defined $node_ns;
3192     my $node_ln = $node->manakai_local_name;
3193     ## NOTE: |minuses| list is not checked since redundant
3194 wakaba 1.8 if ($self->{pluses}->{$node_ns}->{$node_ln}) {
3195     #
3196     } elsif (not ($node_ns eq $HTML_NS and $node_ln eq 'col')) {
3197 wakaba 1.1 $self->{onerror}->(node => $node, type => 'element not allowed');
3198     }
3199     my ($sib, $ch) = $self->_check_get_children ($node, $todo);
3200     unshift @nodes, @$sib;
3201     push @$new_todos, @$ch;
3202     } elsif ($nt == 3 or $nt == 4) {
3203     if ($node->data =~ /[^\x09-\x0D\x20]/) {
3204     $self->{onerror}->(node => $node, type => 'character not allowed');
3205 wakaba 1.25 $todo->{flag}->{has_descendant}->{significant} = 1;
3206 wakaba 1.1 }
3207     } elsif ($nt == 5) {
3208     unshift @nodes, @{$node->child_nodes};
3209     }
3210     }
3211     return ($new_todos);
3212     },
3213     };
3214    
3215     $Element->{$HTML_NS}->{col} = {
3216     attrs_checker => $GetHTMLAttrsChecker->({
3217     span => $GetHTMLNonNegativeIntegerAttrChecker->(sub { shift > 0 }),
3218     }),
3219     checker => $HTMLEmptyChecker,
3220     };
3221    
3222     $Element->{$HTML_NS}->{tbody} = {
3223     attrs_checker => $GetHTMLAttrsChecker->({}),
3224     checker => sub {
3225     my ($self, $todo) = @_;
3226     my $el = $todo->{node};
3227     my $new_todos = [];
3228     my @nodes = (@{$el->child_nodes});
3229    
3230     my $has_tr;
3231     while (@nodes) {
3232     my $node = shift @nodes;
3233     $self->_remove_minuses ($node) and next if ref $node eq 'HASH';
3234    
3235     my $nt = $node->node_type;
3236     if ($nt == 1) {
3237     my $node_ns = $node->namespace_uri;
3238     $node_ns = '' unless defined $node_ns;
3239     my $node_ln = $node->manakai_local_name;
3240     ## NOTE: |minuses| list is not checked since redundant
3241 wakaba 1.8 if ($self->{pluses}->{$node_ns}->{$node_ln}) {
3242     #
3243     } elsif ($node_ns eq $HTML_NS and $node_ln eq 'tr') {
3244 wakaba 1.1 $has_tr = 1;
3245     } else {
3246     $self->{onerror}->(node => $node, type => 'element not allowed');
3247     }
3248     my ($sib, $ch) = $self->_check_get_children ($node, $todo);
3249     unshift @nodes, @$sib;
3250     push @$new_todos, @$ch;
3251     } elsif ($nt == 3 or $nt == 4) {
3252     if ($node->data =~ /[^\x09-\x0D\x20]/) {
3253     $self->{onerror}->(node => $node, type => 'character not allowed');
3254 wakaba 1.25 $todo->{flag}->{has_descendant}->{significant} = 1;
3255 wakaba 1.1 }
3256     } elsif ($nt == 5) {
3257     unshift @nodes, @{$node->child_nodes};
3258     }
3259     }
3260     unless ($has_tr) {
3261     $self->{onerror}->(node => $el, type => 'child element missing:tr');
3262     }
3263     return ($new_todos);
3264     },
3265     };
3266    
3267     $Element->{$HTML_NS}->{thead} = {
3268     attrs_checker => $GetHTMLAttrsChecker->({}),
3269     checker => $Element->{$HTML_NS}->{tbody}->{checker},
3270     };
3271    
3272     $Element->{$HTML_NS}->{tfoot} = {
3273     attrs_checker => $GetHTMLAttrsChecker->({}),
3274     checker => $Element->{$HTML_NS}->{tbody}->{checker},
3275     };
3276    
3277     $Element->{$HTML_NS}->{tr} = {
3278     attrs_checker => $GetHTMLAttrsChecker->({}),
3279     checker => sub {
3280     my ($self, $todo) = @_;
3281     my $el = $todo->{node};
3282     my $new_todos = [];
3283     my @nodes = (@{$el->child_nodes});
3284    
3285     my $has_td;
3286     while (@nodes) {
3287     my $node = shift @nodes;
3288     $self->_remove_minuses ($node) and next if ref $node eq 'HASH';
3289    
3290     my $nt = $node->node_type;
3291     if ($nt == 1) {
3292     my $node_ns = $node->namespace_uri;
3293     $node_ns = '' unless defined $node_ns;
3294     my $node_ln = $node->manakai_local_name;
3295     ## NOTE: |minuses| list is not checked since redundant
3296 wakaba 1.8 if ($self->{pluses}->{$node_ns}->{$node_ln}) {
3297     #
3298     } elsif ($node_ns eq $HTML_NS and
3299     ($node_ln eq 'td' or $node_ln eq 'th')) {
3300 wakaba 1.1 $has_td = 1;
3301     } else {
3302     $self->{onerror}->(node => $node, type => 'element not allowed');
3303     }
3304     my ($sib, $ch) = $self->_check_get_children ($node, $todo);
3305     unshift @nodes, @$sib;
3306     push @$new_todos, @$ch;
3307     } elsif ($nt == 3 or $nt == 4) {
3308     if ($node->data =~ /[^\x09-\x0D\x20]/) {
3309     $self->{onerror}->(node => $node, type => 'character not allowed');
3310 wakaba 1.25 $todo->{flag}->{has_descendant}->{significant} = 1;
3311 wakaba 1.1 }
3312     } elsif ($nt == 5) {
3313     unshift @nodes, @{$node->child_nodes};
3314     }
3315     }
3316     unless ($has_td) {
3317     $self->{onerror}->(node => $el, type => 'child element missing:td|th');
3318     }
3319     return ($new_todos);
3320     },
3321     };
3322    
3323     $Element->{$HTML_NS}->{td} = {
3324     attrs_checker => $GetHTMLAttrsChecker->({
3325     colspan => $GetHTMLNonNegativeIntegerAttrChecker->(sub { shift > 0 }),
3326     rowspan => $GetHTMLNonNegativeIntegerAttrChecker->(sub { shift > 0 }),
3327     }),
3328 wakaba 1.29 checker => $HTMLProseContentChecker,
3329 wakaba 1.1 };
3330    
3331     $Element->{$HTML_NS}->{th} = {
3332     attrs_checker => $GetHTMLAttrsChecker->({
3333     colspan => $GetHTMLNonNegativeIntegerAttrChecker->(sub { shift > 0 }),
3334     rowspan => $GetHTMLNonNegativeIntegerAttrChecker->(sub { shift > 0 }),
3335     scope => $GetHTMLEnumeratedAttrChecker
3336     ->({row => 1, col => 1, rowgroup => 1, colgroup => 1}),
3337     }),
3338 wakaba 1.29 checker => $HTMLProseContentChecker,
3339 wakaba 1.1 };
3340    
3341     ## TODO: forms
3342 wakaba 1.8 ## TODO: Tests for <nest/> in form elements
3343 wakaba 1.1
3344     $Element->{$HTML_NS}->{script} = {
3345 wakaba 1.9 attrs_checker => $GetHTMLAttrsChecker->({
3346 wakaba 1.1 src => $HTMLURIAttrChecker,
3347     defer => $GetHTMLBooleanAttrChecker->('defer'),
3348     async => $GetHTMLBooleanAttrChecker->('async'),
3349     type => $HTMLIMTAttrChecker,
3350 wakaba 1.9 }),
3351 wakaba 1.1 checker => sub {
3352     my ($self, $todo) = @_;
3353    
3354     if ($todo->{node}->has_attribute_ns (undef, 'src')) {
3355     return $HTMLEmptyChecker->($self, $todo);
3356     } else {
3357     ## NOTE: No content model conformance in HTML5 spec.
3358     my $type = $todo->{node}->get_attribute_ns (undef, 'type');
3359     my $language = $todo->{node}->get_attribute_ns (undef, 'language');
3360     if ((defined $type and $type eq '') or
3361     (defined $language and $language eq '')) {
3362     $type = 'text/javascript';
3363     } elsif (defined $type) {
3364     #
3365     } elsif (defined $language) {
3366     $type = 'text/' . $language;
3367     } else {
3368     $type = 'text/javascript';
3369     }
3370     $self->{onerror}->(node => $todo->{node}, level => 'unsupported',
3371     type => 'script:'.$type); ## TODO: $type normalization
3372     return $AnyChecker->($self, $todo);
3373     }
3374     },
3375     };
3376 wakaba 1.25 ## ISSUE: Significant check and text child node
3377 wakaba 1.1
3378     ## NOTE: When script is disabled.
3379     $Element->{$HTML_NS}->{noscript} = {
3380 wakaba 1.3 attrs_checker => sub {
3381     my ($self, $todo) = @_;
3382    
3383     ## NOTE: This check is inserted in |attrs_checker|, rather than |checker|,
3384     ## since the later is not invoked when the |noscript| is used as a
3385     ## transparent element.
3386     unless ($todo->{node}->owner_document->manakai_is_html) {
3387     $self->{onerror}->(node => $todo->{node}, type => 'in XML:noscript');
3388     }
3389    
3390     $GetHTMLAttrsChecker->({})->($self, $todo);
3391     },
3392 wakaba 1.1 checker => sub {
3393     my ($self, $todo) = @_;
3394    
3395 wakaba 1.3 if ($todo->{flag}->{in_head}) {
3396     my $new_todos = [];
3397     my @nodes = (@{$todo->{node}->child_nodes});
3398    
3399     while (@nodes) {
3400     my $node = shift @nodes;
3401     $self->_remove_minuses ($node) and next if ref $node eq 'HASH';
3402    
3403     my $nt = $node->node_type;
3404     if ($nt == 1) {
3405     my $node_ns = $node->namespace_uri;
3406     $node_ns = '' unless defined $node_ns;
3407     my $node_ln = $node->manakai_local_name;
3408 wakaba 1.8 if ($self->{pluses}->{$node_ns}->{$node_ln}) {
3409     #
3410     } elsif ($node_ns eq $HTML_NS) {
3411 wakaba 1.3 if ({link => 1, style => 1}->{$node_ln}) {
3412     #
3413     } elsif ($node_ln eq 'meta') {
3414 wakaba 1.5 if ($node->has_attribute_ns (undef, 'name')) {
3415     #
3416 wakaba 1.3 } else {
3417 wakaba 1.5 $self->{onerror}->(node => $node,
3418     type => 'element not allowed');
3419 wakaba 1.3 }
3420     } else {
3421     $self->{onerror}->(node => $node, type => 'element not allowed');
3422     }
3423     } else {
3424     $self->{onerror}->(node => $node, type => 'element not allowed');
3425     }
3426    
3427     my ($sib, $ch) = $self->_check_get_children ($node, $todo);
3428     unshift @nodes, @$sib;
3429     push @$new_todos, @$ch;
3430     } elsif ($nt == 3 or $nt == 4) {
3431     if ($node->data =~ /[^\x09-\x0D\x20]/) {
3432     $self->{onerror}->(node => $node, type => 'character not allowed');
3433 wakaba 1.25 $todo->{flag}->{has_descendant}->{significant} = 1;
3434 wakaba 1.3 }
3435     } elsif ($nt == 5) {
3436     unshift @nodes, @{$node->child_nodes};
3437     }
3438     }
3439     return ($new_todos);
3440     } else {
3441     my $end = $self->_add_minuses ({$HTML_NS => {noscript => 1}});
3442 wakaba 1.29 my ($sib, $ch) = $HTMLTransparentChecker->($self, $todo);
3443 wakaba 1.3 push @$sib, $end;
3444     return ($sib, $ch);
3445     }
3446 wakaba 1.1 },
3447     };
3448 wakaba 1.3
3449     ## ISSUE: Scripting is disabled: <head><noscript><html a></noscript></head>
3450 wakaba 1.1
3451     $Element->{$HTML_NS}->{'event-source'} = {
3452     attrs_checker => $GetHTMLAttrsChecker->({
3453     src => $HTMLURIAttrChecker,
3454     }),
3455     checker => $HTMLEmptyChecker,
3456     };
3457    
3458     $Element->{$HTML_NS}->{details} = {
3459     attrs_checker => $GetHTMLAttrsChecker->({
3460     open => $GetHTMLBooleanAttrChecker->('open'),
3461     }),
3462     checker => sub {
3463     my ($self, $todo) = @_;
3464    
3465 wakaba 1.29 ## TODO:
3466 wakaba 1.1 my ($sib, $ch)
3467     = $GetHTMLZeroOrMoreThenBlockOrInlineChecker->($HTML_NS, 'legend')
3468     ->($self, $todo);
3469     return ($sib, $ch);
3470     },
3471     };
3472    
3473     $Element->{$HTML_NS}->{datagrid} = {
3474     attrs_checker => $GetHTMLAttrsChecker->({
3475     disabled => $GetHTMLBooleanAttrChecker->('disabled'),
3476     multiple => $GetHTMLBooleanAttrChecker->('multiple'),
3477     }),
3478     checker => sub {
3479     my ($self, $todo) = @_;
3480     my $el = $todo->{node};
3481     my $new_todos = [];
3482     my @nodes = (@{$el->child_nodes});
3483    
3484 wakaba 1.25 my $old_values = {significant =>
3485     $todo->{flag}->{has_descendant}->{significant}};
3486     $todo->{flag}->{has_descendant}->{significant} = 0;
3487    
3488 wakaba 1.1 my $end = $self->_add_minuses ({$HTML_NS => {a => 1, datagrid => 1}});
3489    
3490 wakaba 1.29 ## Prose -(text* table Prose*) | table | select | datalist | Empty
3491 wakaba 1.1 my $mode = 'any';
3492     while (@nodes) {
3493     my $node = shift @nodes;
3494     $self->_remove_minuses ($node) and next if ref $node eq 'HASH';
3495    
3496     my $nt = $node->node_type;
3497     if ($nt == 1) {
3498     my $node_ns = $node->namespace_uri;
3499     $node_ns = '' unless defined $node_ns;
3500     my $node_ln = $node->manakai_local_name;
3501     my $not_allowed = $self->{minuses}->{$node_ns}->{$node_ln};
3502 wakaba 1.8 if ($self->{pluses}->{$node_ns}->{$node_ln}) {
3503     #
3504 wakaba 1.29 } elsif ($mode eq 'prose') {
3505 wakaba 1.1 $not_allowed = 1
3506 wakaba 1.29 unless $HTMLProseContent->{$node_ns}->{$node_ln};
3507 wakaba 1.1 } elsif ($mode eq 'any') {
3508     if ($node_ns eq $HTML_NS and
3509     {table => 1, select => 1, datalist => 1}->{$node_ln}) {
3510     $mode = 'none';
3511 wakaba 1.29 } elsif ($HTMLProseContent->{$node_ns}->{$node_ln}) {
3512     $mode = 'prose';
3513 wakaba 1.1 } else {
3514     $not_allowed = 1;
3515     }
3516     } else {
3517     $not_allowed = 1;
3518     }
3519     $self->{onerror}->(node => $node, type => 'element not allowed')
3520     if $not_allowed;
3521     my ($sib, $ch) = $self->_check_get_children ($node, $todo);
3522     unshift @nodes, @$sib;
3523     push @$new_todos, @$ch;
3524     } elsif ($nt == 3 or $nt == 4) {
3525     if ($node->data =~ /[^\x09-\x0D\x20]/) {
3526 wakaba 1.29 if ($mode eq 'prose') {
3527     #
3528     } elsif ($mode eq 'any') {
3529     $mode = 'prose';
3530     } else {
3531     $self->{onerror}->(node => $node, type => 'character not allowed');
3532     }
3533 wakaba 1.25 $todo->{flag}->{has_descendant}->{significant} = 1;
3534 wakaba 1.1 }
3535     } elsif ($nt == 5) {
3536     unshift @nodes, @{$node->child_nodes};
3537     }
3538     }
3539    
3540     push @$new_todos, $end;
3541 wakaba 1.25
3542     push @$new_todos, {
3543     type => 'descendant', node => $todo->{node}, flag => $todo->{flag},
3544     old_values => $old_values,
3545 wakaba 1.26 errors => $HTMLSignificantContentErrors,
3546 wakaba 1.25 };
3547    
3548 wakaba 1.1 return ($new_todos);
3549 wakaba 1.29
3550     ## ISSUE: "xxx<table/>" is disallowed; "<select/>aaa" and "<datalist/>aa"
3551     ## are not disallowed (assuming that form control contents are also
3552     ## prose content).
3553 wakaba 1.1 },
3554     };
3555    
3556     $Element->{$HTML_NS}->{command} = {
3557     attrs_checker => $GetHTMLAttrsChecker->({
3558     checked => $GetHTMLBooleanAttrChecker->('checked'),
3559     default => $GetHTMLBooleanAttrChecker->('default'),
3560     disabled => $GetHTMLBooleanAttrChecker->('disabled'),
3561     hidden => $GetHTMLBooleanAttrChecker->('hidden'),
3562     icon => $HTMLURIAttrChecker,
3563     label => sub { }, ## NOTE: No conformance creteria
3564     radiogroup => sub { }, ## NOTE: No conformance creteria
3565     ## NOTE: |title| has special semantics, but no syntactical difference
3566     type => sub {
3567     my ($self, $attr) = @_;
3568     my $value = $attr->value;
3569     unless ({command => 1, checkbox => 1, radio => 1}->{$value}) {
3570     $self->{onerror}->(node => $attr, type => 'attribute value not allowed');
3571     }
3572     },
3573     }),
3574     checker => $HTMLEmptyChecker,
3575     };
3576    
3577     $Element->{$HTML_NS}->{menu} = {
3578     attrs_checker => $GetHTMLAttrsChecker->({
3579     autosubmit => $GetHTMLBooleanAttrChecker->('autosubmit'),
3580     id => sub {
3581     ## NOTE: same as global |id=""|, with |$self->{menu}| registeration
3582     my ($self, $attr) = @_;
3583     my $value = $attr->value;
3584     if (length $value > 0) {
3585     if ($self->{id}->{$value}) {
3586     $self->{onerror}->(node => $attr, type => 'duplicate ID');
3587     push @{$self->{id}->{$value}}, $attr;
3588     } else {
3589     $self->{id}->{$value} = [$attr];
3590     }
3591     } else {
3592     ## NOTE: MUST contain at least one character
3593     $self->{onerror}->(node => $attr, type => 'empty attribute value');
3594     }
3595     if ($value =~ /[\x09-\x0D\x20]/) {
3596     $self->{onerror}->(node => $attr, type => 'space in ID');
3597     }
3598     $self->{menu}->{$value} ||= $attr;
3599     ## ISSUE: <menu id=""><p contextmenu=""> match?
3600     },
3601     label => sub { }, ## NOTE: No conformance creteria
3602     type => $GetHTMLEnumeratedAttrChecker->({context => 1, toolbar => 1}),
3603     }),
3604     checker => sub {
3605     my ($self, $todo) = @_;
3606     my $el = $todo->{node};
3607     my $new_todos = [];
3608     my @nodes = (@{$el->child_nodes});
3609 wakaba 1.25
3610     my $old_values = {significant =>
3611     $todo->{flag}->{has_descendant}->{significant}};
3612     $todo->{flag}->{has_descendant}->{significant} = 0;
3613 wakaba 1.1
3614 wakaba 1.29 my $content = 'li or phrasing';
3615 wakaba 1.1 while (@nodes) {
3616     my $node = shift @nodes;
3617     $self->_remove_minuses ($node) and next if ref $node eq 'HASH';
3618    
3619     my $nt = $node->node_type;
3620     if ($nt == 1) {
3621     my $node_ns = $node->namespace_uri;
3622     $node_ns = '' unless defined $node_ns;
3623     my $node_ln = $node->manakai_local_name;
3624     my $not_allowed = $self->{minuses}->{$node_ns}->{$node_ln};
3625 wakaba 1.8 if ($self->{pluses}->{$node_ns}->{$node_ln}) {
3626     #
3627     } elsif ($node_ns eq $HTML_NS and $node_ln eq 'li') {
3628 wakaba 1.29 if ($content eq 'phrasing') {
3629 wakaba 1.1 $not_allowed = 1;
3630 wakaba 1.29 } elsif ($content eq 'li or phrasing') {
3631 wakaba 1.1 $content = 'li';
3632     }
3633     } else {
3634 wakaba 1.29 if ($HTMLPhrasingContent->{$node_ns}->{$node_ln}) {
3635     $content = 'phrasing';
3636 wakaba 1.1 } else {
3637     $not_allowed = 1;
3638     }
3639     }
3640     $self->{onerror}->(node => $node, type => 'element not allowed')
3641     if $not_allowed;
3642     my ($sib, $ch) = $self->_check_get_children ($node, $todo);
3643     unshift @nodes, @$sib;
3644     push @$new_todos, @$ch;
3645     } elsif ($nt == 3 or $nt == 4) {
3646     if ($node->data =~ /[^\x09-\x0D\x20]/) {
3647     if ($content eq 'li') {
3648     $self->{onerror}->(node => $node, type => 'character not allowed');
3649 wakaba 1.29 } elsif ($content eq 'li or phrasing') {
3650     $content = 'phrasing';
3651 wakaba 1.1 }
3652 wakaba 1.25 $todo->{flag}->{has_descendant}->{significant} = 1;
3653 wakaba 1.1 }
3654     } elsif ($nt == 5) {
3655     unshift @nodes, @{$node->child_nodes};
3656     }
3657     }
3658    
3659     for (@$new_todos) {
3660 wakaba 1.29 $_->{flag}->{in_menu} = 1;
3661 wakaba 1.1 }
3662 wakaba 1.25
3663     push @$new_todos, {
3664     type => 'descendant', node => $todo->{node}, flag => $todo->{flag},
3665     old_values => $old_values,
3666 wakaba 1.26 errors => $HTMLSignificantContentErrors,
3667 wakaba 1.25 };
3668    
3669 wakaba 1.1 return ($new_todos);
3670     },
3671 wakaba 1.8 };
3672    
3673     $Element->{$HTML_NS}->{datatemplate} = {
3674     attrs_checker => $GetHTMLAttrsChecker->({}),
3675     checker => sub {
3676     my ($self, $todo) = @_;
3677     my $el = $todo->{node};
3678     my $new_todos = [];
3679     my @nodes = (@{$el->child_nodes});
3680    
3681     while (@nodes) {
3682     my $node = shift @nodes;
3683     $self->_remove_minuses ($node) and next if ref $node eq 'HASH';
3684    
3685     my $nt = $node->node_type;
3686     if ($nt == 1) {
3687     my $node_ns = $node->namespace_uri;
3688     $node_ns = '' unless defined $node_ns;
3689     my $node_ln = $node->manakai_local_name;
3690     ## NOTE: |minuses| list is not checked since redundant
3691     if ($self->{pluses}->{$node_ns}->{$node_ln}) {
3692     #
3693     } elsif (not ($node_ns eq $HTML_NS and $node_ln eq 'rule')) {
3694     $self->{onerror}->(node => $node,
3695     type => 'element not allowed:datatemplate');
3696     }
3697     my ($sib, $ch) = $self->_check_get_children ($node, $todo);
3698     unshift @nodes, @$sib;
3699     push @$new_todos, @$ch;
3700     } elsif ($nt == 3 or $nt == 4) {
3701     if ($node->data =~ /[^\x09-\x0D\x20]/) {
3702     $self->{onerror}->(node => $node, type => 'character not allowed');
3703 wakaba 1.25 $todo->{flag}->{has_descendant}->{significant} = 1;
3704 wakaba 1.8 }
3705     } elsif ($nt == 5) {
3706     unshift @nodes, @{$node->child_nodes};
3707     }
3708     }
3709     return ($new_todos);
3710     },
3711     is_xml_root => 1,
3712     };
3713    
3714     $Element->{$HTML_NS}->{rule} = {
3715     attrs_checker => $GetHTMLAttrsChecker->({
3716 wakaba 1.23 condition => $HTMLSelectorsAttrChecker,
3717 wakaba 1.18 mode => $HTMLUnorderedUniqueSetOfSpaceSeparatedTokensAttrChecker,
3718 wakaba 1.8 }),
3719     checker => sub {
3720     my ($self, $todo) = @_;
3721    
3722     my $end = $self->_add_pluses ({$HTML_NS => {nest => 1}});
3723 wakaba 1.25 my ($sib, $ch) = $HTMLAnyChecker->($self, $todo);
3724 wakaba 1.8 push @$sib, $end;
3725     return ($sib, $ch);
3726     },
3727     ## NOTE: "MAY be anything that, when the parent |datatemplate|
3728     ## is applied to some conforming data, results in a conforming DOM tree.":
3729     ## We don't check against this.
3730     };
3731    
3732     $Element->{$HTML_NS}->{nest} = {
3733     attrs_checker => $GetHTMLAttrsChecker->({
3734 wakaba 1.23 filter => $HTMLSelectorsAttrChecker,
3735     mode => sub {
3736     my ($self, $attr) = @_;
3737     my $value = $attr->value;
3738     if ($value !~ /\A[^\x09-\x0D\x20]+\z/) {
3739     $self->{onerror}->(node => $attr, type => 'mode:syntax error');
3740     }
3741     },
3742 wakaba 1.8 }),
3743     checker => $HTMLEmptyChecker,
3744 wakaba 1.1 };
3745    
3746     $Element->{$HTML_NS}->{legend} = {
3747     attrs_checker => $GetHTMLAttrsChecker->({}),
3748 wakaba 1.29 checker => $HTMLPhrasingContentChecker,
3749 wakaba 1.1 };
3750    
3751     $Element->{$HTML_NS}->{div} = {
3752     attrs_checker => $GetHTMLAttrsChecker->({}),
3753 wakaba 1.29 checker => $HTMLTransparentChecker,
3754 wakaba 1.1 };
3755    
3756     $Element->{$HTML_NS}->{font} = {
3757     attrs_checker => $GetHTMLAttrsChecker->({}), ## TODO
3758     checker => $HTMLTransparentChecker,
3759     };
3760    
3761     $Whatpm::ContentChecker::Namespace->{$HTML_NS}->{loaded} = 1;
3762    
3763     1;

[email protected]
ViewVC Help
Powered by ViewVC 1.1.24