/[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 - (show 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 package Whatpm::ContentChecker;
2 use strict;
3 require Whatpm::ContentChecker;
4
5 my $HTML_NS = q<http://www.w3.org/1999/xhtml>;
6
7 ## 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 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 noscript 1 datatemplate 1
131 /,
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 datatemplate 1
148 /,
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 ## 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 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 ## 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 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 errors => $HTMLSignificantContentErrors,
225 };
226
227 return ($new_todos);
228 }; # $HTMLAnyChecker
229
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 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 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 $todo->{flag}->{has_descendant}->{significant} = 1;
259 }
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 my $old_values = {significant =>
275 $todo->{flag}->{has_descendant}->{significant}};
276 $todo->{flag}->{has_descendant}->{significant} = 0;
277
278 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 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 my ($sib, $ch) = $self->_check_get_children ($node, $todo);
294 unshift @nodes, @$sib;
295 push @$new_todos, @$ch;
296 } elsif ($nt == 3 or $nt == 4) {
297 if ($node->data =~ /[^\x09-\x0D\x20]/) {
298 $todo->{flag}->{has_descendant}->{significant} = 1;
299 }
300 } elsif ($nt == 5) {
301 unshift @nodes, @{$node->child_nodes};
302 }
303 }
304
305 push @$new_todos, {
306 type => 'descendant', node => $todo->{node}, flag => $todo->{flag},
307 old_values => $old_values,
308 errors => $HTMLSignificantContentErrors,
309 };
310
311 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
322 my $old_values = {significant =>
323 $todo->{flag}->{has_descendant}->{significant}};
324 $todo->{flag}->{has_descendant}->{significant} = 0;
325
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 } elsif ($self->{pluses}->{$node_ns}->{$node_ln}) {
343 #
344 } 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 $todo->{flag}->{has_descendant}->{significant} = 1;
357 }
358 } elsif ($nt == 5) {
359 unshift @nodes, @{$node->child_nodes};
360 }
361 }
362
363 push @$new_todos, {
364 type => 'descendant', node => $todo->{node}, flag => $todo->{flag},
365 old_values => $old_values,
366 errors => $HTMLSignificantContentErrors,
367 };
368
369 return ($new_todos);
370 }; # $HTMLStylableBlockChecker
371
372 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 ## 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 my $old_values = {significant =>
446 $todo->{flag}->{has_descendant}->{significant}};
447 $todo->{flag}->{has_descendant}->{significant} = 0;
448
449 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 unless $HTMLBlockLevelElements->{$node_ns}->{$node_ln} or
461 $self->{pluses}->{$node_ns}->{$node_ln};
462 $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 $todo->{flag}->{has_descendant}->{significant} = 1;
471 }
472 } elsif ($nt == 5) {
473 unshift @nodes, @{$node->child_nodes};
474 }
475 }
476
477 push @$new_todos, {
478 type => 'descendant', node => $todo->{node}, flag => $todo->{flag},
479 old_values => $old_values,
480 errors => $HTMLSignificantContentErrors,
481 };
482
483 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 my $old_values = {significant =>
494 $todo->{flag}->{has_descendant}->{significant}};
495 $todo->{flag}->{has_descendant}->{significant} = 0;
496
497 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 $HTMLStructuredInlineLevelElements->{$node_ns}->{$node_ln} or
510 $self->{pluses}->{$node_ns}->{$node_ln};
511 $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 } elsif ($nt == 3 or $nt == 4) {
517 if ($node->data =~ /[^\x09-\x0D\x20]/) {
518 $todo->{flag}->{has_descendant}->{significant} = 1;
519 }
520 } elsif ($nt == 5) {
521 unshift @nodes, @{$node->child_nodes};
522 }
523 }
524
525 for (@$new_todos) {
526 $_->{inline} = 1;
527 }
528
529 push @$new_todos, {
530 type => 'descendant', node => $todo->{node}, flag => $todo->{flag},
531 old_values => $old_values,
532 errors => $HTMLSignificantContentErrors,
533 };
534
535 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
545 my $old_values = {significant =>
546 $todo->{flag}->{has_descendant}->{significant}};
547 $todo->{flag}->{has_descendant}->{significant} = 0;
548
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 unless $HTMLStrictlyInlineLevelElements->{$node_ns}->{$node_ln} or
561 $self->{pluses}->{$node_ns}->{$node_ln};
562 $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 } elsif ($nt == 3 or $nt == 4) {
568 if ($node->data =~ /[^\x09-\x0D\x20]/) {
569 $todo->{flag}->{has_descendant}->{significant} = 1;
570 }
571 } 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
581 push @$new_todos, {
582 type => 'descendant', node => $todo->{node}, flag => $todo->{flag},
583 old_values => $old_values,
584 errors => $HTMLSignificantContentErrors,
585 };
586
587 return ($new_todos);
588 }; # $HTMLStrictlyInlineChecker
589
590 ## Inline-level or strictly inline-level content
591 my $HTMLInlineOrStrictlyInlineChecker = sub {
592 my ($self, $todo) = @_;
593 my $el = $todo->{node};
594 my $new_todos = [];
595 my @nodes = (@{$el->child_nodes});
596
597 my $old_values = {significant =>
598 $todo->{flag}->{has_descendant}->{significant}};
599 $todo->{flag}->{has_descendant}->{significant} = 0;
600
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 unless $HTMLStrictlyInlineLevelElements->{$node_ns}->{$node_ln} or
614 $self->{pluses}->{$node_ns}->{$node_ln};
615 } else {
616 $not_allowed = 1
617 unless $HTMLStrictlyInlineLevelElements->{$node_ns}->{$node_ln} or
618 $HTMLStructuredInlineLevelElements->{$node_ns}->{$node_ln} or
619 $self->{pluses}->{$node_ns}->{$node_ln};
620 }
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 } elsif ($nt == 3 or $nt == 4) {
627 if ($node->data =~ /[^\x09-\x0D\x20]/) {
628 $todo->{flag}->{has_descendant}->{significant} = 1;
629 }
630 } 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
640 push @$new_todos, {
641 type => 'descendant', node => $todo->{node}, flag => $todo->{flag},
642 old_values => $old_values,
643 errors => $HTMLSignificantContentErrors,
644 };
645
646 return ($new_todos);
647 }; # $HTMLInlineOrStrictlyInlineChecker
648
649 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 ## Block-level content or inline-level content (i.e. bimorphic content model)
696 my $HTMLBlockOrInlineChecker = sub {
697 my ($self, $todo) = @_;
698 my $el = $todo->{node};
699 my $new_todos = [];
700 my @nodes = (@{$el->child_nodes});
701
702 my $old_values = {significant =>
703 $todo->{flag}->{has_descendant}->{significant}};
704 $todo->{flag}->{has_descendant}->{significant} = 0;
705
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 ## ISSUE: It is unclear whether "<rule><div><p/><nest/></div></rule>"
713 ## is conforming or not.
714
715 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 unless $HTMLBlockLevelElements->{$node_ns}->{$node_ln} or
724 $self->{pluses}->{$node_ns}->{$node_ln};
725 } elsif ($content eq 'inline') {
726 $not_allowed = 1
727 unless $HTMLStrictlyInlineLevelElements->{$node_ns}->{$node_ln} or
728 $HTMLStructuredInlineLevelElements->{$node_ns}->{$node_ln} or
729 $self->{pluses}->{$node_ns}->{$node_ln};
730 } 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 if (not $is_block and not $self->{pluses}->{$node_ns}->{$node_ln}) {
739 $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 $todo->{flag}->{has_descendant}->{significant} = 1;
762 }
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
774 push @$new_todos, {
775 type => 'descendant', node => $todo->{node}, flag => $todo->{flag},
776 old_values => $old_values,
777 errors => $HTMLSignificantContentErrors,
778 };
779
780 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
792 my $old_values = {significant =>
793 $todo->{flag}->{has_descendant}->{significant}};
794 $todo->{flag}->{has_descendant}->{significant} = 0;
795
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 unless $HTMLBlockLevelElements->{$node_ns}->{$node_ln} or
819 $self->{pluses}->{$node_ns}->{$node_ln};
820 } elsif ($content eq 'inline') {
821 $has_non_style = 1;
822 $not_allowed = 1
823 unless $HTMLStrictlyInlineLevelElements->{$node_ns}->{$node_ln} or
824 $HTMLStructuredInlineLevelElements->{$node_ns}->{$node_ln} or
825 $self->{pluses}->{$node_ns}->{$node_ln};
826 } else {
827 $has_non_style = 1 unless $self->{pluses}->{$node_ns}->{$node_ln};
828 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 if (not $is_block and not $self->{pluses}->{$node_ns}->{$node_ln}) {
836 $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 $todo->{flag}->{has_descendant}->{significant} = 1;
860 }
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
872 push @$new_todos, {
873 type => 'descendant', node => $todo->{node}, flag => $todo->{flag},
874 old_values => $old_values,
875 errors => $HTMLSignificantContentErrors,
876 };
877
878 return ($new_todos);
879 };
880 }; # $GetHTMLZeroOrMoreThenBlockOrInlineChecker
881
882 my $HTMLTransparentChecker = $HTMLProseContentChecker;
883 ## ISSUE: Significant content rule should be applied to transparent element
884 ## with parent? Currently, applied to |video| but not to others.
885
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 ## Unordered set of space-separated tokens
915 my $HTMLUnorderedUniqueSetOfSpaceSeparatedTokensAttrChecker = sub {
916 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 }; # $HTMLUnorderedUniqueSetOfSpaceSeparatedTokensAttrChecker
926
927 ## |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 my ($a_or_area, $todo, $self, $attr) = @_;
931 my %word;
932 for my $word (grep {length $_} split /[\x09-\x0D\x20]/, $attr->value) {
933 unless ($word{$word}) {
934 $word{$word} = 1;
935 } elsif ($word eq 'up') {
936 #
937 } 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 if (defined $def->{effect}->[$a_or_area]) {
964 #
965 } else {
966 $self->{onerror}->(node => $attr,
967 type => 'link type:bad context:'.$word);
968 }
969 } else { # rejected or synonym
970 $self->{onerror}->(node => $attr,
971 type => 'link type:non-conforming:'.$word);
972 }
973 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 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 $todo->{has_hyperlink_link_type} = 1
994 if $word{alternate} and not $word{stylesheet};
995 ## 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
1006 ## NOTE: <link rel="up index"><link rel="up up index"> is not an error.
1007 ## NOTE: We can't check "If the page is part of multiple hierarchies,
1008 ## then they SHOULD be described in different paragraphs.".
1009 }; # $HTMLLinkTypesAttrChecker
1010
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
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 $self->{has_uri_attr} = 1; ## TODO: <html manifest>
1025 }; # $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 type => 'URIs:'.':'.
1036 $opt{type}.':'.$i.
1037 (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 $self->{has_uri_attr} = 1;
1047 }; # $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 ## NOTE: See also $AtomLanguageTagAttrChecker in Atom.pm.
1159
1160 my ($self, $attr) = @_;
1161 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 ## ISSUE: RFC 4646 (3066bis)?
1171
1172 ## TODO: testdata
1173 }; # $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 ## NOTE: An empty string is a valid browsing context name (same as _self).
1221 }
1222 }; # $HTMLTargetAttrChecker
1223
1224 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 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 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 ## ISSUE: RFC 4646 (3066bis)?
1291 unless ($attr->owner_document->manakai_is_html) {
1292 $self->{onerror}->(node => $attr, type => 'in XML:lang');
1293 }
1294
1295 ## TODO: test data
1296 },
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 tabindex => $HTMLIntegerAttrChecker
1321 ## TODO: ref, template, registrationmark
1322 };
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 manifest => $HTMLURIAttrChecker,
1373 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 my $old_values = {significant =>
1392 $todo->{flag}->{has_descendant}->{significant}};
1393 $todo->{flag}->{has_descendant}->{significant} = 0;
1394
1395 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 if ($self->{pluses}->{$node_ns}->{$node_ln}) {
1407 #
1408 } elsif ($phase eq 'before head') {
1409 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 $todo->{flag}->{has_descendant}->{significant} = 1;
1438 }
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 ## 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 errors => $HTMLSignificantContentErrors,
1457 };
1458
1459 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 if ($self->{pluses}->{$node_ns}->{$node_ln}) {
1483 #
1484 } elsif ($node_ns eq $HTML_NS and $node_ln eq 'title') {
1485 unless ($has_title) {
1486 $has_title = 1;
1487 } else {
1488 $not_allowed = 1;
1489 }
1490 } 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 } else {
1498 $not_allowed = 1;
1499 }
1500 $self->{onerror}->(node => $node, type => 'element not allowed')
1501 if $not_allowed;
1502 local $todo->{flag}->{in_head} = 1;
1503 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 $todo->{flag}->{has_descendant}->{significant} = 1;
1510 }
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 attrs_checker => sub {
1529 my ($self, $todo) = @_;
1530
1531 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 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 ## 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 ## NOTE: <html manifest=".."><head><base href=""/> is conforming as
1551 ## an exception.
1552 $self->{onerror}->(node => $todo->{node},
1553 type => 'basehref after URI attribute');
1554 }
1555 if ($self->{has_hyperlink_element} and $has_target) {
1556 ## 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 if (not $has_href and not $has_target) {
1568 $self->{onerror}->(node => $todo->{node},
1569 type => 'attribute missing:href|target');
1570 }
1571
1572 return $GetHTMLAttrsChecker->({
1573 href => $HTMLURIAttrChecker,
1574 target => $HTMLTargetAttrChecker,
1575 })->($self, $todo);
1576 },
1577 checker => $HTMLEmptyChecker,
1578 };
1579
1580 $Element->{$HTML_NS}->{link} = {
1581 attrs_checker => sub {
1582 my ($self, $todo) = @_;
1583 $GetHTMLAttrsChecker->({
1584 href => $HTMLURIAttrChecker,
1585 rel => sub { $HTMLLinkTypesAttrChecker->(0, $todo, @_) },
1586 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 if ($todo->{node}->has_attribute_ns (undef, 'href')) {
1593 $self->{has_hyperlink_element} = 1 if $todo->{has_hyperlink_link_type};
1594 } else {
1595 $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 } elsif ($keyword eq 'content-type') {
1703 $self->{onerror}
1704 ->(node => $http_equiv_attr,
1705 type => 'enumerated:invalid:http-equiv:content-type');
1706 } else {
1707 $self->{onerror}->(node => $http_equiv_attr,
1708 type => 'enumerated:invalid');
1709 }
1710 }
1711
1712 if (defined $charset_attr) {
1713 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 unless ($todo->{node}->owner_document->manakai_is_html) {
1731 $self->{onerror}->(node => $charset_attr,
1732 type => 'in XML:charset');
1733 }
1734
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 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 }
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 ## NOTE: |html:style| itself has no conformance creteria on content model.
1828 my ($self, $todo) = @_;
1829 my $type = $todo->{node}->get_attribute_ns (undef, 'type');
1830 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 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 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 $self->{onsubdoc}->({s => $ss_text, container_node => $el,
1862 media_type => 'text/css', is_char_string => 1});
1863 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 },
1870 };
1871 ## ISSUE: Relationship to significant content check?
1872
1873 $Element->{$HTML_NS}->{body} = {
1874 attrs_checker => $GetHTMLAttrsChecker->({}),
1875 checker => $HTMLProseContentChecker,
1876 };
1877
1878 $Element->{$HTML_NS}->{section} = {
1879 attrs_checker => $GetHTMLAttrsChecker->({}),
1880 checker => $HTMLProseContentChecker,
1881 };
1882
1883 $Element->{$HTML_NS}->{nav} = {
1884 attrs_checker => $GetHTMLAttrsChecker->({}),
1885 checker => $HTMLProseContentChecker,
1886 };
1887
1888 $Element->{$HTML_NS}->{article} = {
1889 attrs_checker => $GetHTMLAttrsChecker->({}),
1890 checker => $HTMLProseContentChecker,
1891 };
1892
1893 $Element->{$HTML_NS}->{blockquote} = {
1894 attrs_checker => $GetHTMLAttrsChecker->({
1895 cite => $HTMLURIAttrChecker,
1896 }),
1897 checker => $HTMLProseContentChecker,
1898 };
1899
1900 $Element->{$HTML_NS}->{aside} = {
1901 attrs_checker => $GetHTMLAttrsChecker->({}),
1902 checker => $HTMLProseContentChecker,
1903 };
1904
1905 $Element->{$HTML_NS}->{h1} = {
1906 attrs_checker => $GetHTMLAttrsChecker->({}),
1907 checker => sub {
1908 my ($self, $todo) = @_;
1909 $todo->{flag}->{has_descendant}->{hn} = 1;
1910 return $HTMLPhrasingContentChecker->($self, $todo);
1911 },
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 ## TODO: Explicit sectioning is "encouraged".
1940
1941 $Element->{$HTML_NS}->{header} = {
1942 attrs_checker => $GetHTMLAttrsChecker->({}),
1943 checker => sub {
1944 my ($self, $todo) = @_;
1945
1946 my $old_flags = {hn => $todo->{flag}->{has_descendant}->{hn}};
1947 $todo->{flag}->{has_descendant}->{hn} = 0;
1948
1949 my $end = $self->_add_minuses
1950 ({$HTML_NS => {qw/header 1 footer 1/}},
1951 $HTMLSectioningContent);
1952 my ($new_todos, $ch) = $HTMLProseContentChecker->($self, $todo);
1953 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 }};
1963 return ($new_todos, $ch);
1964
1965 ## ISSUE: <header><del><h1>...</h1></del></header> is conforming?
1966 },
1967 };
1968
1969 $Element->{$HTML_NS}->{footer} = {
1970 attrs_checker => $GetHTMLAttrsChecker->({}),
1971 checker => sub {
1972 my ($self, $todo) = @_;
1973
1974 my $old_flags = {hn => $todo->{flag}->{has_descendant}->{hn}};
1975 $todo->{flag}->{has_descendant}->{hn} = 0;
1976
1977 my $end = $self->_add_minuses
1978 ({$HTML_NS => {footer => 1}},
1979 $HTMLSectioningContent, $HTMLHeadingContent);
1980 my ($new_todos, $ch) = $HTMLProseContentChecker->($self, $todo);
1981 push @$new_todos, $end;
1982
1983 return ($new_todos, $ch);
1984 },
1985 };
1986
1987 $Element->{$HTML_NS}->{address} = {
1988 attrs_checker => $GetHTMLAttrsChecker->({}),
1989 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 };
2004
2005 $Element->{$HTML_NS}->{p} = {
2006 attrs_checker => $GetHTMLAttrsChecker->({}),
2007 checker => $HTMLPhrasingContentChecker,
2008 };
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 ## NOTE: Blank line MUST NOT be used for presentation purpose.
2019 ## (This requirement is semantic so that we cannot check.)
2020 };
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 if ($self->{pluses}->{$node_ns}->{$node_ln}) {
2042 #
2043 } elsif ($phase eq 'before dt') {
2044 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 $todo->{flag}->{has_descendant}->{significant} = 1;
2071 }
2072 } elsif ($nt == 5) {
2073 unshift @nodes, @{$node->child_nodes};
2074 }
2075 }
2076 if ($phase eq 'before dd') {
2077 $self->{onerror}->(node => $el, type => 'child element missing:dd');
2078 }
2079 return ($new_todos);
2080 },
2081 };
2082
2083 $Element->{$HTML_NS}->{pre} = {
2084 attrs_checker => $GetHTMLAttrsChecker->({}),
2085 checker => $HTMLPhrasingContentChecker,
2086 };
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 if ($self->{pluses}->{$node_ns}->{$node_ln}) {
2109 #
2110 } elsif (not ($node_ns eq $HTML_NS and $node_ln eq 'li')) {
2111 $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 $todo->{flag}->{has_descendant}->{significant} = 1;
2120 }
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 if ($todo->{flag}->{in_menu}) {
2160 return $HTMLPhrasingContentChecker->($self, $todo);
2161 } else {
2162 return $HTMLProseContentChecker->($self, $todo);
2163 }
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 if ($self->{pluses}->{$node_ns}->{$node_ln}) {
2187 #
2188 } elsif ($phase eq 'in dds') {
2189 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 $todo->{flag}->{has_descendant}->{significant} = 1;
2222 }
2223 } elsif ($nt == 5) {
2224 unshift @nodes, @{$node->child_nodes};
2225 }
2226 }
2227 if ($phase eq 'in dts') {
2228 $self->{onerror}->(node => $el, type => 'child element missing:dd');
2229 }
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 checker => $HTMLPhrasingContentChecker,
2243 };
2244
2245 $Element->{$HTML_NS}->{dd} = {
2246 attrs_checker => $GetHTMLAttrsChecker->({}),
2247 checker => $HTMLProseContentChecker,
2248 };
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 rel => sub { $HTMLLinkTypesAttrChecker->(1, $todo, @_) },
2265 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 if (defined $attr{href}) {
2287 $self->{has_hyperlink_element} = 1;
2288 } else {
2289 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 my ($new_todos, $ch) = $HTMLPhrasingContentChecker->($self, $todo);
2302 push @$new_todos, $end;
2303
2304 if ($todo->{node}->has_attribute_ns (undef, 'href')) {
2305 $_->{flag}->{in_a_href} = 1 for @$new_todos;
2306 }
2307
2308 return ($new_todos, $ch);
2309 },
2310 };
2311
2312 $Element->{$HTML_NS}->{q} = {
2313 attrs_checker => $GetHTMLAttrsChecker->({
2314 cite => $HTMLURIAttrChecker,
2315 }),
2316 checker => $HTMLPhrasingContentChecker,
2317 };
2318
2319 $Element->{$HTML_NS}->{cite} = {
2320 attrs_checker => $GetHTMLAttrsChecker->({}),
2321 checker => $HTMLPhrasingContentChecker,
2322 };
2323
2324 $Element->{$HTML_NS}->{em} = {
2325 attrs_checker => $GetHTMLAttrsChecker->({}),
2326 checker => $HTMLPhrasingContentChecker,
2327 };
2328
2329 $Element->{$HTML_NS}->{strong} = {
2330 attrs_checker => $GetHTMLAttrsChecker->({}),
2331 checker => $HTMLPhrasingContentChecker,
2332 };
2333
2334 $Element->{$HTML_NS}->{small} = {
2335 attrs_checker => $GetHTMLAttrsChecker->({}),
2336 checker => $HTMLPhrasingContentChecker,
2337 };
2338
2339 $Element->{$HTML_NS}->{m} = {
2340 attrs_checker => $GetHTMLAttrsChecker->({}),
2341 checker => $HTMLPhrasingContentChecker,
2342 };
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 my ($sib, $ch) = $HTMLPhrasingContentChecker->($self, $todo);
2351 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 checker => $HTMLPhrasingContentChecker,
2404 };
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 return $HTMLPhrasingContentChecker->($self, $todo);
2534 },
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 checker => $HTMLPhrasingContentChecker,
2547 };
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 checker => $HTMLPhrasingContentChecker,
2555 };
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 checker => $HTMLPhrasingContentChecker,
2562 };
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 checker => $HTMLPhrasingContentChecker,
2569 };
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 checker => $HTMLPhrasingContentChecker,
2576 };
2577
2578 $Element->{$HTML_NS}->{kbd} = {
2579 attrs_checker => $GetHTMLAttrsChecker->({}),
2580 checker => $HTMLPhrasingContentChecker,
2581 };
2582
2583 $Element->{$HTML_NS}->{sub} = {
2584 attrs_checker => $GetHTMLAttrsChecker->({}),
2585 checker => $HTMLPhrasingContentChecker,
2586 };
2587
2588 $Element->{$HTML_NS}->{sup} = {
2589 attrs_checker => $GetHTMLAttrsChecker->({}),
2590 checker => $HTMLPhrasingContentChecker,
2591 };
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 checker => $HTMLPhrasingContentChecker,
2598 };
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 checker => $HTMLPhrasingContentChecker,
2605 };
2606
2607 $Element->{$HTML_NS}->{b} = {
2608 attrs_checker => $GetHTMLAttrsChecker->({}),
2609 checker => $HTMLPhrasingContentChecker,
2610 };
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 checker => $HTMLPhrasingContentChecker,
2622 };
2623
2624 =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 $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 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 },
2669 };
2670
2671 ## TODO: figure
2672 ## TODO: Test for <nest/> in <figure/>
2673
2674 ## TODO: |alt|
2675 $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 if (not $todo->{flag}->{in_a_href}) {
2685 $self->{onerror}->(node => $attr,
2686 type => 'attribute not allowed:ismap');
2687 }
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 checker => sub {
2701 my ($self, $todo) = @_;
2702 $todo->{flag}->{has_descendant}->{significant} = 1;
2703 return $HTMLEmptyChecker->($self, $todo);
2704 },
2705 };
2706
2707 $Element->{$HTML_NS}->{iframe} = {
2708 attrs_checker => $GetHTMLAttrsChecker->({
2709 src => $HTMLURIAttrChecker,
2710 }),
2711 checker => sub {
2712 my ($self, $todo) = @_;
2713 $todo->{flag}->{has_descendant}->{significant} = 1;
2714 return $HTMLTextChecker->($self, $todo);
2715 },
2716 };
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 checker => sub {
2757 my ($self, $todo) = @_;
2758 $todo->{flag}->{has_descendant}->{significant} = 1;
2759 return $HTMLEmptyChecker->($self, $todo);
2760 },
2761 };
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 ## NOTE: param*, then transparent.
2781 checker => sub {
2782 my ($self, $todo) = @_;
2783 $todo->{flag}->{has_descendant}->{significant} = 1;
2784 return $ElementDefault->{checker}->($self, $todo); ## TODO
2785 },
2786 ## TODO: Tests for <nest/> in <object/>
2787 };
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 ## ISSUE: playcount has no conformance creteria
2814 autoplay => $GetHTMLBooleanAttrChecker->('autoplay'),
2815 controls => $GetHTMLBooleanAttrChecker->('controls'),
2816 poster => $HTMLURIAttrChecker, ## TODO: not for audio!
2817 ## TODO: width, height (not for audio!)
2818 }),
2819 checker => sub {
2820 my ($self, $todo) = @_;
2821 $todo->{flag}->{has_descendant}->{significant} = 1;
2822
2823 ## TODO:
2824 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 checker => sub {
2860 my ($self, $todo) = @_;
2861 $todo->{flag}->{has_descendant}->{significant} = 1;
2862 return $HTMLTransparentChecker->($self, $todo);
2863 },
2864 };
2865
2866 $Element->{$HTML_NS}->{map} = {
2867 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 } else {
2883 ## NOTE: MUST contain at least one character
2884 $self->{onerror}->(node => $attr, type => 'empty attribute value');
2885 }
2886 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 checker => $HTMLProseContentChecker,
2897 };
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 rel => sub { $HTMLLinkTypesAttrChecker->(1, $todo, @_) },
2933 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 $self->{has_hyperlink_element} = 1;
2956 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 if ($self->{pluses}->{$node_ns}->{$node_ln}) {
3073 #
3074 } elsif ($phase eq 'in tbodys') {
3075 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 $todo->{flag}->{has_descendant}->{significant} = 1;
3147 }
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 checker => $HTMLStrictlyInlineChecker,
3168 };
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 if ($self->{pluses}->{$node_ns}->{$node_ln}) {
3195 #
3196 } elsif (not ($node_ns eq $HTML_NS and $node_ln eq 'col')) {
3197 $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 $todo->{flag}->{has_descendant}->{significant} = 1;
3206 }
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 if ($self->{pluses}->{$node_ns}->{$node_ln}) {
3242 #
3243 } elsif ($node_ns eq $HTML_NS and $node_ln eq 'tr') {
3244 $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 $todo->{flag}->{has_descendant}->{significant} = 1;
3255 }
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 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 $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 $todo->{flag}->{has_descendant}->{significant} = 1;
3311 }
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 checker => $HTMLProseContentChecker,
3329 };
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 checker => $HTMLProseContentChecker,
3339 };
3340
3341 ## TODO: forms
3342 ## TODO: Tests for <nest/> in form elements
3343
3344 $Element->{$HTML_NS}->{script} = {
3345 attrs_checker => $GetHTMLAttrsChecker->({
3346 src => $HTMLURIAttrChecker,
3347 defer => $GetHTMLBooleanAttrChecker->('defer'),
3348 async => $GetHTMLBooleanAttrChecker->('async'),
3349 type => $HTMLIMTAttrChecker,
3350 }),
3351 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 ## ISSUE: Significant check and text child node
3377
3378 ## NOTE: When script is disabled.
3379 $Element->{$HTML_NS}->{noscript} = {
3380 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 checker => sub {
3393 my ($self, $todo) = @_;
3394
3395 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 if ($self->{pluses}->{$node_ns}->{$node_ln}) {
3409 #
3410 } elsif ($node_ns eq $HTML_NS) {
3411 if ({link => 1, style => 1}->{$node_ln}) {
3412 #
3413 } elsif ($node_ln eq 'meta') {
3414 if ($node->has_attribute_ns (undef, 'name')) {
3415 #
3416 } else {
3417 $self->{onerror}->(node => $node,
3418 type => 'element not allowed');
3419 }
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 $todo->{flag}->{has_descendant}->{significant} = 1;
3434 }
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 my ($sib, $ch) = $HTMLTransparentChecker->($self, $todo);
3443 push @$sib, $end;
3444 return ($sib, $ch);
3445 }
3446 },
3447 };
3448
3449 ## ISSUE: Scripting is disabled: <head><noscript><html a></noscript></head>
3450
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 ## TODO:
3466 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 my $old_values = {significant =>
3485 $todo->{flag}->{has_descendant}->{significant}};
3486 $todo->{flag}->{has_descendant}->{significant} = 0;
3487
3488 my $end = $self->_add_minuses ({$HTML_NS => {a => 1, datagrid => 1}});
3489
3490 ## Prose -(text* table Prose*) | table | select | datalist | Empty
3491 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 if ($self->{pluses}->{$node_ns}->{$node_ln}) {
3503 #
3504 } elsif ($mode eq 'prose') {
3505 $not_allowed = 1
3506 unless $HTMLProseContent->{$node_ns}->{$node_ln};
3507 } 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 } elsif ($HTMLProseContent->{$node_ns}->{$node_ln}) {
3512 $mode = 'prose';
3513 } 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 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 $todo->{flag}->{has_descendant}->{significant} = 1;
3534 }
3535 } elsif ($nt == 5) {
3536 unshift @nodes, @{$node->child_nodes};
3537 }
3538 }
3539
3540 push @$new_todos, $end;
3541
3542 push @$new_todos, {
3543 type => 'descendant', node => $todo->{node}, flag => $todo->{flag},
3544 old_values => $old_values,
3545 errors => $HTMLSignificantContentErrors,
3546 };
3547
3548 return ($new_todos);
3549
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 },
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
3610 my $old_values = {significant =>
3611 $todo->{flag}->{has_descendant}->{significant}};
3612 $todo->{flag}->{has_descendant}->{significant} = 0;
3613
3614 my $content = 'li or phrasing';
3615 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 if ($self->{pluses}->{$node_ns}->{$node_ln}) {
3626 #
3627 } elsif ($node_ns eq $HTML_NS and $node_ln eq 'li') {
3628 if ($content eq 'phrasing') {
3629 $not_allowed = 1;
3630 } elsif ($content eq 'li or phrasing') {
3631 $content = 'li';
3632 }
3633 } else {
3634 if ($HTMLPhrasingContent->{$node_ns}->{$node_ln}) {
3635 $content = 'phrasing';
3636 } 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 } elsif ($content eq 'li or phrasing') {
3650 $content = 'phrasing';
3651 }
3652 $todo->{flag}->{has_descendant}->{significant} = 1;
3653 }
3654 } elsif ($nt == 5) {
3655 unshift @nodes, @{$node->child_nodes};
3656 }
3657 }
3658
3659 for (@$new_todos) {
3660 $_->{flag}->{in_menu} = 1;
3661 }
3662
3663 push @$new_todos, {
3664 type => 'descendant', node => $todo->{node}, flag => $todo->{flag},
3665 old_values => $old_values,
3666 errors => $HTMLSignificantContentErrors,
3667 };
3668
3669 return ($new_todos);
3670 },
3671 };
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 $todo->{flag}->{has_descendant}->{significant} = 1;
3704 }
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 condition => $HTMLSelectorsAttrChecker,
3717 mode => $HTMLUnorderedUniqueSetOfSpaceSeparatedTokensAttrChecker,
3718 }),
3719 checker => sub {
3720 my ($self, $todo) = @_;
3721
3722 my $end = $self->_add_pluses ({$HTML_NS => {nest => 1}});
3723 my ($sib, $ch) = $HTMLAnyChecker->($self, $todo);
3724 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 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 }),
3743 checker => $HTMLEmptyChecker,
3744 };
3745
3746 $Element->{$HTML_NS}->{legend} = {
3747 attrs_checker => $GetHTMLAttrsChecker->({}),
3748 checker => $HTMLPhrasingContentChecker,
3749 };
3750
3751 $Element->{$HTML_NS}->{div} = {
3752 attrs_checker => $GetHTMLAttrsChecker->({}),
3753 checker => $HTMLTransparentChecker,
3754 };
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