/[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.26 - (hide annotations) (download)
Sun Nov 25 08:10:07 2007 UTC (18 years, 10 months ago) by wakaba
Branch: MAIN
Changes since 1.25: +22 -104 lines
++ whatpm/Whatpm/ContentChecker/ChangeLog	25 Nov 2007 08:10:04 -0000
	* HTML.pm ($HTMLSignificantContentErrors): New.

2007-11-25  Wakaba  <wakaba@suika.fam.cx>

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

[email protected]
ViewVC Help
Powered by ViewVC 1.1.24