/[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.25 - (hide annotations) (download)
Sun Nov 25 08:04:20 2007 UTC (18 years, 10 months ago) by wakaba
Branch: MAIN
Changes since 1.24: +317 -10 lines
++ whatpm/t/ChangeLog	25 Nov 2007 07:57:28 -0000
2007-11-25  Wakaba  <wakaba@suika.fam.cx>

	* content-model-1.dat, content-model-2.dat, content-model-3.dat,
	content-model-4.dat, table-1.dat: Test data are updated
	for the significant content check.

	* content-model-5.dat: New test data.

	* ContentChecker.t: New test data file is added.

++ whatpm/Whatpm/ChangeLog	25 Nov 2007 07:59:33 -0000
	* ContentChecker.pm ($AnyChecker): Old way to add child elements
	for checking had been used.

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

++ whatpm/Whatpm/ContentChecker/ChangeLog	25 Nov 2007 08:00:46 -0000
	* HTML.pm: Support for checking for significant content (HTML5
	revision 1114).  Note that the current implementation has
	an issue on treatment for transparent or semi-transparent
	elements.

	* Atom.pm: Support for significant content checking (for composed
	HTML-Atom documents).

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

[email protected]
ViewVC Help
Powered by ViewVC 1.1.24