/[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.6 - (hide annotations) (download)
Sun Sep 9 07:57:33 2007 UTC (19 years, 1 month ago) by wakaba
Branch: MAIN
Changes since 1.5: +26 -9 lines
++ whatpm/Whatpm/ChangeLog	9 Sep 2007 07:57:16 -0000
	* ContentChecker.pm: Support for language tag validation.

2007-09-09  Wakaba  <wakaba@suika.fam.cx>

++ whatpm/Whatpm/ContentChecker/ChangeLog	9 Sep 2007 07:56:59 -0000
2007-09-09  Wakaba  <wakaba@suika.fam.cx>

	* HTML.pm: Support for language tag validation.

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

[email protected]
ViewVC Help
Powered by ViewVC 1.1.24