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

Diff of /markup/html/whatpm/Whatpm/ContentChecker.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.36 by wakaba, Mon Jul 16 14:28:35 2007 UTC revision 1.97 by wakaba, Sun Sep 21 09:45:02 2008 UTC
# Line 1  Line 1 
1  package Whatpm::ContentChecker;  package Whatpm::ContentChecker;
2  use strict;  use strict;
3    our $VERSION=do{my @r=(q$Revision$=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};
4    
5  require Whatpm::URIChecker;  require Whatpm::URIChecker;
6    
7  ## ISSUE: How XML and XML Namespaces conformance can (or cannot)  ## ISSUE: How XML and XML Namespaces conformance can (or cannot)
8  ## be applied to an in-memory representation (i.e. DOM)?  ## be applied to an in-memory representation (i.e. DOM)?
9    
10    ## TODO: Conformance of an HTML document with non-html root element.
11    
12    ## Stability
13    sub FEATURE_STATUS_REC () { 0b1 } ## Interoperable standard
14    sub FEATURE_STATUS_CR () { 0b10 } ## Call for implementation
15    sub FEATURE_STATUS_LC () { 0b100 } ## Last call for comments
16    sub FEATURE_STATUS_WD () { 0b1000 } ## Working or editor's draft
17    
18    ## Deprecated
19    sub FEATURE_DEPRECATED_SHOULD () { 0b100000 } ## SHOULD-level
20    sub FEATURE_DEPRECATED_INFO () { 0b1000000 } ## Does not affect conformance
21    
22    ## Conformance
23    sub FEATURE_ALLOWED () { 0b10000 }
24    
25    my $HTML_NS = q<http://www.w3.org/1999/xhtml>;
26  my $XML_NS = q<http://www.w3.org/XML/1998/namespace>;  my $XML_NS = q<http://www.w3.org/XML/1998/namespace>;
27  my $XMLNS_NS = q<http://www.w3.org/2000/xmlns/>;  my $XMLNS_NS = q<http://www.w3.org/2000/xmlns/>;
28    
29  my $AttrChecker = {  my $Namespace = {
30      '' => {loaded => 1},
31      q<http://www.w3.org/2005/Atom> => {module => 'Whatpm::ContentChecker::Atom'},
32      q<http://purl.org/syndication/history/1.0>
33          => {module => 'Whatpm::ContentChecker::Atom'},
34      q<http://purl.org/syndication/threading/1.0>
35          => {module => 'Whatpm::ContentChecker::Atom'},
36      $HTML_NS => {module => 'Whatpm::ContentChecker::HTML'},
37      $XML_NS => {loaded => 1},
38      $XMLNS_NS => {loaded => 1},
39      q<http://www.w3.org/1999/02/22-rdf-syntax-ns#> => {loaded => 1},
40    };
41    
42    sub load_ns_module ($) {
43      my $nsuri = shift; # namespace URI or ''
44      unless ($Namespace->{$nsuri}->{loaded}) {
45        if ($Namespace->{$nsuri}->{module}) {
46          eval qq{ require $Namespace->{$nsuri}->{module} } or die $@;
47        } else {
48          $Namespace->{$nsuri}->{loaded} = 1;
49        }
50      }
51    } # load_ns_module
52    
53    our $AttrChecker = {
54    $XML_NS => {    $XML_NS => {
55      space => sub {      space => sub {
56        my ($self, $attr) = @_;        my ($self, $attr) = @_;
# Line 18  my $AttrChecker = { Line 59  my $AttrChecker = {
59          #          #
60        } else {        } else {
61          ## NOTE: An XML "error"          ## NOTE: An XML "error"
62          $self->{onerror}->(node => $attr, level => 'error',          $self->{onerror}->(node => $attr, level => $self->{level}->{xml_error},
63                             type => 'invalid attribute value');                             type => 'invalid attribute value');
64        }        }
65      },      },
66      lang => sub {      lang => sub {
67        my ($self, $attr) = @_;        my ($self, $attr) = @_;
68          my $value = $attr->value;
69          if ($value eq '') {
70            #
71          } else {
72            require Whatpm::LangTag;
73            Whatpm::LangTag->check_rfc3066_language_tag ($value, sub {
74              $self->{onerror}->(@_, node => $attr);
75            }, $self->{level});
76          }
77    
78        ## NOTE: "The values of the attribute are language identifiers        ## NOTE: "The values of the attribute are language identifiers
79        ## as defined by [IETF RFC 3066], Tags for the Identification        ## as defined by [IETF RFC 3066], Tags for the Identification
80        ## of Languages, or its successor; in addition, the empty string        ## of Languages, or its successor; in addition, the empty string
81        ## may be specified." ("may" in lower case)        ## may be specified." ("may" in lower case)
82        $self->{onerror}->(node => $attr, level => 'unsupported',        ## NOTE: Is an RFC 3066-valid (but RFC 4646-invalid) language tag
83                           type => 'language tag');        ## allowed today?
84    
85          ## TODO: test data
86    
87          my $nsuri = $attr->owner_element->namespace_uri;
88          if (defined $nsuri and $nsuri eq $HTML_NS) {
89            my $lang_attr = $attr->owner_element->get_attribute_node_ns
90                (undef, 'lang');
91            if ($lang_attr) {
92              my $lang_attr_value = $lang_attr->value;
93              $lang_attr_value =~ tr/A-Z/a-z/; ## ASCII case-insensitive
94              my $value = $value;
95              $value =~ tr/A-Z/a-z/; ## ASCII case-insensitive
96              if ($lang_attr_value ne $value) {
97                ## NOTE: HTML5 Section "The |lang| and |xml:lang| attributes"
98                $self->{onerror}->(node => $attr,
99                                   type => 'xml:lang ne lang',
100                                   level => $self->{level}->{must});
101              }
102            }
103          }
104    
105        if ($attr->owner_document->manakai_is_html) { # MUST NOT        if ($attr->owner_document->manakai_is_html) { # MUST NOT
106          $self->{onerror}->(node => $attr, type => 'in HTML:xml:lang');          $self->{onerror}->(node => $attr, type => 'in HTML:xml:lang',
107                               level => $self->{level}->{must});
108  ## TODO: Test data...  ## TODO: Test data...
109        }        }
110      },      },
# Line 40  my $AttrChecker = { Line 113  my $AttrChecker = {
113        my $value = $attr->value;        my $value = $attr->value;
114        if ($value =~ /[^\x{0000}-\x{10FFFF}]/) { ## ISSUE: Should we disallow noncharacters?        if ($value =~ /[^\x{0000}-\x{10FFFF}]/) { ## ISSUE: Should we disallow noncharacters?
115          $self->{onerror}->(node => $attr,          $self->{onerror}->(node => $attr,
116                             type => 'invalid attribute value');                             type => 'invalid attribute value',
117                               level => $self->{level}->{fact}, ## TODO: correct?
118                              );
119        }        }
120        ## NOTE: Conformance to URI standard is not checked since there is        ## NOTE: Conformance to URI standard is not checked since there is
121        ## no author requirement on conformance in the XML Base specification.        ## no author requirement on conformance in the XML Base specification.
# Line 53  my $AttrChecker = { Line 128  my $AttrChecker = {
128        $value =~ s/\x20$//;        $value =~ s/\x20$//;
129        ## TODO: NCName in XML 1.0 or 1.1        ## TODO: NCName in XML 1.0 or 1.1
130        ## TODO: declared type is ID?        ## TODO: declared type is ID?
131        if ($self->{id}->{$value}) { ## NOTE: An xml:id error        if ($self->{id}->{$value}) {
132          $self->{onerror}->(node => $attr, level => 'error',          $self->{onerror}->(node => $attr,
133                             type => 'duplicate ID');                             type => 'duplicate ID',
134                               level => $self->{level}->{xml_id_error});
135            push @{$self->{id}->{$value}}, $attr;
136        } else {        } else {
137          $self->{id}->{$value} = 1;          $self->{id}->{$value} = [$attr];
138        }        }
139      },      },
140    },    },
# Line 68  my $AttrChecker = { Line 145  my $AttrChecker = {
145        my $value = $attr->value;        my $value = $attr->value;
146        if ($value eq $XML_NS and $ln ne 'xml') {        if ($value eq $XML_NS and $ln ne 'xml') {
147          $self->{onerror}          $self->{onerror}
148            ->(node => $attr, level => 'NC',            ->(node => $attr,
149               type => 'Reserved Prefixes and Namespace Names:=xml');               type => 'Reserved Prefixes and Namespace Names:Name',
150                 text => $value,
151                 level => $self->{level}->{nc});
152        } elsif ($value eq $XMLNS_NS) {        } elsif ($value eq $XMLNS_NS) {
153          $self->{onerror}          $self->{onerror}
154            ->(node => $attr, level => 'NC',            ->(node => $attr,
155               type => 'Reserved Prefixes and Namespace Names:=xmlns');               type => 'Reserved Prefixes and Namespace Names:Name',
156                 text => $value,
157                 level => $self->{level}->{nc});
158        }        }
159        if ($ln eq 'xml' and $value ne $XML_NS) {        if ($ln eq 'xml' and $value ne $XML_NS) {
160          $self->{onerror}          $self->{onerror}
161            ->(node => $attr, level => 'NC',            ->(node => $attr,
162               type => 'Reserved Prefixes and Namespace Names:xmlns:xml=');               type => 'Reserved Prefixes and Namespace Names:Prefix',
163                 text => $ln,
164                 level => $self->{level}->{nc});
165        } elsif ($ln eq 'xmlns') {        } elsif ($ln eq 'xmlns') {
166          $self->{onerror}          $self->{onerror}
167            ->(node => $attr, level => 'NC',            ->(node => $attr,
168               type => 'Reserved Prefixes and Namespace Names:xmlns:xmlns=');               type => 'Reserved Prefixes and Namespace Names:Prefix',
169                 text => $ln,
170                 level => $self->{level}->{nc});
171        }        }
172        ## TODO: If XML 1.0 and empty        ## TODO: If XML 1.0 and empty
173      },      },
# Line 94  my $AttrChecker = { Line 179  my $AttrChecker = {
179        my $value = $attr->value;        my $value = $attr->value;
180        if ($value eq $XML_NS) {        if ($value eq $XML_NS) {
181          $self->{onerror}          $self->{onerror}
182            ->(node => $attr, level => 'NC',            ->(node => $attr,
183               type => 'Reserved Prefixes and Namespace Names:=xml');               type => 'Reserved Prefixes and Namespace Names:Name',
184                 text => $value,
185                 level => $self->{level}->{nc});
186        } elsif ($value eq $XMLNS_NS) {        } elsif ($value eq $XMLNS_NS) {
187          $self->{onerror}          $self->{onerror}
188            ->(node => $attr, level => 'NC',            ->(node => $attr,
189               type => 'Reserved Prefixes and Namespace Names:=xmlns');               type => 'Reserved Prefixes and Namespace Names:Name',
190                 text => $value,
191                 level => $self->{level}->{nc});
192        }        }
193      },      },
194    },    },
# Line 108  my $AttrChecker = { Line 197  my $AttrChecker = {
197  ## ISSUE: Should we really allow these attributes?  ## ISSUE: Should we really allow these attributes?
198  $AttrChecker->{''}->{'xml:space'} = $AttrChecker->{$XML_NS}->{space};  $AttrChecker->{''}->{'xml:space'} = $AttrChecker->{$XML_NS}->{space};
199  $AttrChecker->{''}->{'xml:lang'} = $AttrChecker->{$XML_NS}->{lang};  $AttrChecker->{''}->{'xml:lang'} = $AttrChecker->{$XML_NS}->{lang};
200        ## NOTE: Checker for (null, "xml:lang") attribute is shadowed for
201        ## HTML elements in Whatpm::ContentChecker::HTML.
202  $AttrChecker->{''}->{'xml:base'} = $AttrChecker->{$XML_NS}->{base};  $AttrChecker->{''}->{'xml:base'} = $AttrChecker->{$XML_NS}->{base};
203  $AttrChecker->{''}->{'xml:id'} = $AttrChecker->{$XML_NS}->{id};  $AttrChecker->{''}->{'xml:id'} = $AttrChecker->{$XML_NS}->{id};
204    
205  ## ANY  our $AttrStatus;
 my $AnyChecker = sub {  
   my ($self, $todo) = @_;  
   my $el = $todo->{node};  
   my $new_todos = [];  
   my @nodes = (@{$el->child_nodes});  
   while (@nodes) {  
     my $node = shift @nodes;  
     $self->_remove_minuses ($node) and next if ref $node eq 'HASH';  
   
     my $nt = $node->node_type;  
     if ($nt == 1) {  
       my $node_ns = $node->namespace_uri;  
       $node_ns = '' unless defined $node_ns;  
       my $node_ln = $node->manakai_local_name;  
       if ($self->{minuses}->{$node_ns}->{$node_ln}) {  
         $self->{onerror}->(node => $node, type => 'element not allowed');  
       }  
       push @$new_todos, {type => 'element', node => $node};  
     } elsif ($nt == 5) {  
       unshift @nodes, @{$node->child_nodes};  
     }  
   }  
   return ($new_todos);  
 }; # $AnyChecker  
   
 my $ElementDefault = {  
   checker => sub {  
     my ($self, $todo) = @_;  
     $self->{onerror}->(node => $todo->{node}, level => 'unsupported',  
                        type => 'element');  
     return $AnyChecker->($self, $todo);  
   },  
   attrs_checker => sub {  
     my ($self, $todo) = @_;  
     for my $attr (@{$todo->{node}->attributes}) {  
       my $attr_ns = $attr->namespace_uri;  
       $attr_ns = '' unless defined $attr_ns;  
       my $attr_ln = $attr->manakai_local_name;  
       my $checker = $AttrChecker->{$attr_ns}->{$attr_ln}  
         || $AttrChecker->{$attr_ns}->{''};  
       if ($checker) {  
         $checker->($self, $attr);  
       } else {  
         $self->{onerror}->(node => $attr, level => 'unsupported',  
                            type => 'attribute');  
       }  
     }  
   },  
 };  
   
 my $Element = {};  
   
 my $HTML_NS = q<http://www.w3.org/1999/xhtml>;  
   
 my $HTMLMetadataElements = {  
   $HTML_NS => {  
     qw/link 1 meta 1 style 1 script 1 event-source 1 command 1 base 1 title 1  
        noscript 1  
       /,  
   },  
 };  
   
 my $HTMLSectioningElements = {  
   $HTML_NS => {qw/body 1 section 1 nav 1 article 1 blockquote 1 aside 1/},  
 };  
   
 my $HTMLBlockLevelElements = {  
   $HTML_NS => {  
     qw/  
       section 1 nav 1 article 1 blockquote 1 aside 1  
       h1 1 h2 1 h3 1 h4 1 h5 1 h6 1 header 1 footer 1  
       address 1 p 1 hr 1 dialog 1 pre 1 ol 1 ul 1 dl 1  
       ins 1 del 1 figure 1 map 1 table 1 script 1 noscript 1  
       event-source 1 details 1 datagrid 1 menu 1 div 1 font 1  
     /,  
   },  
 };  
   
 my $HTMLStrictlyInlineLevelElements = {  
   $HTML_NS => {  
     qw/  
       br 1 a 1 q 1 cite 1 em 1 strong 1 small 1 m 1 dfn 1 abbr 1  
       time 1 meter 1 progress 1 code 1 var 1 samp 1 kbd 1  
       sub 1 sup 1 span 1 i 1 b 1 bdo 1 ins 1 del 1 img 1  
       iframe 1 embed 1 object 1 video 1 audio 1 canvas 1 area 1  
       script 1 noscript 1 event-source 1 command 1 font 1  
     /,  
   },  
 };  
   
 my $HTMLStructuredInlineLevelElements = {  
   $HTML_NS => {qw/blockquote 1 pre 1 ol 1 ul 1 dl 1 table 1 menu 1/},  
 };  
   
 my $HTMLInteractiveElements = {  
   $HTML_NS => {a => 1, details => 1, datagrid => 1},  
 };  
 ## NOTE: |html:a| and |html:datagrid| are not allowed as a descendant  
 ## of interactive elements  
   
 my $HTMLTransparentElements = {  
   $HTML_NS => {qw/ins 1 font 1 noscript 1/},  
   ## NOTE: |html:noscript| is transparent if scripting is disabled  
   ## and not in |head|.  
 };  
   
 #my $HTMLSemiTransparentElements = {  
 #  $HTML_NS => {qw/video 1 audio 1/},  
 #};  
   
 my $HTMLEmbededElements = {  
   $HTML_NS => {qw/img 1 iframe 1 embed 1 object 1 video 1 audio 1 canvas 1/},  
 };  
   
 ## Empty  
 my $HTMLEmptyChecker = sub {  
   my ($self, $todo) = @_;  
   my $el = $todo->{node};  
   my $new_todos = [];  
   my @nodes = (@{$el->child_nodes});  
   
   while (@nodes) {  
     my $node = shift @nodes;  
     $self->_remove_minuses ($node) and next if ref $node eq 'HASH';  
   
     my $nt = $node->node_type;  
     if ($nt == 1) {  
       ## NOTE: |minuses| list is not checked since redundant  
       $self->{onerror}->(node => $node, type => 'element not allowed');  
       my ($sib, $ch) = $self->_check_get_children ($node, $todo);  
       unshift @nodes, @$sib;  
       push @$new_todos, @$ch;  
     } elsif ($nt == 3 or $nt == 4) {  
       if ($node->data =~ /[^\x09-\x0D\x20]/) {  
         $self->{onerror}->(node => $node, type => 'character not allowed');  
       }  
     } elsif ($nt == 5) {  
       unshift @nodes, @{$node->child_nodes};  
     }  
   }  
   return ($new_todos);  
 };  
   
 ## Text  
 my $HTMLTextChecker = sub {  
   my ($self, $todo) = @_;  
   my $el = $todo->{node};  
   my $new_todos = [];  
   my @nodes = (@{$el->child_nodes});  
   
   while (@nodes) {  
     my $node = shift @nodes;  
     $self->_remove_minuses ($node) and next if ref $node eq 'HASH';  
   
     my $nt = $node->node_type;  
     if ($nt == 1) {  
       ## NOTE: |minuses| list is not checked since redundant  
       $self->{onerror}->(node => $node, type => 'element not allowed');  
       my ($sib, $ch) = $self->_check_get_children ($node, $todo);  
       unshift @nodes, @$sib;  
       push @$new_todos, @$ch;  
     } elsif ($nt == 5) {  
       unshift @nodes, @{$node->child_nodes};  
     }  
   }  
   return ($new_todos);  
 };  
   
 ## Zero or more |html:style| elements,  
 ## followed by zero or more block-level elements  
 my $HTMLStylableBlockChecker = sub {  
   my ($self, $todo) = @_;  
   my $el = $todo->{node};  
   my $new_todos = [];  
   my @nodes = (@{$el->child_nodes});  
     
   my $has_non_style;  
   while (@nodes) {  
     my $node = shift @nodes;  
     $self->_remove_minuses ($node) and next if ref $node eq 'HASH';  
   
     my $nt = $node->node_type;  
     if ($nt == 1) {  
       my $node_ns = $node->namespace_uri;  
       $node_ns = '' unless defined $node_ns;  
       my $node_ln = $node->manakai_local_name;  
       my $not_allowed = $self->{minuses}->{$node_ns}->{$node_ln};  
       if ($node_ns eq $HTML_NS and $node_ln eq 'style') {  
         $not_allowed = 1 if $has_non_style or  
             not $node->has_attribute_ns (undef, 'scoped');  
       } elsif ($HTMLBlockLevelElements->{$node_ns}->{$node_ln}) {  
         $has_non_style = 1;  
       } else {  
         $has_non_style = 1;  
         $not_allowed = 1;  
       }  
       $self->{onerror}->(node => $node, type => 'element not allowed')  
         if $not_allowed;  
       my ($sib, $ch) = $self->_check_get_children ($node, $todo);  
       unshift @nodes, @$sib;  
       push @$new_todos, @$ch;  
     } elsif ($nt == 3 or $nt == 4) {  
       if ($node->data =~ /[^\x09-\x0D\x20]/) {  
         $self->{onerror}->(node => $node, type => 'character not allowed');  
       }  
     } elsif ($nt == 5) {  
       unshift @nodes, @{$node->child_nodes};  
     }  
   }  
   return ($new_todos);  
 }; # $HTMLStylableBlockChecker  
   
 ## Zero or more block-level elements  
 my $HTMLBlockChecker = sub {  
   my ($self, $todo) = @_;  
   my $el = $todo->{node};  
   my $new_todos = [];  
   my @nodes = (@{$el->child_nodes});  
     
   while (@nodes) {  
     my $node = shift @nodes;  
     $self->_remove_minuses ($node) and next if ref $node eq 'HASH';  
   
     my $nt = $node->node_type;  
     if ($nt == 1) {  
       my $node_ns = $node->namespace_uri;  
       $node_ns = '' unless defined $node_ns;  
       my $node_ln = $node->manakai_local_name;  
       my $not_allowed = $self->{minuses}->{$node_ns}->{$node_ln};  
       $not_allowed = 1  
         unless $HTMLBlockLevelElements->{$node_ns}->{$node_ln};  
       $self->{onerror}->(node => $node, type => 'element not allowed')  
         if $not_allowed;  
       my ($sib, $ch) = $self->_check_get_children ($node, $todo);  
       unshift @nodes, @$sib;  
       push @$new_todos, @$ch;  
     } elsif ($nt == 3 or $nt == 4) {  
       if ($node->data =~ /[^\x09-\x0D\x20]/) {  
         $self->{onerror}->(node => $node, type => 'character not allowed');  
       }  
     } elsif ($nt == 5) {  
       unshift @nodes, @{$node->child_nodes};  
     }  
   }  
   return ($new_todos);  
 }; # $HTMLBlockChecker  
   
 ## Inline-level content  
 my $HTMLInlineChecker = sub {  
   my ($self, $todo) = @_;  
   my $el = $todo->{node};  
   my $new_todos = [];  
   my @nodes = (@{$el->child_nodes});  
     
   while (@nodes) {  
     my $node = shift @nodes;  
     $self->_remove_minuses ($node) and next if ref $node eq 'HASH';  
   
     my $nt = $node->node_type;  
     if ($nt == 1) {  
       my $node_ns = $node->namespace_uri;  
       $node_ns = '' unless defined $node_ns;  
       my $node_ln = $node->manakai_local_name;  
       my $not_allowed = $self->{minuses}->{$node_ns}->{$node_ln};  
       $not_allowed = 1  
         unless $HTMLStrictlyInlineLevelElements->{$node_ns}->{$node_ln} or  
           $HTMLStructuredInlineLevelElements->{$node_ns}->{$node_ln};  
       $self->{onerror}->(node => $node, type => 'element not allowed')  
         if $not_allowed;  
       my ($sib, $ch) = $self->_check_get_children ($node, $todo);  
       unshift @nodes, @$sib;  
       push @$new_todos, @$ch;  
     } elsif ($nt == 5) {  
       unshift @nodes, @{$node->child_nodes};  
     }  
   }  
   
   for (@$new_todos) {  
     $_->{inline} = 1;  
   }  
   return ($new_todos);  
 }; # $HTMLInlineChecker  
   
 my $HTMLSignificantInlineChecker = $HTMLInlineChecker;  
 ## TODO: check significant content  
   
 ## Strictly inline-level content  
 my $HTMLStrictlyInlineChecker = sub {  
   my ($self, $todo) = @_;  
   my $el = $todo->{node};  
   my $new_todos = [];  
   my @nodes = (@{$el->child_nodes});  
     
   while (@nodes) {  
     my $node = shift @nodes;  
     $self->_remove_minuses ($node) and next if ref $node eq 'HASH';  
   
     my $nt = $node->node_type;  
     if ($nt == 1) {  
       my $node_ns = $node->namespace_uri;  
       $node_ns = '' unless defined $node_ns;  
       my $node_ln = $node->manakai_local_name;  
       my $not_allowed = $self->{minuses}->{$node_ns}->{$node_ln};  
       $not_allowed = 1  
         unless $HTMLStrictlyInlineLevelElements->{$node_ns}->{$node_ln};  
       $self->{onerror}->(node => $node, type => 'element not allowed')  
         if $not_allowed;  
       my ($sib, $ch) = $self->_check_get_children ($node, $todo);  
       unshift @nodes, @$sib;  
       push @$new_todos, @$ch;  
     } elsif ($nt == 5) {  
       unshift @nodes, @{$node->child_nodes};  
     }  
   }  
   
   for (@$new_todos) {  
     $_->{inline} = 1;  
     $_->{strictly_inline} = 1;  
   }  
   return ($new_todos);  
 }; # $HTMLStrictlyInlineChecker  
   
 my $HTMLSignificantStrictlyInlineChecker = $HTMLStrictlyInlineChecker;  
 ## TODO: check significant content  
   
 ## Inline-level or strictly inline-kevek content  
 my $HTMLInlineOrStrictlyInlineChecker = sub {  
   my ($self, $todo) = @_;  
   my $el = $todo->{node};  
   my $new_todos = [];  
   my @nodes = (@{$el->child_nodes});  
     
   while (@nodes) {  
     my $node = shift @nodes;  
     $self->_remove_minuses ($node) and next if ref $node eq 'HASH';  
   
     my $nt = $node->node_type;  
     if ($nt == 1) {  
       my $node_ns = $node->namespace_uri;  
       $node_ns = '' unless defined $node_ns;  
       my $node_ln = $node->manakai_local_name;  
       my $not_allowed = $self->{minuses}->{$node_ns}->{$node_ln};  
       if ($todo->{strictly_inline}) {  
         $not_allowed = 1  
           unless $HTMLStrictlyInlineLevelElements->{$node_ns}->{$node_ln};  
       } else {  
         $not_allowed = 1  
           unless $HTMLStrictlyInlineLevelElements->{$node_ns}->{$node_ln} or  
             $HTMLStructuredInlineLevelElements->{$node_ns}->{$node_ln};  
       }  
       $self->{onerror}->(node => $node, type => 'element not allowed')  
         if $not_allowed;  
       my ($sib, $ch) = $self->_check_get_children ($node, $todo);  
       unshift @nodes, @$sib;  
       push @$new_todos, @$ch;  
     } elsif ($nt == 5) {  
       unshift @nodes, @{$node->child_nodes};  
     }  
   }  
   
   for (@$new_todos) {  
     $_->{inline} = 1;  
     $_->{strictly_inline} = 1;  
   }  
   return ($new_todos);  
 }; # $HTMLInlineOrStrictlyInlineChecker  
   
 my $HTMLSignificantInlineOrStrictlyInlineChecker  
     = $HTMLInlineOrStrictlyInlineChecker;  
 ## TODO: check significant content  
   
 my $HTMLBlockOrInlineChecker = sub {  
   my ($self, $todo) = @_;  
   my $el = $todo->{node};  
   my $new_todos = [];  
   my @nodes = (@{$el->child_nodes});  
     
   my $content = 'block-or-inline'; # or 'block' or 'inline'  
   my @block_not_inline;  
   while (@nodes) {  
     my $node = shift @nodes;  
     $self->_remove_minuses ($node) and next if ref $node eq 'HASH';  
   
     my $nt = $node->node_type;  
     if ($nt == 1) {  
       my $node_ns = $node->namespace_uri;  
       $node_ns = '' unless defined $node_ns;  
       my $node_ln = $node->manakai_local_name;  
       my $not_allowed = $self->{minuses}->{$node_ns}->{$node_ln};  
       if ($content eq 'block') {  
         $not_allowed = 1  
           unless $HTMLBlockLevelElements->{$node_ns}->{$node_ln};  
       } elsif ($content eq 'inline') {  
         $not_allowed = 1  
           unless $HTMLStrictlyInlineLevelElements->{$node_ns}->{$node_ln} or  
             $HTMLStructuredInlineLevelElements->{$node_ns}->{$node_ln};  
       } else {  
         my $is_block = $HTMLBlockLevelElements->{$node_ns}->{$node_ln};  
         my $is_inline  
           = $HTMLStrictlyInlineLevelElements->{$node_ns}->{$node_ln} ||  
             $HTMLStructuredInlineLevelElements->{$node_ns}->{$node_ln};  
           
         push @block_not_inline, $node  
           if $is_block and not $is_inline and not $not_allowed;  
         unless ($is_block) {  
           $content = 'inline';  
           for (@block_not_inline) {  
             $self->{onerror}->(node => $_, type => 'element not allowed');  
           }  
           $not_allowed = 1 unless $is_inline;  
         }  
       }  
       $self->{onerror}->(node => $node, type => 'element not allowed')  
         if $not_allowed;  
       my ($sib, $ch) = $self->_check_get_children ($node, $todo);  
       unshift @nodes, @$sib;  
       push @$new_todos, @$ch;  
     } elsif ($nt == 3 or $nt == 4) {  
       if ($node->data =~ /[^\x09-\x0D\x20]/) {  
         if ($content eq 'block') {  
           $self->{onerror}->(node => $node, type => 'character not allowed');  
         } else {  
           $content = 'inline';  
           for (@block_not_inline) {  
             $self->{onerror}->(node => $_, type => 'element not allowed');  
           }  
         }  
       }  
     } elsif ($nt == 5) {  
       unshift @nodes, @{$node->child_nodes};  
     }  
   }  
   
   if ($content eq 'inline') {  
     for (@$new_todos) {  
       $_->{inline} = 1;  
     }  
   }  
   return ($new_todos);  
 };  
   
 ## Zero or more XXX element, then either block-level or inline-level  
 my $GetHTMLZeroOrMoreThenBlockOrInlineChecker = sub ($$) {  
   my ($elnsuri, $ellname) = @_;  
   return sub {  
     my ($self, $todo) = @_;  
     my $el = $todo->{node};  
     my $new_todos = [];  
     my @nodes = (@{$el->child_nodes});  
       
     my $has_non_style;  
     my $content = 'block-or-inline'; # or 'block' or 'inline'  
     my @block_not_inline;  
     while (@nodes) {  
       my $node = shift @nodes;  
       $self->_remove_minuses ($node) and next if ref $node eq 'HASH';  
   
       my $nt = $node->node_type;  
       if ($nt == 1) {  
         my $node_ns = $node->namespace_uri;  
         $node_ns = '' unless defined $node_ns;  
         my $node_ln = $node->manakai_local_name;  
         my $not_allowed = $self->{minuses}->{$node_ns}->{$node_ln};  
         if ($node_ns eq $elnsuri and $node_ln eq $ellname) {  
           $not_allowed = 1 if $has_non_style;  
           if ($ellname eq 'style' and  
               not $node->has_attribute_ns (undef, 'scoped')) {  
             $not_allowed = 1;  
           }  
         } elsif ($content eq 'block') {  
           $has_non_style = 1;  
           $not_allowed = 1  
             unless $HTMLBlockLevelElements->{$node_ns}->{$node_ln};  
         } elsif ($content eq 'inline') {  
           $has_non_style = 1;  
           $not_allowed = 1  
             unless $HTMLStrictlyInlineLevelElements->{$node_ns}->{$node_ln} or  
               $HTMLStructuredInlineLevelElements->{$node_ns}->{$node_ln};  
         } else {  
           $has_non_style = 1;  
           my $is_block = $HTMLBlockLevelElements->{$node_ns}->{$node_ln};  
           my $is_inline  
             = $HTMLStrictlyInlineLevelElements->{$node_ns}->{$node_ln} ||  
               $HTMLStructuredInlineLevelElements->{$node_ns}->{$node_ln};  
               
           push @block_not_inline, $node  
             if $is_block and not $is_inline and not $not_allowed;  
           unless ($is_block) {  
             $content = 'inline';  
             for (@block_not_inline) {  
               $self->{onerror}->(node => $_, type => 'element not allowed');  
             }  
             $not_allowed = 1 unless $is_inline;  
           }  
         }  
         $self->{onerror}->(node => $node, type => 'element not allowed')  
           if $not_allowed;  
         my ($sib, $ch) = $self->_check_get_children ($node, $todo);  
         unshift @nodes, @$sib;  
         push @$new_todos, @$ch;  
       } elsif ($nt == 3 or $nt == 4) {  
         if ($node->data =~ /[^\x09-\x0D\x20]/) {  
           $has_non_style = 1;  
           if ($content eq 'block') {  
             $self->{onerror}->(node => $node, type => 'character not allowed');  
           } else {  
             $content = 'inline';  
             for (@block_not_inline) {  
               $self->{onerror}->(node => $_, type => 'element not allowed');  
             }  
           }  
         }  
       } elsif ($nt == 5) {  
         unshift @nodes, @{$node->child_nodes};  
       }  
     }  
   
     if ($content eq 'inline') {  
       for (@$new_todos) {  
         $_->{inline} = 1;  
       }  
     }  
     return ($new_todos);  
   };  
 }; # $GetHTMLZeroOrMoreThenBlockOrInlineChecker  
   
 my $HTMLTransparentChecker = $HTMLBlockOrInlineChecker;  
   
 my $GetHTMLEnumeratedAttrChecker = sub {  
   my $states = shift; # {value => conforming ? 1 : -1}  
   return sub {  
     my ($self, $attr) = @_;  
     my $value = lc $attr->value; ## TODO: ASCII case insensitibility?  
     if ($states->{$value} > 0) {  
       #  
     } elsif ($states->{$value}) {  
       $self->{onerror}->(node => $attr, type => 'enumerated:non-conforming');  
     } else {  
       $self->{onerror}->(node => $attr, type => 'enumerated:invalid');  
     }  
   };  
 }; # $GetHTMLEnumeratedAttrChecker  
   
 my $GetHTMLBooleanAttrChecker = sub {  
   my $local_name = shift;  
   return sub {  
     my ($self, $attr) = @_;  
     my $value = $attr->value;  
     unless ($value eq $local_name or $value eq '') {  
       $self->{onerror}->(node => $attr, type => 'boolean:invalid');  
     }  
   };  
 }; # $GetHTMLBooleanAttrChecker  
   
 my $HTMLUnorderedSetOfSpaceSeparatedTokensAttrChecker = sub {  
   my ($self, $attr) = @_;  
   my %word;  
   for my $word (grep {length $_} split /[\x09-\x0D\x20]/, $attr->value) {  
     unless ($word{$word}) {  
       $word{$word} = 1;  
     } else {  
       $self->{onerror}->(node => $attr, type => 'duplicate token:'.$word);  
     }  
   }  
 }; # $HTMLUnorderedSetOfSpaceSeparatedTokensAttrChecker  
   
 ## |rel| attribute (unordered set of space separated tokens,  
 ## whose allowed values are defined by the section on link types)  
 my $HTMLLinkTypesAttrChecker = sub {  
   my ($a_or_area, $self, $attr) = @_;  
   my %word;  
   for my $word (grep {length $_} split /[\x09-\x0D\x20]/, $attr->value) {  
     unless ($word{$word}) {  
       $word{$word} = 1;  
     } else {  
       $self->{onerror}->(node => $attr, type => 'duplicate token:'.$word);  
     }  
   }  
   ## NOTE: Case sensitive match (since HTML5 spec does not say link  
   ## types are case-insensitive and it says "The value should not  
   ## be confusingly similar to any other defined value (e.g.  
   ## differing only in case).").  
   ## NOTE: Though there is no explicit "MUST NOT" for undefined values,  
   ## "MAY"s and "only ... MAY" restrict non-standard non-registered  
   ## values to be used conformingly.  
   require Whatpm::_LinkTypeList;  
   our $LinkType;  
   for my $word (keys %word) {  
     my $def = $LinkType->{$word};  
     if (defined $def) {  
       if ($def->{status} eq 'accepted') {  
         if (defined $def->{effect}->[$a_or_area]) {  
           #  
         } else {  
           $self->{onerror}->(node => $attr,  
                              type => 'link type:bad context:'.$word);  
         }  
       } elsif ($def->{status} eq 'proposal') {  
         $self->{onerror}->(node => $attr, level => 's',  
                            type => 'link type:proposed:'.$word);  
       } else { # rejected or synonym  
         $self->{onerror}->(node => $attr,  
                            type => 'link type:non-conforming:'.$word);  
       }  
       if ($def->{unique}) {  
         unless ($self->{has_link_type}->{$word}) {  
           $self->{has_link_type}->{$word} = 1;  
         } else {  
           $self->{onerror}->(node => $attr,  
                              type => 'link type:duplicate:'.$word);  
         }  
       }  
     } else {  
       $self->{onerror}->(node => $attr, level => 'unsupported',  
                          type => 'link type:'.$word);  
     }  
   }  
   ## TODO: The Pingback 1.0 specification, which is referenced by HTML5,  
   ## says that using both X-Pingback: header field and HTML  
   ## <link rel=pingback> is deprecated and if both appears they  
   ## SHOULD contain exactly the same value.  
   ## ISSUE: Pingback 1.0 specification defines the exact representation  
   ## of its link element, which cannot be tested by the current arch.  
   ## ISSUE: Pingback 1.0 specification says that the document MUST NOT  
   ## include any string that matches to the pattern for the rel=pingback link,  
   ## which again inpossible to test.  
   ## ISSUE: rel=pingback href MUST NOT include entities other than predefined 4.  
 }; # $HTMLLinkTypesAttrChecker  
   
 ## URI (or IRI)  
 my $HTMLURIAttrChecker = sub {  
   my ($self, $attr) = @_;  
   ## ISSUE: Relative references are allowed? (RFC 3987 "IRI" is an absolute reference with optional fragment identifier.)  
   my $value = $attr->value;  
   Whatpm::URIChecker->check_iri_reference ($value, sub {  
     my %opt = @_;  
     $self->{onerror}->(node => $attr, level => $opt{level},  
                        type => 'URI::'.$opt{type}.  
                        (defined $opt{position} ? ':'.$opt{position} : ''));  
   });  
 }; # $HTMLURIAttrChecker  
   
 ## A space separated list of one or more URIs (or IRIs)  
 my $HTMLSpaceURIsAttrChecker = sub {  
   my ($self, $attr) = @_;  
   my $i = 0;  
   for my $value (split /[\x09-\x0D\x20]+/, $attr->value) {  
     Whatpm::URIChecker->check_iri_reference ($value, sub {  
       my %opt = @_;  
       $self->{onerror}->(node => $attr, level => $opt{level},  
                          type => 'URIs:'.$i.'::'.  
                          $opt{type}.  
                          (defined $opt{position} ? ':'.$opt{position} : ''));  
     });  
     $i++;  
   }  
   ## ISSUE: Relative references?  
   ## ISSUE: Leading or trailing white spaces are conformant?  
   ## ISSUE: A sequence of white space characters are conformant?  
   ## ISSUE: A zero-length string is conformant? (It does contain a relative reference, i.e. same as base URI.)  
   ## NOTE: Duplication seems not an error.  
 }; # $HTMLSpaceURIsAttrChecker  
   
 my $HTMLDatetimeAttrChecker = sub {  
   my ($self, $attr) = @_;  
   my $value = $attr->value;  
   ## ISSUE: "space", not "space character" (in parsing algorihtm, "space character")  
   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/) {  
     my ($y, $M, $d, $h, $m, $s, $f, $zh, $zm)  
         = ($1, $2, $3, $4, $5, $6, $7, $8, $9);  
     if (0 < $M and $M < 13) { ## ISSUE: This is not explicitly specified (though in parsing algorithm)  
       $self->{onerror}->(node => $attr, type => 'datetime:bad day')  
           if $d < 1 or  
               $d > [0, 31, 29, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31]->[$M];  
       $self->{onerror}->(node => $attr, type => 'datetime:bad day')  
           if $M == 2 and $d == 29 and  
               not ($y % 400 == 0 or ($y % 4 == 0 and $y % 100 != 0));  
     } else {  
       $self->{onerror}->(node => $attr, type => 'datetime:bad month');  
     }  
     $self->{onerror}->(node => $attr, type => 'datetime:bad hour') if $h > 23;  
     $self->{onerror}->(node => $attr, type => 'datetime:bad minute') if $m > 59;  
     $self->{onerror}->(node => $attr, type => 'datetime:bad second')  
         if defined $s and $s > 59;  
     $self->{onerror}->(node => $attr, type => 'datetime:bad timezone hour')  
         if $zh > 23;  
     $self->{onerror}->(node => $attr, type => 'datetime:bad timezone minute')  
         if $zm > 59;  
     ## ISSUE: Maybe timezone -00:00 should have same semantics as in RFC 3339.  
   } else {  
     $self->{onerror}->(node => $attr, type => 'datetime:syntax error');  
   }  
 }; # $HTMLDatetimeAttrChecker  
   
 my $HTMLIntegerAttrChecker = sub {  
   my ($self, $attr) = @_;  
   my $value = $attr->value;  
   unless ($value =~ /\A-?[0-9]+\z/) {  
     $self->{onerror}->(node => $attr, type => 'integer:syntax error');  
   }  
 }; # $HTMLIntegerAttrChecker  
   
 my $GetHTMLNonNegativeIntegerAttrChecker = sub {  
   my $range_check = shift;  
   return sub {  
     my ($self, $attr) = @_;  
     my $value = $attr->value;  
     if ($value =~ /\A[0-9]+\z/) {  
       unless ($range_check->($value + 0)) {  
         $self->{onerror}->(node => $attr, type => 'nninteger:out of range');  
       }  
     } else {  
       $self->{onerror}->(node => $attr,  
                          type => 'nninteger:syntax error');  
     }  
   };  
 }; # $GetHTMLNonNegativeIntegerAttrChecker  
   
 my $GetHTMLFloatingPointNumberAttrChecker = sub {  
   my $range_check = shift;  
   return sub {  
     my ($self, $attr) = @_;  
     my $value = $attr->value;  
     if ($value =~ /\A-?[0-9.]+\z/ and $value =~ /[0-9]/) {  
       unless ($range_check->($value + 0)) {  
         $self->{onerror}->(node => $attr, type => 'float:out of range');  
       }  
     } else {  
       $self->{onerror}->(node => $attr,  
                          type => 'float:syntax error');  
     }  
   };  
 }; # $GetHTMLFloatingPointNumberAttrChecker  
   
 ## "A valid MIME type, optionally with parameters. [RFC 2046]"  
 ## ISSUE: RFC 2046 does not define syntax of media types.  
 ## ISSUE: The definition of "a valid MIME type" is unknown.  
 ## Syntactical correctness?  
 my $HTMLIMTAttrChecker = sub {  
   my ($self, $attr) = @_;  
   my $value = $attr->value;  
   ## ISSUE: RFC 2045 Content-Type header field allows insertion  
   ## of LWS/comments between tokens.  Is it allowed in HTML?  Maybe no.  
   ## ISSUE: RFC 2231 extension?  Maybe no.  
   my $lws0 = qr/(?>(?>\x0D\x0A)?[\x09\x20])*/;  
   my $token = qr/[\x21\x23-\x27\x2A\x2B\x2D\x2E\x30-\x39\x41-\x5A\x5E-\x7E]+/;  
   my $qs = qr/"(?>[\x00-\x0C\x0E-\x21\x23-\x5B\x5D-\x7E]|\x0D\x0A[\x09\x20]|\x5C[\x00-\x7F])*"/;  
   if ($value =~ m#\A$lws0($token)$lws0/$lws0($token)$lws0((?>;$lws0$token$lws0=$lws0(?>$token|$qs)$lws0)*)\z#) {  
     my @type = ($1, $2);  
     my $param = $3;  
     while ($param =~ s/^;$lws0($token)$lws0=$lws0(?>($token)|($qs))$lws0//) {  
       if (defined $2) {  
         push @type, $1 => $2;  
       } else {  
         my $n = $1;  
         my $v = $2;  
         $v =~ s/\\(.)/$1/gs;  
         push @type, $n => $v;  
       }  
     }  
     require Whatpm::IMTChecker;  
     Whatpm::IMTChecker->check_imt (sub {  
       my %opt = @_;  
       $self->{onerror}->(node => $attr, level => $opt{level},  
                          type => 'IMT:'.$opt{type});  
     }, @type);  
   } else {  
     $self->{onerror}->(node => $attr, type => 'IMT:syntax error');  
   }  
 }; # $HTMLIMTAttrChecker  
   
 my $HTMLLanguageTagAttrChecker = sub {  
   my ($self, $attr) = @_;  
   $self->{onerror}->(node => $attr, level => 'unsupported',  
                      type => 'language tag');  
   if ($attr->value eq '') {  
     $self->{onerror}->(node => $attr, type => 'language tag:syntax error');  
   }  
   ## TODO: RFC 3066 test  
   ## ISSUE: RFC 4646 (3066bis)?  
 }; # $HTMLLanguageTagAttrChecker  
   
 ## "A valid media query [MQ]"  
 my $HTMLMQAttrChecker = sub {  
   my ($self, $attr) = @_;  
   $self->{onerror}->(node => $attr, level => 'unsupported',  
                      type => 'media query');  
   ## ISSUE: What is "a valid media query"?  
 }; # $HTMLMQAttrChecker  
   
 my $HTMLEventHandlerAttrChecker = sub {  
   my ($self, $attr) = @_;  
   $self->{onerror}->(node => $attr, level => 'unsupported',  
                      type => 'event handler');  
   ## TODO: MUST contain valid ECMAScript code matching the  
   ## ECMAScript |FunctionBody| production. [ECMA262]  
   ## ISSUE: MUST be ES3? E4X? ES4? JS1.x?  
   ## ISSUE: Automatic semicolon insertion does not apply?  
   ## ISSUE: Other script languages?  
 }; # $HTMLEventHandlerAttrChecker  
   
 my $HTMLUsemapAttrChecker = sub {  
   my ($self, $attr) = @_;  
   ## MUST be a valid hashed ID reference to a |map| element  
   my $value = $attr->value;  
   if ($value =~ s/^#//) {  
     ## ISSUE: Is |usemap="#"| conformant? (c.f. |id=""| is non-conformant.)  
     push @{$self->{usemap}}, [$value => $attr];  
   } else {  
     $self->{onerror}->(node => $attr, type => '#idref:syntax error');  
   }  
   ## NOTE: Space characters in hashed ID references are conforming.  
   ## ISSUE: UA algorithm for matching is case-insensitive; IDs only different in cases should be reported  
 }; # $HTMLUsemapAttrChecker  
   
 my $HTMLTargetAttrChecker = sub {  
   my ($self, $attr) = @_;  
   my $value = $attr->value;  
   if ($value =~ /^_/) {  
     $value = lc $value; ## ISSUE: ASCII case-insentitive?  
     unless ({  
              _self => 1, _parent => 1, _top => 1,  
             }->{$value}) {  
       $self->{onerror}->(node => $attr,  
                          type => 'reserved browsing context name');  
     }  
   } else {  
     #$ ISSUE: An empty string is conforming?  
   }  
 }; # $HTMLTargetAttrChecker  
206    
207  my $HTMLAttrChecker = {  for (qw/space lang base id/) {
208    id => sub {    $AttrStatus->{$XML_NS}->{$_} = FEATURE_STATUS_REC | FEATURE_ALLOWED;
209      ## NOTE: |map| has its own variant of |id=""| checker    $AttrStatus->{''}->{"xml:$_"} = FEATURE_STATUS_REC | FEATURE_ALLOWED;
210      my ($self, $attr) = @_;    ## XML 1.0: FEATURE_STATUS_CR
211      my $value = $attr->value;    ## XML 1.1: FEATURE_STATUS_REC
212      if (length $value > 0) {    ## XML Namespaces 1.0: FEATURE_STATUS_CR
213        if ($self->{id}->{$value}) {    ## XML Namespaces 1.1: FEATURE_STATUS_REC
214          $self->{onerror}->(node => $attr, type => 'duplicate ID');    ## XML Base: FEATURE_STATUS_REC
215        } else {    ## xml:id: FEATURE_STATUS_REC
         $self->{id}->{$value} = 1;  
       }  
       if ($value =~ /[\x09-\x0D\x20]/) {  
         $self->{onerror}->(node => $attr, type => 'space in ID');  
       }  
     } else {  
       ## NOTE: MUST contain at least one character  
       $self->{onerror}->(node => $attr, type => 'empty attribute value');  
     }  
   },  
   title => sub {}, ## NOTE: No conformance creteria  
   lang => sub {  
     my ($self, $attr) = @_;  
     $self->{onerror}->(node => $attr, level => 'unsupported',  
                        type => 'language tag');  
     ## TODO: RFC 3066 or empty test  
     ## ISSUE: RFC 4646 (3066bis)?  
     unless ($attr->owner_document->manakai_is_html) {  
       $self->{onerror}->(node => $attr, type => 'in XML:lang');  
     }  
   },  
   dir => $GetHTMLEnumeratedAttrChecker->({ltr => 1, rtl => 1}),  
   class => $HTMLUnorderedSetOfSpaceSeparatedTokensAttrChecker,  
   contextmenu => sub {  
     my ($self, $attr) = @_;  
     my $value = $attr->value;  
     push @{$self->{contextmenu}}, [$value => $attr];  
     ## ISSUE: "The value must be the ID of a menu element in the DOM."  
     ## What is "in the DOM"?  A menu Element node that is not part  
     ## of the Document tree is in the DOM?  A menu Element node that  
     ## belong to another Document tree is in the DOM?  
   },  
   irrelevant => $GetHTMLBooleanAttrChecker->('irrelevant'),  
   tabindex => $HTMLIntegerAttrChecker,  
 };  
   
 for (qw/  
          onabort onbeforeunload onblur onchange onclick oncontextmenu  
          ondblclick ondrag ondragend ondragenter ondragleave ondragover  
          ondragstart ondrop onerror onfocus onkeydown onkeypress  
          onkeyup onload onmessage onmousedown onmousemove onmouseout  
          onmouseover onmouseup onmousewheel onresize onscroll onselect  
          onsubmit onunload  
      /) {  
   $HTMLAttrChecker->{$_} = $HTMLEventHandlerAttrChecker;  
216  }  }
217    
218  my $GetHTMLAttrsChecker = sub {  $AttrStatus->{$XMLNS_NS}->{''} = FEATURE_STATUS_REC | FEATURE_ALLOWED;
   my $element_specific_checker = shift;  
   return sub {  
     my ($self, $todo) = @_;  
     for my $attr (@{$todo->{node}->attributes}) {  
       my $attr_ns = $attr->namespace_uri;  
       $attr_ns = '' unless defined $attr_ns;  
       my $attr_ln = $attr->manakai_local_name;  
       my $checker;  
       if ($attr_ns eq '') {  
         $checker = $element_specific_checker->{$attr_ln}  
           || $HTMLAttrChecker->{$attr_ln};  
       }  
       $checker ||= $AttrChecker->{$attr_ns}->{$attr_ln}  
         || $AttrChecker->{$attr_ns}->{''};  
       if ($checker) {  
         $checker->($self, $attr, $todo);  
       } else {  
         $self->{onerror}->(node => $attr, level => 'unsupported',  
                            type => 'attribute');  
         ## ISSUE: No comformance createria for unknown attributes in the spec  
       }  
     }  
   };  
 }; # $GetHTMLAttrsChecker  
219    
220  $Element->{$HTML_NS}->{''} = {  ## TODO: xsi:schemaLocation for XHTML2 support (very, very low priority)
   attrs_checker => $GetHTMLAttrsChecker->({}),  
   checker => $ElementDefault->{checker},  
 };  
221    
222  $Element->{$HTML_NS}->{html} = {  our %AnyChecker = (
223    is_root => 1,    check_start => sub { },
224    attrs_checker => $GetHTMLAttrsChecker->({    check_attrs => sub {
225      xmlns => sub {      my ($self, $item, $element_state) = @_;
226        my ($self, $attr) = @_;      for my $attr (@{$item->{node}->attributes}) {
       my $value = $attr->value;  
       unless ($value eq $HTML_NS) {  
         $self->{onerror}->(node => $attr, type => 'invalid attribute value');  
       }  
       unless ($attr->owner_document->manakai_is_html) {  
         $self->{onerror}->(node => $attr, type => 'in XML:xmlns');  
   ## TODO: Test  
       }  
     },  
   }),  
   checker => sub {  
     my ($self, $todo) = @_;  
     my $el = $todo->{node};  
     my $new_todos = [];  
     my @nodes = (@{$el->child_nodes});  
   
     my $phase = 'before head';  
     while (@nodes) {  
       my $node = shift @nodes;  
       $self->_remove_minuses ($node) and next if ref $node eq 'HASH';  
   
       my $nt = $node->node_type;  
       if ($nt == 1) {  
         my $node_ns = $node->namespace_uri;  
         $node_ns = '' unless defined $node_ns;  
         my $node_ln = $node->manakai_local_name;  
         my $not_allowed = $self->{minuses}->{$node_ns}->{$node_ln};  
         if ($phase eq 'before head') {  
           if ($node_ns eq $HTML_NS and $node_ln eq 'head') {  
             $phase = 'after head';              
           } elsif ($node_ns eq $HTML_NS and $node_ln eq 'body') {  
             $self->{onerror}->(node => $node, type => 'ps element missing:head');  
             $phase = 'after body';  
           } else {  
             $not_allowed = 1;  
             # before head  
           }  
         } elsif ($phase eq 'after head') {  
           if ($node_ns eq $HTML_NS and $node_ln eq 'body') {  
             $phase = 'after body';  
           } else {  
             $not_allowed = 1;  
             # after head  
           }  
         } else { #elsif ($phase eq 'after body') {  
           $not_allowed = 1;  
           # after body  
         }  
         $self->{onerror}->(node => $node, type => 'element not allowed')  
           if $not_allowed;  
         my ($sib, $ch) = $self->_check_get_children ($node, $todo);  
         unshift @nodes, @$sib;  
         push @$new_todos, @$ch;  
       } elsif ($nt == 3 or $nt == 4) {  
         if ($node->data =~ /[^\x09-\x0D\x20]/) {  
           $self->{onerror}->(node => $node, type => 'character not allowed');  
         }  
       } elsif ($nt == 5) {  
         unshift @nodes, @{$node->child_nodes};  
       }  
     }  
   
     if ($phase eq 'before head') {  
       $self->{onerror}->(node => $el, type => 'child element missing:head');  
       $self->{onerror}->(node => $el, type => 'child element missing:body');  
     } elsif ($phase eq 'after head') {  
       $self->{onerror}->(node => $el, type => 'child element missing:body');  
     }  
   
     return ($new_todos);  
   },  
 };  
   
 $Element->{$HTML_NS}->{head} = {  
   attrs_checker => $GetHTMLAttrsChecker->({}),  
   checker => sub {  
     my ($self, $todo) = @_;  
     my $el = $todo->{node};  
     my $new_todos = [];  
     my @nodes = (@{$el->child_nodes});  
   
     my $has_title;  
     my $phase = 'initial'; # 'after charset', 'after base'  
     while (@nodes) {  
       my $node = shift @nodes;  
       $self->_remove_minuses ($node) and next if ref $node eq 'HASH';  
   
       my $nt = $node->node_type;  
       if ($nt == 1) {  
         my $node_ns = $node->namespace_uri;  
         $node_ns = '' unless defined $node_ns;  
         my $node_ln = $node->manakai_local_name;  
         my $not_allowed = $self->{minuses}->{$node_ns}->{$node_ln};  
         if ($node_ns eq $HTML_NS and $node_ln eq 'title') {  
           $phase = 'after base';  
           unless ($has_title) {  
             $has_title = 1;  
           } else {  
             $not_allowed = 1;  
           }  
         } elsif ($node_ns eq $HTML_NS and $node_ln eq 'meta') {  
           if ($node->has_attribute_ns (undef, 'charset')) {  
             if ($phase eq 'initial') {  
               $phase = 'after charset';  
             } else {  
               $not_allowed = 1;  
               ## NOTE: See also |base|'s "contexts" field in the spec  
             }  
           } else {  
             $phase = 'after base';  
           }  
         } elsif ($node_ns eq $HTML_NS and $node_ln eq 'base') {  
           if ($phase eq 'initial' or $phase eq 'after charset') {  
             $phase = 'after base';  
           } else {  
             $not_allowed = 1;  
           }  
         } elsif ($node_ns eq $HTML_NS and $node_ln eq 'style') {  
           $phase = 'after base';  
           if ($node->has_attribute_ns (undef, 'scoped')) {  
             $not_allowed = 1;  
           }  
         } elsif ($HTMLMetadataElements->{$node_ns}->{$node_ln}) {  
           $phase = 'after base';  
         } else {  
           $not_allowed = 1;  
         }  
         $self->{onerror}->(node => $node, type => 'element not allowed')  
           if $not_allowed;  
         my ($sib, $ch) = $self->_check_get_children ($node, $todo);  
         unshift @nodes, @$sib;  
         push @$new_todos, @$ch;  
       } elsif ($nt == 3 or $nt == 4) {  
         if ($node->data =~ /[^\x09-\x0D\x20]/) {  
           $self->{onerror}->(node => $node, type => 'character not allowed');  
         }  
       } elsif ($nt == 5) {  
         unshift @nodes, @{$node->child_nodes};  
       }  
     }  
     unless ($has_title) {  
       $self->{onerror}->(node => $el, type => 'child element missing:title');  
     }  
     return ($new_todos);  
   },  
 };  
   
 $Element->{$HTML_NS}->{title} = {  
   attrs_checker => $GetHTMLAttrsChecker->({}),  
   checker => $HTMLTextChecker,  
 };  
   
 $Element->{$HTML_NS}->{base} = {  
   attrs_checker => $GetHTMLAttrsChecker->({  
     href => $HTMLURIAttrChecker,  
     target => $HTMLTargetAttrChecker,  
   }),  
   checker => $HTMLEmptyChecker,  
 };  
   
 $Element->{$HTML_NS}->{link} = {  
   attrs_checker => sub {  
     my ($self, $todo) = @_;  
     $GetHTMLAttrsChecker->({  
       href => $HTMLURIAttrChecker,  
       rel => sub { $HTMLLinkTypesAttrChecker->(0, @_) },  
       media => $HTMLMQAttrChecker,  
       hreflang => $HTMLLanguageTagAttrChecker,  
       type => $HTMLIMTAttrChecker,  
       ## NOTE: Though |title| has special semantics,  
       ## syntactically same as the |title| as global attribute.  
     })->($self, $todo);  
     unless ($todo->{node}->has_attribute_ns (undef, 'href')) {  
       $self->{onerror}->(node => $todo->{node},  
                          type => 'attribute missing:href');  
     }  
     unless ($todo->{node}->has_attribute_ns (undef, 'rel')) {  
       $self->{onerror}->(node => $todo->{node},  
                          type => 'attribute missing:rel');  
     }  
   },  
   checker => $HTMLEmptyChecker,  
 };  
   
 $Element->{$HTML_NS}->{meta} = {  
   attrs_checker => sub {  
     my ($self, $todo) = @_;  
     my $name_attr;  
     my $http_equiv_attr;  
     my $charset_attr;  
     my $content_attr;  
     for my $attr (@{$todo->{node}->attributes}) {  
227        my $attr_ns = $attr->namespace_uri;        my $attr_ns = $attr->namespace_uri;
228        $attr_ns = '' unless defined $attr_ns;        if (defined $attr_ns) {
229        my $attr_ln = $attr->manakai_local_name;          load_ns_module ($attr_ns);
       my $checker;  
       if ($attr_ns eq '') {  
         if ($attr_ln eq 'content') {  
           $content_attr = $attr;  
           $checker = 1;  
         } elsif ($attr_ln eq 'name') {  
           $name_attr = $attr;  
           $checker = 1;  
         } elsif ($attr_ln eq 'http-equiv') {  
           $http_equiv_attr = $attr;  
           $checker = 1;  
         } elsif ($attr_ln eq 'charset') {  
           $charset_attr = $attr;  
           $checker = 1;  
         } else {  
           $checker = $HTMLAttrChecker->{$attr_ln}  
             || $AttrChecker->{$attr_ns}->{$attr_ln}  
               || $AttrChecker->{$attr_ns}->{''};  
         }  
       } else {  
         $checker ||= $AttrChecker->{$attr_ns}->{$attr_ln}  
           || $AttrChecker->{$attr_ns}->{''};  
       }  
       if ($checker) {  
         $checker->($self, $attr) if ref $checker;  
       } else {  
         $self->{onerror}->(node => $attr, level => 'unsupported',  
                            type => 'attribute');  
         ## ISSUE: No comformance createria for unknown attributes in the spec  
       }  
     }  
       
     if (defined $name_attr) {  
       if (defined $http_equiv_attr) {  
         $self->{onerror}->(node => $http_equiv_attr,  
                            type => 'attribute not allowed');  
       } elsif (defined $charset_attr) {  
         $self->{onerror}->(node => $charset_attr,  
                            type => 'attribute not allowed');  
       }  
       my $metadata_name = $name_attr->value;  
       my $metadata_value;  
       if (defined $content_attr) {  
         $metadata_value = $content_attr->value;  
       } else {  
         $self->{onerror}->(node => $todo->{node},  
                            type => 'attribute missing:content');  
         $metadata_value = '';  
       }  
     } elsif (defined $http_equiv_attr) {  
       if (defined $charset_attr) {  
         $self->{onerror}->(node => $charset_attr,  
                            type => 'attribute not allowed');  
       }  
       unless (defined $content_attr) {  
         $self->{onerror}->(node => $todo->{node},  
                            type => 'attribute missing:content');  
       }  
     } elsif (defined $charset_attr) {  
       if (defined $content_attr) {  
         $self->{onerror}->(node => $content_attr,  
                            type => 'attribute not allowed');  
       }  
     } else {  
       if (defined $content_attr) {  
         $self->{onerror}->(node => $content_attr,  
                            type => 'attribute not allowed');  
         $self->{onerror}->(node => $todo->{node},  
                            type => 'attribute missing:name|http-equiv');  
       } else {  
         $self->{onerror}->(node => $todo->{node},  
                            type => 'attribute missing:name|http-equiv|charset');  
       }  
     }  
   
     ## TODO: metadata conformance  
   
     ## TODO: pragma conformance  
     if (defined $http_equiv_attr) { ## An enumerated attribute  
       my $keyword = lc $http_equiv_attr->value; ## TODO: ascii case?  
       if ({  
            'refresh' => 1,  
            'default-style' => 1,  
           }->{$keyword}) {  
         #  
230        } else {        } else {
231          $self->{onerror}->(node => $http_equiv_attr,          $attr_ns = '';
                            type => 'enumerated:invalid');  
       }  
     }  
   
     if (defined $charset_attr) {  
       unless ($todo->{node}->owner_document->manakai_is_html) {  
         $self->{onerror}->(node => $charset_attr,  
                            type => 'in XML:charset');  
       }  
       ## TODO: charset  
     }  
   },  
   checker => $HTMLEmptyChecker,  
 };  
   
 $Element->{$HTML_NS}->{style} = {  
   attrs_checker => $GetHTMLAttrsChecker->({  
     type => $HTMLIMTAttrChecker, ## TODO: MUST be a styling language  
     media => $HTMLMQAttrChecker,  
     scoped => $GetHTMLBooleanAttrChecker->('scoped'),  
     ## NOTE: |title| has special semantics for |style|s, but is syntactically  
     ## not different  
   }),  
   checker => sub {  
     ## NOTE: |html:style| has no conformance creteria on content model  
     my ($self, $todo) = @_;  
     my $type = $todo->{node}->get_attribute_ns (undef, 'type');  
     $type = 'text/css' unless defined $type;  
     $self->{onerror}->(node => $todo->{node}, level => 'unsupported',  
                        type => 'style:'.$type); ## TODO: $type normalization  
     return $AnyChecker->($self, $todo);  
   },  
 };  
   
 $Element->{$HTML_NS}->{body} = {  
   attrs_checker => $GetHTMLAttrsChecker->({}),  
   checker => $HTMLBlockChecker,  
 };  
   
 $Element->{$HTML_NS}->{section} = {  
   attrs_checker => $GetHTMLAttrsChecker->({}),  
   checker => $HTMLStylableBlockChecker,  
 };  
   
 $Element->{$HTML_NS}->{nav} = {  
   attrs_checker => $GetHTMLAttrsChecker->({}),  
   checker => $HTMLBlockOrInlineChecker,  
 };  
   
 $Element->{$HTML_NS}->{article} = {  
   attrs_checker => $GetHTMLAttrsChecker->({}),  
   checker => $HTMLStylableBlockChecker,  
 };  
   
 $Element->{$HTML_NS}->{blockquote} = {  
   attrs_checker => $GetHTMLAttrsChecker->({  
     cite => $HTMLURIAttrChecker,  
   }),  
   checker => $HTMLBlockChecker,  
 };  
   
 $Element->{$HTML_NS}->{aside} = {  
   attrs_checker => $GetHTMLAttrsChecker->({}),  
   checker => $GetHTMLZeroOrMoreThenBlockOrInlineChecker->($HTML_NS, 'style'),  
 };  
   
 $Element->{$HTML_NS}->{h1} = {  
   attrs_checker => $GetHTMLAttrsChecker->({}),  
   checker => sub {  
     my ($self, $todo) = @_;  
     $todo->{flag}->{has_heading}->[0] = 1;  
     return $HTMLSignificantStrictlyInlineChecker->($self, $todo);  
   },  
 };  
   
 $Element->{$HTML_NS}->{h2} = {  
   attrs_checker => $GetHTMLAttrsChecker->({}),  
   checker => $Element->{$HTML_NS}->{h1}->{checker},  
 };  
   
 $Element->{$HTML_NS}->{h3} = {  
   attrs_checker => $GetHTMLAttrsChecker->({}),  
   checker => $Element->{$HTML_NS}->{h1}->{checker},  
 };  
   
 $Element->{$HTML_NS}->{h4} = {  
   attrs_checker => $GetHTMLAttrsChecker->({}),  
   checker => $Element->{$HTML_NS}->{h1}->{checker},  
 };  
   
 $Element->{$HTML_NS}->{h5} = {  
   attrs_checker => $GetHTMLAttrsChecker->({}),  
   checker => $Element->{$HTML_NS}->{h1}->{checker},  
 };  
   
 $Element->{$HTML_NS}->{h6} = {  
   attrs_checker => $GetHTMLAttrsChecker->({}),  
   checker => $Element->{$HTML_NS}->{h1}->{checker},  
 };  
   
 $Element->{$HTML_NS}->{header} = {  
   attrs_checker => $GetHTMLAttrsChecker->({}),  
   checker => sub {  
     my ($self, $todo) = @_;  
     my $old_flag = $todo->{flag}->{has_heading} || [];  
     my $new_flag = [];  
     local $todo->{flag}->{has_heading} = $new_flag;  
     my $node = $todo->{node};  
   
     my $end = $self->_add_minuses  
         ({$HTML_NS => {qw/header 1 footer 1/}},  
          $HTMLSectioningElements);  
     my ($new_todos, $ch) = $HTMLBlockChecker->($self, $todo);  
     push @$new_todos, $end,  
         {type => 'code', code => sub {  
            if ($new_flag->[0]) {  
              $old_flag->[0] = 1;  
            } else {  
              $self->{onerror}->(node => $node, type => 'element missing:hn');  
            }  
          }};  
     return ($new_todos, $ch);  
   },  
 };  
   
 $Element->{$HTML_NS}->{footer} = {  
   attrs_checker => $GetHTMLAttrsChecker->({}),  
   checker => sub { ## block -hn -header -footer -sectioning or inline  
     my ($self, $todo) = @_;  
     my $el = $todo->{node};  
     my $new_todos = [];  
     my @nodes = (@{$el->child_nodes});  
     
     my $content = 'block-or-inline'; # or 'block' or 'inline'  
     my @block_not_inline;  
     while (@nodes) {  
       my $node = shift @nodes;  
       $self->_remove_minuses ($node) and next if ref $node eq 'HASH';  
   
       my $nt = $node->node_type;  
       if ($nt == 1) {  
         my $node_ns = $node->namespace_uri;  
         $node_ns = '' unless defined $node_ns;    
         my $node_ln = $node->manakai_local_name;  
         my $not_allowed;  
         if ($self->{minuses}->{$node_ns}->{$node_ln}) {  
           $not_allowed = 1;  
         } elsif ($node_ns eq $HTML_NS and  
                  {  
                    qw/h1 1 h2 1 h3 1 h4 1 h5 1 h6 1 header 1 footer 1/  
                  }->{$node_ln}) {  
           $not_allowed = 1;  
         } elsif ($HTMLSectioningElements->{$node_ns}->{$node_ln}) {  
           $not_allowed = 1;  
         }  
         if ($content eq 'block') {  
           $not_allowed = 1  
             unless $HTMLBlockLevelElements->{$node_ns}->{$node_ln};  
         } elsif ($content eq 'inline') {  
           $not_allowed = 1  
             unless $HTMLStrictlyInlineLevelElements->{$node_ns}->{$node_ln} or  
               $HTMLStructuredInlineLevelElements->{$node_ns}->{$node_ln};  
         } else {  
           my $is_block = $HTMLBlockLevelElements->{$node_ns}->{$node_ln};  
           my $is_inline  
             = $HTMLStrictlyInlineLevelElements->{$node_ns}->{$node_ln} ||  
               $HTMLStructuredInlineLevelElements->{$node_ns}->{$node_ln};  
             
           push @block_not_inline, $node  
             if $is_block and not $is_inline and not $not_allowed;  
           unless ($is_block) {  
             $content = 'inline';  
             for (@block_not_inline) {  
               $self->{onerror}->(node => $_, type => 'element not allowed');  
             }  
             $not_allowed = 1 unless $is_inline;  
           }  
         }  
         $self->{onerror}->(node => $node, type => 'element not allowed')  
           if $not_allowed;  
         my ($sib, $ch) = $self->_check_get_children ($node, $todo);  
         unshift @nodes, @$sib;  
         push @$new_todos, @$ch;  
       } elsif ($nt == 3 or $nt == 4) {  
         if ($node->data =~ /[^\x09-\x0D\x20]/) {  
           if ($content eq 'block') {  
             $self->{onerror}->(node => $node, type => 'character not allowed');  
           } else {  
             $content = 'inline';  
             for (@block_not_inline) {  
               $self->{onerror}->(node => $_, type => 'element not allowed');  
             }  
           }  
         }  
       } elsif ($nt == 5) {  
         unshift @nodes, @{$node->child_nodes};  
       }  
     }  
   
     my $end = $self->_add_minuses  
       ({$HTML_NS => {qw/h1 1 h2 1 h3 1 h4 1 h5 1 h6 1/}},  
        $HTMLSectioningElements);  
     push @$new_todos, $end;  
   
     if ($content eq 'inline') {  
       for (@$new_todos) {  
         $_->{inline} = 1;  
232        }        }
     }  
   
     return ($new_todos);  
   },  
 };  
   
 $Element->{$HTML_NS}->{address} = {  
   attrs_checker => $GetHTMLAttrsChecker->({}),  
   checker => $HTMLInlineChecker,  
 };  
   
 $Element->{$HTML_NS}->{p} = {  
   attrs_checker => $GetHTMLAttrsChecker->({}),  
   checker => $HTMLSignificantInlineChecker,  
 };  
   
 $Element->{$HTML_NS}->{hr} = {  
   attrs_checker => $GetHTMLAttrsChecker->({}),  
   checker => $HTMLEmptyChecker,  
 };  
   
 $Element->{$HTML_NS}->{br} = {  
   attrs_checker => $GetHTMLAttrsChecker->({}),  
   checker => $HTMLEmptyChecker,  
 };  
   
 $Element->{$HTML_NS}->{dialog} = {  
   attrs_checker => $GetHTMLAttrsChecker->({}),  
   checker => sub {  
     my ($self, $todo) = @_;  
     my $el = $todo->{node};  
     my $new_todos = [];  
     my @nodes = (@{$el->child_nodes});  
   
     my $phase = 'before dt';  
     while (@nodes) {  
       my $node = shift @nodes;  
       $self->_remove_minuses ($node) and next if ref $node eq 'HASH';  
   
       my $nt = $node->node_type;  
       if ($nt == 1) {  
         my $node_ns = $node->namespace_uri;  
         $node_ns = '' unless defined $node_ns;  
         my $node_ln = $node->manakai_local_name;  
         ## NOTE: |minuses| list is not checked since redundant  
         if ($phase eq 'before dt') {  
           if ($node_ns eq $HTML_NS and $node_ln eq 'dt') {  
             $phase = 'before dd';  
           } elsif ($node_ns eq $HTML_NS and $node_ln eq 'dd') {  
             $self->{onerror}  
               ->(node => $node, type => 'ps element missing:dt');  
             $phase = 'before dt';  
           } else {  
             $self->{onerror}->(node => $node, type => 'element not allowed');  
           }  
         } else { # before dd  
           if ($node_ns eq $HTML_NS and $node_ln eq 'dd') {  
             $phase = 'before dt';  
           } elsif ($node_ns eq $HTML_NS and $node_ln eq 'dt') {  
             $self->{onerror}  
               ->(node => $node, type => 'ps element missing:dd');  
             $phase = 'before dd';  
           } else {  
             $self->{onerror}->(node => $node, type => 'element not allowed');  
           }  
         }  
         my ($sib, $ch) = $self->_check_get_children ($node, $todo);  
         unshift @nodes, @$sib;  
         push @$new_todos, @$ch;  
       } elsif ($nt == 3 or $nt == 4) {  
         if ($node->data =~ /[^\x09-\x0D\x20]/) {  
           $self->{onerror}->(node => $node, type => 'character not allowed');  
         }  
       } elsif ($nt == 5) {  
         unshift @nodes, @{$node->child_nodes};  
       }  
     }  
     if ($phase eq 'before dd') {  
       $self->{onerror}->(node => $el, type => 'ps element missing:dd');  
     }  
     return ($new_todos);  
   },  
 };  
   
 $Element->{$HTML_NS}->{pre} = {  
   attrs_checker => $GetHTMLAttrsChecker->({}),  
   checker => $HTMLStrictlyInlineChecker,  
 };  
   
 $Element->{$HTML_NS}->{ol} = {  
   attrs_checker => $GetHTMLAttrsChecker->({  
     start => $HTMLIntegerAttrChecker,  
   }),  
   checker => sub {  
     my ($self, $todo) = @_;  
     my $el = $todo->{node};  
     my $new_todos = [];  
     my @nodes = (@{$el->child_nodes});  
   
     while (@nodes) {  
       my $node = shift @nodes;  
       $self->_remove_minuses ($node) and next if ref $node eq 'HASH';  
   
       my $nt = $node->node_type;  
       if ($nt == 1) {  
         my $node_ns = $node->namespace_uri;  
         $node_ns = '' unless defined $node_ns;  
         my $node_ln = $node->manakai_local_name;  
         ## NOTE: |minuses| list is not checked since redundant  
         unless ($node_ns eq $HTML_NS and $node_ln eq 'li') {  
           $self->{onerror}->(node => $node, type => 'element not allowed');  
         }  
         my ($sib, $ch) = $self->_check_get_children ($node, $todo);  
         unshift @nodes, @$sib;  
         push @$new_todos, @$ch;  
       } elsif ($nt == 3 or $nt == 4) {  
         if ($node->data =~ /[^\x09-\x0D\x20]/) {  
           $self->{onerror}->(node => $node, type => 'character not allowed');  
         }  
       } elsif ($nt == 5) {  
         unshift @nodes, @{$node->child_nodes};  
       }  
     }  
   
     if ($todo->{inline}) {  
       for (@$new_todos) {  
         $_->{inline} = 1;  
       }  
     }  
     return ($new_todos);  
   },  
 };  
   
 $Element->{$HTML_NS}->{ul} = {  
   attrs_checker => $GetHTMLAttrsChecker->({}),  
   checker => $Element->{$HTML_NS}->{ol}->{checker},  
 };  
   
   
 $Element->{$HTML_NS}->{li} = {  
   attrs_checker => $GetHTMLAttrsChecker->({  
     start => sub {  
       my ($self, $attr) = @_;  
       my $parent = $attr->owner_element->manakai_parent_element;  
       if (defined $parent) {  
         my $parent_ns = $parent->namespace_uri;  
         $parent_ns = '' unless defined $parent_ns;  
         my $parent_ln = $parent->manakai_local_name;  
         unless ($parent_ns eq $HTML_NS and $parent_ln eq 'ol') {  
           $self->{onerror}->(node => $attr, level => 'unsupported',  
                              type => 'attribute');  
         }  
       }  
       $HTMLIntegerAttrChecker->($self, $attr);  
     },  
   }),  
   checker => sub {  
     my ($self, $todo) = @_;  
     if ($todo->{inline}) {  
       return $HTMLInlineChecker->($self, $todo);  
     } else {  
       return $HTMLBlockOrInlineChecker->($self, $todo);  
     }  
   },  
 };  
   
 $Element->{$HTML_NS}->{dl} = {  
   attrs_checker => $GetHTMLAttrsChecker->({}),  
   checker => sub {  
     my ($self, $todo) = @_;  
     my $el = $todo->{node};  
     my $new_todos = [];  
     my @nodes = (@{$el->child_nodes});  
   
     my $phase = 'before dt';  
     while (@nodes) {  
       my $node = shift @nodes;  
       $self->_remove_minuses ($node) and next if ref $node eq 'HASH';  
   
       my $nt = $node->node_type;  
       if ($nt == 1) {  
         my $node_ns = $node->namespace_uri;  
         $node_ns = '' unless defined $node_ns;  
         my $node_ln = $node->manakai_local_name;  
         ## NOTE: |minuses| list is not checked since redundant  
         if ($phase eq 'in dds') {  
           if ($node_ns eq $HTML_NS and $node_ln eq 'dd') {  
             #$phase = 'in dds';  
           } elsif ($node_ns eq $HTML_NS and $node_ln eq 'dt') {  
             $phase = 'in dts';  
           } else {  
             $self->{onerror}->(node => $node, type => 'element not allowed');  
           }  
         } elsif ($phase eq 'in dts') {  
           if ($node_ns eq $HTML_NS and $node_ln eq 'dt') {  
             #$phase = 'in dts';  
           } elsif ($node_ns eq $HTML_NS and $node_ln eq 'dd') {  
             $phase = 'in dds';  
           } else {  
             $self->{onerror}->(node => $node, type => 'element not allowed');  
           }  
         } else { # before dt  
           if ($node_ns eq $HTML_NS and $node_ln eq 'dt') {  
             $phase = 'in dts';  
           } elsif ($node_ns eq $HTML_NS and $node_ln eq 'dd') {  
             $self->{onerror}  
               ->(node => $node, type => 'ps element missing:dt');  
             $phase = 'in dds';  
           } else {  
             $self->{onerror}->(node => $node, type => 'element not allowed');  
           }  
         }  
         my ($sib, $ch) = $self->_check_get_children ($node, $todo);  
         unshift @nodes, @$sib;  
         push @$new_todos, @$ch;  
       } elsif ($nt == 3 or $nt == 4) {  
         if ($node->data =~ /[^\x09-\x0D\x20]/) {  
           $self->{onerror}->(node => $node, type => 'character not allowed');  
         }  
       } elsif ($nt == 5) {  
         unshift @nodes, @{$node->child_nodes};  
       }  
     }  
     if ($phase eq 'in dts') {  
       $self->{onerror}->(node => $el, type => 'ps element missing:dd');  
     }  
   
     if ($todo->{inline}) {  
       for (@$new_todos) {  
         $_->{inline} = 1;  
       }  
     }  
     return ($new_todos);  
   },  
 };  
   
 $Element->{$HTML_NS}->{dt} = {  
   attrs_checker => $GetHTMLAttrsChecker->({}),  
   checker => $HTMLStrictlyInlineChecker,  
 };  
   
 $Element->{$HTML_NS}->{dd} = {  
   attrs_checker => $GetHTMLAttrsChecker->({}),  
   checker => $Element->{$HTML_NS}->{li}->{checker},  
 };  
   
 $Element->{$HTML_NS}->{a} = {  
   attrs_checker => sub {  
     my ($self, $todo) = @_;  
     my %attr;  
     for my $attr (@{$todo->{node}->attributes}) {  
       my $attr_ns = $attr->namespace_uri;  
       $attr_ns = '' unless defined $attr_ns;  
233        my $attr_ln = $attr->manakai_local_name;        my $attr_ln = $attr->manakai_local_name;
234        my $checker;        
235        if ($attr_ns eq '') {        my $checker = $AttrChecker->{$attr_ns}->{$attr_ln}
236          $checker = {            || $AttrChecker->{$attr_ns}->{''};
237                       target => $HTMLTargetAttrChecker,        my $status = $AttrStatus->{$attr_ns}->{$attr_ln}
238                       href => $HTMLURIAttrChecker,            || $AttrStatus->{$attr_ns}->{''};
239                       ping => $HTMLSpaceURIsAttrChecker,        if (not defined $status) {
240                       rel => sub { $HTMLLinkTypesAttrChecker->(1, @_) },          $status = FEATURE_ALLOWED;
241                       media => $HTMLMQAttrChecker,          ## NOTE: FEATURE_ALLOWED for all attributes, since the element
242                       hreflang => $HTMLLanguageTagAttrChecker,          ## is not supported and therefore "attribute not defined" error
243                       type => $HTMLIMTAttrChecker,          ## should not raised (too verbose) and global attributes should be
244                     }->{$attr_ln};          ## allowed anyway (if a global attribute has its specified creteria
245          if ($checker) {          ## for where it may be specified, then it should be checked in it's
246            $attr{$attr_ln} = $attr;          ## checker function).
         } else {  
           $checker = $HTMLAttrChecker->{$attr_ln};  
         }  
       }  
       $checker ||= $AttrChecker->{$attr_ns}->{$attr_ln}  
         || $AttrChecker->{$attr_ns}->{''};  
       if ($checker) {  
         $checker->($self, $attr) if ref $checker;  
       } else {  
         $self->{onerror}->(node => $attr, level => 'unsupported',  
                            type => 'attribute');  
         ## ISSUE: No comformance createria for unknown attributes in the spec  
       }  
     }  
   
     unless (defined $attr{href}) {  
       for (qw/target ping rel media hreflang type/) {  
         if (defined $attr{$_}) {  
           $self->{onerror}->(node => $attr{$_},  
                              type => 'attribute not allowed');  
         }  
       }  
     }  
   },  
   checker => sub {  
     my ($self, $todo) = @_;  
   
     my $end = $self->_add_minuses ($HTMLInteractiveElements);  
     my ($new_todos, $ch)  
       = $HTMLSignificantInlineOrStrictlyInlineChecker->($self, $todo);  
     push @$new_todos, $end;  
   
     $_->{flag}->{has_a} = 1 for @$new_todos;  
   
     return ($new_todos, $ch);  
   },  
 };  
   
 $Element->{$HTML_NS}->{q} = {  
   attrs_checker => $GetHTMLAttrsChecker->({  
     cite => $HTMLURIAttrChecker,  
   }),  
   checker => $HTMLInlineOrStrictlyInlineChecker,  
 };  
   
 $Element->{$HTML_NS}->{cite} = {  
   attrs_checker => $GetHTMLAttrsChecker->({}),  
   checker => $HTMLStrictlyInlineChecker,  
 };  
   
 $Element->{$HTML_NS}->{em} = {  
   attrs_checker => $GetHTMLAttrsChecker->({}),  
   checker => $HTMLInlineOrStrictlyInlineChecker,  
 };  
   
 $Element->{$HTML_NS}->{strong} = {  
   attrs_checker => $GetHTMLAttrsChecker->({}),  
   checker => $HTMLInlineOrStrictlyInlineChecker,  
 };  
   
 $Element->{$HTML_NS}->{small} = {  
   attrs_checker => $GetHTMLAttrsChecker->({}),  
   checker => $HTMLInlineOrStrictlyInlineChecker,  
 };  
   
 $Element->{$HTML_NS}->{m} = {  
   attrs_checker => $GetHTMLAttrsChecker->({}),  
   checker => $HTMLInlineOrStrictlyInlineChecker,  
 };  
   
 $Element->{$HTML_NS}->{dfn} = {  
   attrs_checker => $GetHTMLAttrsChecker->({}),  
   checker => sub {  
     my ($self, $todo) = @_;  
   
     my $end = $self->_add_minuses ({$HTML_NS => {dfn => 1}});  
     my ($sib, $ch) = $HTMLStrictlyInlineChecker->($self, $todo);  
     push @$sib, $end;  
   
     my $node = $todo->{node};  
     my $term = $node->get_attribute_ns (undef, 'title');  
     unless (defined $term) {  
       for my $child (@{$node->child_nodes}) {  
         if ($child->node_type == 1) { # ELEMENT_NODE  
           if (defined $term) {  
             undef $term;  
             last;  
           } elsif ($child->manakai_local_name eq 'abbr') {  
             my $nsuri = $child->namespace_uri;  
             if (defined $nsuri and $nsuri eq $HTML_NS) {  
               my $attr = $child->get_attribute_node_ns (undef, 'title');  
               if ($attr) {  
                 $term = $attr->value;  
               }  
             }  
           }  
         } elsif ($child->node_type == 3 or $child->node_type == 4) {  
           ## TEXT_NODE or CDATA_SECTION_NODE  
           if ($child->data =~ /\A[\x09-\x0D\x20]+\z/) { # Inter-element whitespace  
             next;  
           }  
           undef $term;  
           last;  
         }  
       }  
       unless (defined $term) {  
         $term = $node->text_content;  
       }  
     }  
     if ($self->{term}->{$term}) {  
       $self->{onerror}->(node => $node, type => 'duplicate term');  
       push @{$self->{term}->{$term}}, $node;  
     } else {  
       $self->{term}->{$term} = [$node];  
     }  
   
     return ($sib, $ch);  
   },  
 };  
   
 $Element->{$HTML_NS}->{abbr} = {  
   attrs_checker => $GetHTMLAttrsChecker->({  
     ## NOTE: |title| has special semantics for |abbr|s, but is syntactically  
     ## not different.  The spec says that the |title| MAY be omitted  
     ## if there is a |dfn| whose defining term is the abbreviation,  
     ## but it does not prohibit |abbr| w/o |title| in other cases.  
   }),  
   checker => $HTMLStrictlyInlineChecker,  
 };  
   
 $Element->{$HTML_NS}->{time} = { ## TODO: validate content  
   attrs_checker => $GetHTMLAttrsChecker->({}), ## TODO: datetime  
   checker => $HTMLStrictlyInlineChecker,  
 };  
   
 $Element->{$HTML_NS}->{meter} = { ## TODO: "The recommended way of giving the value is to include it as contents of the element"  
   attrs_checker => $GetHTMLAttrsChecker->({  
     value => $GetHTMLFloatingPointNumberAttrChecker->(sub { 1 }),  
     min => $GetHTMLFloatingPointNumberAttrChecker->(sub { 1 }),  
     low => $GetHTMLFloatingPointNumberAttrChecker->(sub { 1 }),  
     high => $GetHTMLFloatingPointNumberAttrChecker->(sub { 1 }),  
     max => $GetHTMLFloatingPointNumberAttrChecker->(sub { 1 }),  
     optimum => $GetHTMLFloatingPointNumberAttrChecker->(sub { 1 }),  
   }),  
   checker => $HTMLStrictlyInlineChecker,  
 };  
   
 $Element->{$HTML_NS}->{progress} = { ## TODO: recommended to use content  
   attrs_checker => $GetHTMLAttrsChecker->({  
     value => $GetHTMLFloatingPointNumberAttrChecker->(sub { shift >= 0 }),  
     max => $GetHTMLFloatingPointNumberAttrChecker->(sub { shift > 0 }),  
   }),  
   checker => $HTMLStrictlyInlineChecker,  
 };  
   
 $Element->{$HTML_NS}->{code} = {  
   attrs_checker => $GetHTMLAttrsChecker->({}),  
   ## NOTE: Though |title| has special semantics,  
   ## syntatically same as the |title| as global attribute.  
   checker => $HTMLInlineOrStrictlyInlineChecker,  
 };  
   
 $Element->{$HTML_NS}->{var} = {  
   attrs_checker => $GetHTMLAttrsChecker->({}),  
   ## NOTE: Though |title| has special semantics,  
   ## syntatically same as the |title| as global attribute.  
   checker => $HTMLStrictlyInlineChecker,  
 };  
   
 $Element->{$HTML_NS}->{samp} = {  
   attrs_checker => $GetHTMLAttrsChecker->({}),  
   ## NOTE: Though |title| has special semantics,  
   ## syntatically same as the |title| as global attribute.  
   checker => $HTMLInlineOrStrictlyInlineChecker,  
 };  
   
 $Element->{$HTML_NS}->{kbd} = {  
   attrs_checker => $GetHTMLAttrsChecker->({}),  
   checker => $HTMLStrictlyInlineChecker,  
 };  
   
 $Element->{$HTML_NS}->{sub} = {  
   attrs_checker => $GetHTMLAttrsChecker->({}),  
   checker => $HTMLStrictlyInlineChecker,  
 };  
   
 $Element->{$HTML_NS}->{sup} = {  
   attrs_checker => $GetHTMLAttrsChecker->({}),  
   checker => $HTMLStrictlyInlineChecker,  
 };  
   
 $Element->{$HTML_NS}->{span} = {  
   attrs_checker => $GetHTMLAttrsChecker->({}),  
   ## NOTE: Though |title| has special semantics,  
   ## syntatically same as the |title| as global attribute.  
   checker => $HTMLInlineOrStrictlyInlineChecker,  
 };  
   
 $Element->{$HTML_NS}->{i} = {  
   attrs_checker => $GetHTMLAttrsChecker->({}),  
   ## NOTE: Though |title| has special semantics,  
   ## syntatically same as the |title| as global attribute.  
   checker => $HTMLStrictlyInlineChecker,  
 };  
   
 $Element->{$HTML_NS}->{b} = {  
   attrs_checker => $GetHTMLAttrsChecker->({}),  
   checker => $HTMLStrictlyInlineChecker,  
 };  
   
 $Element->{$HTML_NS}->{bdo} = {  
   attrs_checker => sub {  
     my ($self, $todo) = @_;  
     $GetHTMLAttrsChecker->({})->($self, $todo);  
     unless ($todo->{node}->has_attribute_ns (undef, 'dir')) {  
       $self->{onerror}->(node => $todo->{node}, type => 'attribute missing:dir');  
     }  
   },  
   ## ISSUE: The spec does not directly say that |dir| is a enumerated attr.  
   checker => $HTMLStrictlyInlineChecker,  
 };  
   
 $Element->{$HTML_NS}->{ins} = {  
   attrs_checker => $GetHTMLAttrsChecker->({  
     cite => $HTMLURIAttrChecker,  
     datetime => $HTMLDatetimeAttrChecker,  
   }),  
   checker => $HTMLTransparentChecker,  
 };  
   
 $Element->{$HTML_NS}->{del} = {  
   attrs_checker => $GetHTMLAttrsChecker->({  
     cite => $HTMLURIAttrChecker,  
     datetime => $HTMLDatetimeAttrChecker,  
   }),  
   checker => sub {  
     my ($self, $todo) = @_;  
   
     my $parent = $todo->{node}->manakai_parent_element;  
     if (defined $parent) {  
       my $nsuri = $parent->namespace_uri;  
       $nsuri = '' unless defined $nsuri;  
       my $ln = $parent->manakai_local_name;  
       my $eldef = $Element->{$nsuri}->{$ln} ||  
         $Element->{$nsuri}->{''} ||  
         $ElementDefault;  
       return $eldef->{checker}->($self, $todo);  
     } else {  
       return $HTMLBlockOrInlineChecker->($self, $todo);  
     }  
   },  
 };  
   
 ## TODO: figure  
   
 $Element->{$HTML_NS}->{img} = {  
   attrs_checker => sub {  
     my ($self, $todo) = @_;  
     $GetHTMLAttrsChecker->({  
       alt => sub { }, ## NOTE: No syntactical requirement  
       src => $HTMLURIAttrChecker,  
       usemap => $HTMLUsemapAttrChecker,  
       ismap => sub {  
         my ($self, $attr, $parent_todo) = @_;  
         if (not $todo->{flag}->{has_a}) {  
           $self->{onerror}->(node => $attr, type => 'attribute not allowed');  
         }  
         $GetHTMLBooleanAttrChecker->('ismap')->($self, $attr, $parent_todo);  
       },  
       ## TODO: height  
       ## TODO: width  
     })->($self, $todo);  
     unless ($todo->{node}->has_attribute_ns (undef, 'alt')) {  
       $self->{onerror}->(node => $todo->{node}, type => 'attribute missing:alt');  
     }  
     unless ($todo->{node}->has_attribute_ns (undef, 'src')) {  
       $self->{onerror}->(node => $todo->{node}, type => 'attribute missing:src');  
     }  
   },  
   checker => $HTMLEmptyChecker,  
 };  
   
 $Element->{$HTML_NS}->{iframe} = {  
   attrs_checker => $GetHTMLAttrsChecker->({  
     src => $HTMLURIAttrChecker,  
   }),  
   checker => $HTMLTextChecker,  
 };  
   
 $Element->{$HTML_NS}->{embed} = {  
   attrs_checker => sub {  
     my ($self, $todo) = @_;  
     my $has_src;  
     for my $attr (@{$todo->{node}->attributes}) {  
       my $attr_ns = $attr->namespace_uri;  
       $attr_ns = '' unless defined $attr_ns;  
       my $attr_ln = $attr->manakai_local_name;  
       my $checker;  
       if ($attr_ns eq '') {  
         if ($attr_ln eq 'src') {  
           $checker = $HTMLURIAttrChecker;  
           $has_src = 1;  
         } elsif ($attr_ln eq 'type') {  
           $checker = $HTMLIMTAttrChecker;  
         } else {  
           ## TODO: height  
           ## TODO: width  
           $checker = $HTMLAttrChecker->{$attr_ln}  
             || sub { }; ## NOTE: Any local attribute is ok.  
         }  
247        }        }
       $checker ||= $AttrChecker->{$attr_ns}->{$attr_ln}  
         || $AttrChecker->{$attr_ns}->{''};  
248        if ($checker) {        if ($checker) {
249          $checker->($self, $attr);          $checker->($self, $attr);
250        } else {        } else {
251          $self->{onerror}->(node => $attr, level => 'unsupported',          $self->{onerror}->(node => $attr,
252                             type => 'attribute');                             type => 'unknown attribute',
253          ## ISSUE: No comformance createria for global attributes in the spec                             level => $self->{level}->{uncertain});
       }  
     }  
   
     unless ($has_src) {  
       $self->{onerror}->(node => $todo->{node},  
                          type => 'attribute missing:src');  
     }  
   },  
   checker => $HTMLEmptyChecker,  
 };  
   
 $Element->{$HTML_NS}->{object} = {  
   attrs_checker => sub {  
     my ($self, $todo) = @_;  
     $GetHTMLAttrsChecker->({  
       data => $HTMLURIAttrChecker,  
       type => $HTMLIMTAttrChecker,  
       usemap => $HTMLUsemapAttrChecker,  
       ## TODO: width  
       ## TODO: height  
     })->($self, $todo);  
     unless ($todo->{node}->has_attribute_ns (undef, 'data')) {  
       unless ($todo->{node}->has_attribute_ns (undef, 'type')) {  
         $self->{onerror}->(node => $todo->{node},  
                            type => 'attribute missing:data|type');  
       }  
     }  
   },  
   checker => $ElementDefault->{checker}, ## TODO  
 };  
   
 $Element->{$HTML_NS}->{param} = {  
   attrs_checker => sub {  
     my ($self, $todo) = @_;  
     $GetHTMLAttrsChecker->({  
       name => sub { },  
       value => sub { },  
     })->($self, $todo);  
     unless ($todo->{node}->has_attribute_ns (undef, 'name')) {  
       $self->{onerror}->(node => $todo->{node},  
                          type => 'attribute missing:name');  
     }  
     unless ($todo->{node}->has_attribute_ns (undef, 'value')) {  
       $self->{onerror}->(node => $todo->{node},  
                          type => 'attribute missing:value');  
     }  
   },  
   checker => $HTMLEmptyChecker,  
 };  
   
 $Element->{$HTML_NS}->{video} = {  
   attrs_checker => $GetHTMLAttrsChecker->({  
     src => $HTMLURIAttrChecker,  
     ## TODO: start, loopstart, loopend, end  
     ## ISSUE: they MUST be "value time offset"s.  Value?  
     ## ISSUE: loopcount has no conformance creteria  
     autoplay => $GetHTMLBooleanAttrChecker->('autoplay'),  
     controls => $GetHTMLBooleanAttrChecker->('controls'),  
   }),  
   checker => sub {  
     my ($self, $todo) = @_;  
   
     if ($todo->{node}->has_attribute_ns (undef, 'src')) {  
       return $HTMLBlockOrInlineChecker->($self, $todo);  
     } else {  
       return $GetHTMLZeroOrMoreThenBlockOrInlineChecker->($HTML_NS, 'source')  
         ->($self, $todo);  
     }  
   },  
 };  
   
 $Element->{$HTML_NS}->{audio} = {  
   attrs_checker => $Element->{$HTML_NS}->{video}->{attrs_checker},  
   checker => $Element->{$HTML_NS}->{video}->{checker},  
 };  
   
 $Element->{$HTML_NS}->{source} = {  
   attrs_checker => sub {  
     my ($self, $todo) = @_;  
     $GetHTMLAttrsChecker->({  
       src => $HTMLURIAttrChecker,  
       type => $HTMLIMTAttrChecker,  
       media => $HTMLMQAttrChecker,  
     })->($self, $todo);  
     unless ($todo->{node}->has_attribute_ns (undef, 'src')) {  
       $self->{onerror}->(node => $todo->{node},  
                          type => 'attribute missing:src');  
     }  
   },  
   checker => $HTMLEmptyChecker,  
 };  
   
 $Element->{$HTML_NS}->{canvas} = {  
   attrs_checker => $GetHTMLAttrsChecker->({  
     height => $GetHTMLNonNegativeIntegerAttrChecker->(sub { 1 }),  
     width => $GetHTMLNonNegativeIntegerAttrChecker->(sub { 1 }),  
   }),  
   checker => $HTMLInlineChecker,  
 };  
   
 $Element->{$HTML_NS}->{map} = {  
   attrs_checker => $GetHTMLAttrsChecker->({  
     id => sub {  
       ## NOTE: same as global |id=""|, with |$self->{map}| registeration  
       my ($self, $attr) = @_;  
       my $value = $attr->value;  
       if (length $value > 0) {  
         if ($self->{id}->{$value}) {  
           $self->{onerror}->(node => $attr, type => 'duplicate ID');  
         } else {  
           $self->{id}->{$value} = 1;  
         }  
       } else {  
         ## NOTE: MUST contain at least one character  
         $self->{onerror}->(node => $attr, type => 'empty attribute value');  
       }  
       if ($value =~ /[\x09-\x0D\x20]/) {  
         $self->{onerror}->(node => $attr, type => 'space in ID');  
       }  
       $self->{map}->{$value} ||= $attr;  
     },  
   }),  
   checker => $HTMLBlockChecker,  
 };  
   
 $Element->{$HTML_NS}->{area} = {  
   attrs_checker => sub {  
     my ($self, $todo) = @_;  
     my %attr;  
     my $coords;  
     for my $attr (@{$todo->{node}->attributes}) {  
       my $attr_ns = $attr->namespace_uri;  
       $attr_ns = '' unless defined $attr_ns;  
       my $attr_ln = $attr->manakai_local_name;  
       my $checker;  
       if ($attr_ns eq '') {  
         $checker = {  
                      alt => sub { },  
                          ## NOTE: |alt| value has no conformance creteria.  
                      shape => $GetHTMLEnumeratedAttrChecker->({  
                        circ => -1, circle => 1,  
                        default => 1,  
                        poly => 1, polygon => -1,  
                        rect => 1, rectangle => -1,  
                      }),  
                      coords => sub {  
                        my ($self, $attr) = @_;  
                        my $value = $attr->value;  
                        if ($value =~ /\A-?[0-9]+(?>,-?[0-9]+)*\z/) {  
                          $coords = [split /,/, $value];  
                        } else {  
                          $self->{onerror}->(node => $attr,  
                                             type => 'coords:syntax error');  
                        }  
                      },  
                      target => $HTMLTargetAttrChecker,  
                      href => $HTMLURIAttrChecker,  
                      ping => $HTMLSpaceURIsAttrChecker,  
                      rel => sub { $HTMLLinkTypesAttrChecker->(1, @_) },  
                      media => $HTMLMQAttrChecker,  
                      hreflang => $HTMLLanguageTagAttrChecker,  
                      type => $HTMLIMTAttrChecker,  
                    }->{$attr_ln};  
         if ($checker) {  
           $attr{$attr_ln} = $attr;  
         } else {  
           $checker = $HTMLAttrChecker->{$attr_ln};  
         }  
       }  
       $checker ||= $AttrChecker->{$attr_ns}->{$attr_ln}  
         || $AttrChecker->{$attr_ns}->{''};  
       if ($checker) {  
         $checker->($self, $attr) if ref $checker;  
       } else {  
         $self->{onerror}->(node => $attr, level => 'unsupported',  
                            type => 'attribute');  
         ## ISSUE: No comformance createria for unknown attributes in the spec  
       }  
     }  
   
     if (defined $attr{href}) {  
       unless (defined $attr{alt}) {  
         $self->{onerror}->(node => $todo->{node},  
                            type => 'attribute missing:alt');  
       }  
     } else {  
       for (qw/target ping rel media hreflang type alt/) {  
         if (defined $attr{$_}) {  
           $self->{onerror}->(node => $attr{$_},  
                              type => 'attribute not allowed');  
         }  
       }  
     }  
   
     my $shape = 'rectangle';  
     if (defined $attr{shape}) {  
       $shape = {  
                 circ => 'circle', circle => 'circle',  
                 default => 'default',  
                 poly => 'polygon', polygon => 'polygon',  
                 rect => 'rectangle', rectangle => 'rectangle',  
                }->{lc $attr{shape}->value} || 'rectangle';  
       ## TODO: ASCII lowercase?  
     }  
   
     if ($shape eq 'circle') {  
       if (defined $attr{coords}) {  
         if (defined $coords) {  
           if (@$coords == 3) {  
             if ($coords->[2] < 0) {  
               $self->{onerror}->(node => $attr{coords},  
                                  type => 'coords:out of range:2');  
             }  
           } else {  
             $self->{onerror}->(node => $attr{coords},  
                                type => 'coords:number:3:'.@$coords);  
           }  
         } else {  
           ## NOTE: A syntax error has been reported.  
         }  
       } else {  
         $self->{onerror}->(node => $todo->{node},  
                            type => 'attribute missing:coords');  
       }  
     } elsif ($shape eq 'default') {  
       if (defined $attr{coords}) {  
         $self->{onerror}->(node => $attr{coords},  
                            type => 'attribute not allowed');  
       }  
     } elsif ($shape eq 'polygon') {  
       if (defined $attr{coords}) {  
         if (defined $coords) {  
           if (@$coords >= 6) {  
             unless (@$coords % 2 == 0) {  
               $self->{onerror}->(node => $attr{coords},  
                                  type => 'coords:number:even:'.@$coords);  
             }  
           } else {  
             $self->{onerror}->(node => $attr{coords},  
                                type => 'coords:number:>=6:'.@$coords);  
           }  
         } else {  
           ## NOTE: A syntax error has been reported.  
         }  
       } else {  
         $self->{onerror}->(node => $todo->{node},  
                            type => 'attribute missing:coords');  
       }  
     } elsif ($shape eq 'rectangle') {  
       if (defined $attr{coords}) {  
         if (defined $coords) {  
           if (@$coords == 4) {  
             unless ($coords->[0] < $coords->[2]) {  
               $self->{onerror}->(node => $attr{coords},  
                                  type => 'coords:out of range:0');  
             }  
             unless ($coords->[1] < $coords->[3]) {  
               $self->{onerror}->(node => $attr{coords},  
                                  type => 'coords:out of range:1');  
             }  
           } else {  
             $self->{onerror}->(node => $attr{coords},  
                                type => 'coords:number:4:'.@$coords);  
           }  
         } else {  
           ## NOTE: A syntax error has been reported.  
         }  
       } else {  
         $self->{onerror}->(node => $todo->{node},  
                            type => 'attribute missing:coords');  
       }  
     }  
   },  
   checker => $HTMLEmptyChecker,  
 };  
 ## TODO: only in map  
   
 $Element->{$HTML_NS}->{table} = {  
   attrs_checker => $GetHTMLAttrsChecker->({}),  
   checker => sub {  
     my ($self, $todo) = @_;  
     my $el = $todo->{node};  
     my $new_todos = [];  
     my @nodes = (@{$el->child_nodes});  
   
     my $phase = 'before caption';  
     my $has_tfoot;  
     while (@nodes) {  
       my $node = shift @nodes;  
       $self->_remove_minuses ($node) and next if ref $node eq 'HASH';  
   
       my $nt = $node->node_type;  
       if ($nt == 1) {  
         my $node_ns = $node->namespace_uri;  
         $node_ns = '' unless defined $node_ns;  
         my $node_ln = $node->manakai_local_name;  
         ## NOTE: |minuses| list is not checked since redundant  
         if ($phase eq 'in tbodys') {  
           if ($node_ns eq $HTML_NS and $node_ln eq 'tbody') {  
             #$phase = 'in tbodys';  
           } elsif (not $has_tfoot and  
                    $node_ns eq $HTML_NS and $node_ln eq 'tfoot') {  
             $phase = 'after tfoot';  
             $has_tfoot = 1;  
           } else {  
             $self->{onerror}->(node => $node, type => 'element not allowed');  
           }  
         } elsif ($phase eq 'in trs') {  
           if ($node_ns eq $HTML_NS and $node_ln eq 'tr') {  
             #$phase = 'in trs';  
           } elsif (not $has_tfoot and  
                    $node_ns eq $HTML_NS and $node_ln eq 'tfoot') {  
             $phase = 'after tfoot';  
             $has_tfoot = 1;  
           } else {  
             $self->{onerror}->(node => $node, type => 'element not allowed');  
           }  
         } elsif ($phase eq 'after thead') {  
           if ($node_ns eq $HTML_NS and $node_ln eq 'tbody') {  
             $phase = 'in tbodys';  
           } elsif ($node_ns eq $HTML_NS and $node_ln eq 'tr') {  
             $phase = 'in trs';  
           } elsif ($node_ns eq $HTML_NS and $node_ln eq 'tfoot') {  
             $phase = 'in tbodys';  
             $has_tfoot = 1;  
           } else {  
             $self->{onerror}->(node => $node, type => 'element not allowed');  
           }  
         } elsif ($phase eq 'in colgroup') {  
           if ($node_ns eq $HTML_NS and $node_ln eq 'colgroup') {  
             $phase = 'in colgroup';  
           } elsif ($node_ns eq $HTML_NS and $node_ln eq 'thead') {  
             $phase = 'after thead';  
           } elsif ($node_ns eq $HTML_NS and $node_ln eq 'tbody') {  
             $phase = 'in tbodys';  
           } elsif ($node_ns eq $HTML_NS and $node_ln eq 'tr') {  
             $phase = 'in trs';  
           } elsif ($node_ns eq $HTML_NS and $node_ln eq 'tfoot') {  
             $phase = 'in tbodys';  
             $has_tfoot = 1;  
           } else {  
             $self->{onerror}->(node => $node, type => 'element not allowed');  
           }  
         } elsif ($phase eq 'before caption') {  
           if ($node_ns eq $HTML_NS and $node_ln eq 'caption') {  
             $phase = 'in colgroup';  
           } elsif ($node_ns eq $HTML_NS and $node_ln eq 'colgroup') {  
             $phase = 'in colgroup';  
           } elsif ($node_ns eq $HTML_NS and $node_ln eq 'thead') {  
             $phase = 'after thead';  
           } elsif ($node_ns eq $HTML_NS and $node_ln eq 'tbody') {  
             $phase = 'in tbodys';  
           } elsif ($node_ns eq $HTML_NS and $node_ln eq 'tr') {  
             $phase = 'in trs';  
           } elsif ($node_ns eq $HTML_NS and $node_ln eq 'tfoot') {  
             $phase = 'in tbodys';  
             $has_tfoot = 1;  
           } else {  
             $self->{onerror}->(node => $node, type => 'element not allowed');  
           }  
         } else { # after tfoot  
           $self->{onerror}->(node => $node, type => 'element not allowed');  
         }  
         my ($sib, $ch) = $self->_check_get_children ($node, $todo);  
         unshift @nodes, @$sib;  
         push @$new_todos, @$ch;  
       } elsif ($nt == 3 or $nt == 4) {  
         if ($node->data =~ /[^\x09-\x0D\x20]/) {  
           $self->{onerror}->(node => $node, type => 'character not allowed');  
         }  
       } elsif ($nt == 5) {  
         unshift @nodes, @{$node->child_nodes};  
       }  
     }  
   
     ## Table model errors  
     require Whatpm::HTMLTable;  
     Whatpm::HTMLTable->form_table ($todo->{node}, sub {  
       my %opt = @_;  
       $self->{onerror}->(type => 'table:'.$opt{type}, node => $opt{node});  
     });  
     push @{$self->{return}->{table}}, $todo->{node};  
   
     return ($new_todos);  
   },  
 };  
   
 $Element->{$HTML_NS}->{caption} = {  
   attrs_checker => $GetHTMLAttrsChecker->({}),  
   checker => $HTMLSignificantStrictlyInlineChecker,  
 };  
   
 $Element->{$HTML_NS}->{colgroup} = {  
   attrs_checker => $GetHTMLAttrsChecker->({  
     span => $GetHTMLNonNegativeIntegerAttrChecker->(sub { shift > 0 }),  
       ## NOTE: Defined only if "the |colgroup| element contains no |col| elements"  
       ## TODO: "attribute not supported" if |col|.  
       ## ISSUE: MUST NOT if any |col|?  
       ## ISSUE: MUST NOT for |<colgroup span="1"><any><col/></any></colgroup>| (though non-conforming)?  
   }),  
   checker => sub {  
     my ($self, $todo) = @_;  
     my $el = $todo->{node};  
     my $new_todos = [];  
     my @nodes = (@{$el->child_nodes});  
   
     while (@nodes) {  
       my $node = shift @nodes;  
       $self->_remove_minuses ($node) and next if ref $node eq 'HASH';  
   
       my $nt = $node->node_type;  
       if ($nt == 1) {  
         my $node_ns = $node->namespace_uri;  
         $node_ns = '' unless defined $node_ns;  
         my $node_ln = $node->manakai_local_name;  
         ## NOTE: |minuses| list is not checked since redundant  
         unless ($node_ns eq $HTML_NS and $node_ln eq 'col') {  
           $self->{onerror}->(node => $node, type => 'element not allowed');  
         }  
         my ($sib, $ch) = $self->_check_get_children ($node, $todo);  
         unshift @nodes, @$sib;  
         push @$new_todos, @$ch;  
       } elsif ($nt == 3 or $nt == 4) {  
         if ($node->data =~ /[^\x09-\x0D\x20]/) {  
           $self->{onerror}->(node => $node, type => 'character not allowed');  
         }  
       } elsif ($nt == 5) {  
         unshift @nodes, @{$node->child_nodes};  
       }  
     }  
     return ($new_todos);  
   },  
 };  
   
 $Element->{$HTML_NS}->{col} = {  
   attrs_checker => $GetHTMLAttrsChecker->({  
     span => $GetHTMLNonNegativeIntegerAttrChecker->(sub { shift > 0 }),  
   }),  
   checker => $HTMLEmptyChecker,  
 };  
   
 $Element->{$HTML_NS}->{tbody} = {  
   attrs_checker => $GetHTMLAttrsChecker->({}),  
   checker => sub {  
     my ($self, $todo) = @_;  
     my $el = $todo->{node};  
     my $new_todos = [];  
     my @nodes = (@{$el->child_nodes});  
   
     my $has_tr;  
     while (@nodes) {  
       my $node = shift @nodes;  
       $self->_remove_minuses ($node) and next if ref $node eq 'HASH';  
   
       my $nt = $node->node_type;  
       if ($nt == 1) {  
         my $node_ns = $node->namespace_uri;  
         $node_ns = '' unless defined $node_ns;  
         my $node_ln = $node->manakai_local_name;  
         ## NOTE: |minuses| list is not checked since redundant  
         if ($node_ns eq $HTML_NS and $node_ln eq 'tr') {  
           $has_tr = 1;  
         } else {  
           $self->{onerror}->(node => $node, type => 'element not allowed');  
         }  
         my ($sib, $ch) = $self->_check_get_children ($node, $todo);  
         unshift @nodes, @$sib;  
         push @$new_todos, @$ch;  
       } elsif ($nt == 3 or $nt == 4) {  
         if ($node->data =~ /[^\x09-\x0D\x20]/) {  
           $self->{onerror}->(node => $node, type => 'character not allowed');  
         }  
       } elsif ($nt == 5) {  
         unshift @nodes, @{$node->child_nodes};  
       }  
     }  
     unless ($has_tr) {  
       $self->{onerror}->(node => $el, type => 'child element missing:tr');  
     }  
     return ($new_todos);  
   },  
 };  
   
 $Element->{$HTML_NS}->{thead} = {  
   attrs_checker => $GetHTMLAttrsChecker->({}),  
   checker => $Element->{$HTML_NS}->{tbody}->{checker},  
 };  
   
 $Element->{$HTML_NS}->{tfoot} = {  
   attrs_checker => $GetHTMLAttrsChecker->({}),  
   checker => $Element->{$HTML_NS}->{tbody}->{checker},  
 };  
   
 $Element->{$HTML_NS}->{tr} = {  
   attrs_checker => $GetHTMLAttrsChecker->({}),  
   checker => sub {  
     my ($self, $todo) = @_;  
     my $el = $todo->{node};  
     my $new_todos = [];  
     my @nodes = (@{$el->child_nodes});  
   
     my $has_td;  
     while (@nodes) {  
       my $node = shift @nodes;  
       $self->_remove_minuses ($node) and next if ref $node eq 'HASH';  
   
       my $nt = $node->node_type;  
       if ($nt == 1) {  
         my $node_ns = $node->namespace_uri;  
         $node_ns = '' unless defined $node_ns;  
         my $node_ln = $node->manakai_local_name;  
         ## NOTE: |minuses| list is not checked since redundant  
         if ($node_ns eq $HTML_NS and ($node_ln eq 'td' or $node_ln eq 'th')) {  
           $has_td = 1;  
         } else {  
           $self->{onerror}->(node => $node, type => 'element not allowed');  
         }  
         my ($sib, $ch) = $self->_check_get_children ($node, $todo);  
         unshift @nodes, @$sib;  
         push @$new_todos, @$ch;  
       } elsif ($nt == 3 or $nt == 4) {  
         if ($node->data =~ /[^\x09-\x0D\x20]/) {  
           $self->{onerror}->(node => $node, type => 'character not allowed');  
         }  
       } elsif ($nt == 5) {  
         unshift @nodes, @{$node->child_nodes};  
       }  
     }  
     unless ($has_td) {  
       $self->{onerror}->(node => $el, type => 'child element missing:td|th');  
     }  
     return ($new_todos);  
   },  
 };  
   
 $Element->{$HTML_NS}->{td} = {  
   attrs_checker => $GetHTMLAttrsChecker->({  
     colspan => $GetHTMLNonNegativeIntegerAttrChecker->(sub { shift > 0 }),  
     rowspan => $GetHTMLNonNegativeIntegerAttrChecker->(sub { shift > 0 }),  
   }),  
   checker => $HTMLBlockOrInlineChecker,  
 };  
   
 $Element->{$HTML_NS}->{th} = {  
   attrs_checker => $GetHTMLAttrsChecker->({  
     colspan => $GetHTMLNonNegativeIntegerAttrChecker->(sub { shift > 0 }),  
     rowspan => $GetHTMLNonNegativeIntegerAttrChecker->(sub { shift > 0 }),  
     scope => $GetHTMLEnumeratedAttrChecker  
         ->({row => 1, col => 1, rowgroup => 1, colgroup => 1}),  
   }),  
   checker => $HTMLBlockOrInlineChecker,  
 };  
   
 ## TODO: forms  
   
 $Element->{$HTML_NS}->{script} = {  
   attrs_checker => sub {  
     my ($self, $todo) = @_;  
     $GetHTMLAttrsChecker->({  
       src => $HTMLURIAttrChecker,  
       defer => $GetHTMLBooleanAttrChecker->('defer'),  
       async => $GetHTMLBooleanAttrChecker->('async'),  
       type => $HTMLIMTAttrChecker,  
     })->($self, $todo);  
     if ($todo->{node}->has_attribute_ns (undef, 'defer')) {  
       my $async_attr = $todo->{node}->get_attribute_node_ns (undef, 'async');  
       if ($async_attr) {  
         $self->{onerror}->(node => $async_attr,  
                            type => 'attribute not allowed'); # MUST NOT  
254        }        }
255          $self->_attr_status_info ($attr, $status);
256      }      }
257    },    },
258    checker => sub {    check_child_element => sub {
259      my ($self, $todo) = @_;      my ($self, $item, $child_el, $child_nsuri, $child_ln,
260            $child_is_transparent, $element_state) = @_;
261      if ($todo->{node}->has_attribute_ns (undef, 'src')) {      if ($self->{minus_elements}->{$child_nsuri}->{$child_ln}) {
262        return $HTMLEmptyChecker->($self, $todo);        $self->{onerror}->(node => $child_el,
263                             type => 'element not allowed:minus',
264                             level => $self->{level}->{must});
265        } elsif ($self->{plus_elements}->{$child_nsuri}->{$child_ln}) {
266          #
267      } else {      } else {
268        ## NOTE: No content model conformance in HTML5 spec.        #
       my $type = $todo->{node}->get_attribute_ns (undef, 'type');  
       my $language = $todo->{node}->get_attribute_ns (undef, 'language');  
       if ((defined $type and $type eq '') or  
           (defined $language and $language eq '')) {  
         $type = 'text/javascript';  
       } elsif (defined $type) {  
         #  
       } elsif (defined $language) {  
         $type = 'text/' . $language;  
       } else {  
         $type = 'text/javascript';  
       }  
       $self->{onerror}->(node => $todo->{node}, level => 'unsupported',  
                          type => 'script:'.$type); ## TODO: $type normalization  
       return $AnyChecker->($self, $todo);  
269      }      }
270    },    },
271  };    check_child_text => sub { },
272      check_end => sub {
273  ## NOTE: When script is disabled.      my ($self, $item, $element_state) = @_;
274  $Element->{$HTML_NS}->{noscript} = {      ## NOTE: There is a modified copy of the code below for |html:ruby|.
275    attrs_checker => $GetHTMLAttrsChecker->({}),      if ($element_state->{has_significant}) {
276    checker => sub {        $item->{real_parent_state}->{has_significant} = 1;
277      my ($self, $todo) = @_;      }    
278      },
279      my $end = $self->_add_minuses ({$HTML_NS => {noscript => 1}});  );
280      my ($sib, $ch) = $HTMLBlockOrInlineChecker->($self, $todo);  
281      push @$sib, $end;  our $ElementDefault = {
282      return ($sib, $ch);    %AnyChecker,
283      status => FEATURE_ALLOWED,
284          ## NOTE: No "element not defined" error - it is not supported anyway.
285      check_start => sub {
286        my ($self, $item, $element_state) = @_;
287        $self->{onerror}->(node => $item->{node},
288                           type => 'unknown element',
289                           level => $self->{level}->{uncertain});
290    },    },
291  };  };
 ## TODO: noscript in head  
 ## TODO: noscript in XHTML  
292    
293  $Element->{$HTML_NS}->{'event-source'} = {  our $HTMLEmbeddedContent = {
294    attrs_checker => $GetHTMLAttrsChecker->({    ## NOTE: All embedded content is also phrasing content.
295      src => $HTMLURIAttrChecker,    $HTML_NS => {
296    }),      img => 1, iframe => 1, embed => 1, object => 1, video => 1, audio => 1,
297    checker => $HTMLEmptyChecker,      canvas => 1,
 };  
   
 $Element->{$HTML_NS}->{details} = {  
   attrs_checker => $GetHTMLAttrsChecker->({  
     open => $GetHTMLBooleanAttrChecker->('open'),  
   }),  
   checker => sub {  
     my ($self, $todo) = @_;  
   
     my $end = $self->_add_minuses ({$HTML_NS => {a => 1, datagrid => 1}});  
     my ($sib, $ch)  
       = $GetHTMLZeroOrMoreThenBlockOrInlineChecker->($HTML_NS, 'legend')  
         ->($self, $todo);  
     push @$sib, $end;  
     return ($sib, $ch);  
   },  
 };  
   
 $Element->{$HTML_NS}->{datagrid} = {  
   attrs_checker => $GetHTMLAttrsChecker->({  
     disabled => $GetHTMLBooleanAttrChecker->('disabled'),  
     multiple => $GetHTMLBooleanAttrChecker->('multiple'),  
   }),  
   checker => sub {  
     my ($self, $todo) = @_;  
     my $el = $todo->{node};  
     my $new_todos = [];  
     my @nodes = (@{$el->child_nodes});  
   
     my $end = $self->_add_minuses ({$HTML_NS => {a => 1, datagrid => 1}});  
       
     ## Block-table Block* | table | select | datalist | Empty  
     my $mode = 'any';  
     while (@nodes) {  
       my $node = shift @nodes;  
       $self->_remove_minuses ($node) and next if ref $node eq 'HASH';  
         
       my $nt = $node->node_type;  
       if ($nt == 1) {  
         my $node_ns = $node->namespace_uri;  
         $node_ns = '' unless defined $node_ns;  
         my $node_ln = $node->manakai_local_name;  
         my $not_allowed = $self->{minuses}->{$node_ns}->{$node_ln};  
         if ($mode eq 'block') {  
           $not_allowed = 1  
               unless $HTMLBlockLevelElements->{$node_ns}->{$node_ln};  
         } elsif ($mode eq 'any') {  
           if ($node_ns eq $HTML_NS and  
               {table => 1, select => 1, datalist => 1}->{$node_ln}) {  
             $mode = 'none';  
           } elsif ($HTMLBlockLevelElements->{$node_ns}->{$node_ln}) {  
             $mode = 'block';  
           } else {  
             $not_allowed = 1;  
           }  
         } else {  
           $not_allowed = 1;  
         }  
         $self->{onerror}->(node => $node, type => 'element not allowed')  
             if $not_allowed;  
         my ($sib, $ch) = $self->_check_get_children ($node, $todo);  
         unshift @nodes, @$sib;  
         push @$new_todos, @$ch;  
       } elsif ($nt == 3 or $nt == 4) {  
         if ($node->data =~ /[^\x09-\x0D\x20]/) {  
           $self->{onerror}->(node => $node, type => 'character not allowed');  
         }  
       } elsif ($nt == 5) {  
         unshift @nodes, @{$node->child_nodes};  
       }  
     }  
   
     push @$new_todos, $end;  
     return ($new_todos);  
298    },    },
299  };    q<http://www.w3.org/1998/Math/MathML> => {math => 1},
300      q<http://www.w3.org/2000/svg> => {svg => 1},
301  $Element->{$HTML_NS}->{command} = {    ## NOTE: Foreign elements with content (but no metadata) are
302    attrs_checker => $GetHTMLAttrsChecker->({    ## embedded content.
303      checked => $GetHTMLBooleanAttrChecker->('checked'),  };  
304      default => $GetHTMLBooleanAttrChecker->('default'),  
305      disabled => $GetHTMLBooleanAttrChecker->('disabled'),  our $IsInHTMLInteractiveContent = sub {
306      hidden => $GetHTMLBooleanAttrChecker->('hidden'),    my ($el, $nsuri, $ln) = @_;
307      icon => $HTMLURIAttrChecker,  
308      label => sub { }, ## NOTE: No conformance creteria    ## NOTE: This CODE returns whether an element that is conditionally
309      radiogroup => sub { }, ## NOTE: No conformance creteria    ## categorizzed as an interactive content is currently in that
310      ## NOTE: |title| has special semantics, but no syntactical difference    ## condition or not.  See $HTMLInteractiveContent list defined in
311      type => sub {    ## Whatpm::ContentChecler::HTML for the list of all (conditionally
312        my ($self, $attr) = @_;    ## or permanently) interactive content.
313        my $value = $attr->value;  
314        unless ({command => 1, checkbox => 1, radio => 1}->{$value}) {    if ($nsuri eq $HTML_NS and ($ln eq 'video' or $ln eq 'audio')) {
315          $self->{onerror}->(node => $attr, type => 'attribute value not allowed');      return $el->has_attribute ('controls');
316        }    } elsif ($nsuri eq $HTML_NS and $ln eq 'menu') {
317      },      my $value = $el->get_attribute ('type');
318    }),      $value =~ tr/A-Z/a-z/; # ASCII case-insensitive
319    checker => $HTMLEmptyChecker,      return ($value eq 'toolbar');
320  };    } else {
321        return 1;
322  $Element->{$HTML_NS}->{menu} = {    }
323    attrs_checker => $GetHTMLAttrsChecker->({  }; # $IsInHTMLInteractiveContent
     autosubmit => $GetHTMLBooleanAttrChecker->('autosubmit'),  
     id => sub {  
       ## NOTE: same as global |id=""|, with |$self->{menu}| registeration  
       my ($self, $attr) = @_;  
       my $value = $attr->value;  
       if (length $value > 0) {  
         if ($self->{id}->{$value}) {  
           $self->{onerror}->(node => $attr, type => 'duplicate ID');  
         } else {  
           $self->{id}->{$value} = 1;  
         }  
       } else {  
         ## NOTE: MUST contain at least one character  
         $self->{onerror}->(node => $attr, type => 'empty attribute value');  
       }  
       if ($value =~ /[\x09-\x0D\x20]/) {  
         $self->{onerror}->(node => $attr, type => 'space in ID');  
       }  
       $self->{menu}->{$value} ||= $attr;  
       ## ISSUE: <menu id=""><p contextmenu=""> match?  
     },  
     label => sub { }, ## NOTE: No conformance creteria  
     type => $GetHTMLEnumeratedAttrChecker->({context => 1, toolbar => 1}),  
   }),  
   checker => sub {  
     my ($self, $todo) = @_;  
     my $el = $todo->{node};  
     my $new_todos = [];  
     my @nodes = (@{$el->child_nodes});  
       
     my $content = 'li or inline';  
     while (@nodes) {  
       my $node = shift @nodes;  
       $self->_remove_minuses ($node) and next if ref $node eq 'HASH';  
   
       my $nt = $node->node_type;  
       if ($nt == 1) {  
         my $node_ns = $node->namespace_uri;  
         $node_ns = '' unless defined $node_ns;  
         my $node_ln = $node->manakai_local_name;  
         my $not_allowed = $self->{minuses}->{$node_ns}->{$node_ln};  
         if ($node_ns eq $HTML_NS and $node_ln eq 'li') {  
           if ($content eq 'inline') {  
             $not_allowed = 1;  
           } elsif ($content eq 'li or inline') {  
             $content = 'li';  
           }  
         } else {  
           if ($HTMLStrictlyInlineLevelElements->{$node_ns}->{$node_ln} or  
               $HTMLStructuredInlineLevelElements->{$node_ns}->{$node_ln}) {  
             $content = 'inline';  
           } else {  
             $not_allowed = 1;  
           }  
         }  
         $self->{onerror}->(node => $node, type => 'element not allowed')  
           if $not_allowed;  
         my ($sib, $ch) = $self->_check_get_children ($node, $todo);  
         unshift @nodes, @$sib;  
         push @$new_todos, @$ch;  
       } elsif ($nt == 3 or $nt == 4) {  
         if ($node->data =~ /[^\x09-\x0D\x20]/) {  
           if ($content eq 'li') {  
             $self->{onerror}->(node => $node, type => 'character not allowed');  
           } elsif ($content eq 'li or inline') {  
             $content = 'inline';  
           }  
         }  
       } elsif ($nt == 5) {  
         unshift @nodes, @{$node->child_nodes};  
       }  
     }  
324    
325      for (@$new_todos) {  my $HTMLTransparentElements = {
326        $_->{inline} = 1;    $HTML_NS => {qw/ins 1 del 1 font 1 noscript 1 canvas 1 a 1/},
327      }    ## NOTE: |html:noscript| is transparent if scripting is disabled
328      return ($new_todos);    ## and not in |head|.
   },  
329  };  };
330    
331  $Element->{$HTML_NS}->{legend} = {  my $HTMLSemiTransparentElements = {
332    attrs_checker => $GetHTMLAttrsChecker->({}),    $HTML_NS => {object => 1, video => 1, audio => 1},
   checker => sub {  
     my ($self, $todo) = @_;  
   
     my $parent = $todo->{node}->manakai_parent_element;  
     if (defined $parent) {  
       my $nsuri = $parent->namespace_uri;  
       $nsuri = '' unless defined $nsuri;  
       my $ln = $parent->manakai_local_name;  
       if ($nsuri eq $HTML_NS and $ln eq 'figure') {  
         return $HTMLInlineChecker->($self, $todo);  
       } else {  
         return $HTMLSignificantStrictlyInlineChecker->($self, $todo);  
       }  
     } else {  
       return $HTMLInlineChecker->($self, $todo);  
     }  
   
     ## ISSUE: Content model is defined only for fieldset/legend,  
     ## details/legend, and figure/legend.  
   },  
333  };  };
334    
335  $Element->{$HTML_NS}->{div} = {  our $Element = {};
   attrs_checker => $GetHTMLAttrsChecker->({}),  
   checker => $GetHTMLZeroOrMoreThenBlockOrInlineChecker->($HTML_NS, 'style'),  
 };  
336    
337  $Element->{$HTML_NS}->{font} = {  $Element->{q<http://www.w3.org/1999/02/22-rdf-syntax-ns#>}->{RDF} = {
338    attrs_checker => $GetHTMLAttrsChecker->({}), ## TODO    %AnyChecker,
339    checker => $HTMLTransparentChecker,    status => FEATURE_STATUS_REC | FEATURE_ALLOWED,
340      is_root => 1, ## ISSUE: Not explicitly allowed for non application/rdf+xml
341      check_start => sub {
342        my ($self, $item, $element_state) = @_;
343        my $triple = [];
344        push @{$self->{return}->{rdf}}, [$item->{node}, $triple];
345        require Whatpm::RDFXML;
346        my $rdf = Whatpm::RDFXML->new;
347        ## TODO: Should we make bnodeid unique in a document?
348        $rdf->{onerror} = $self->{onerror};
349        $rdf->{level} = $self->{level};
350        $rdf->{ontriple} = sub {
351          my %opt = @_;
352          push @$triple,
353              [$opt{node}, $opt{subject}, $opt{predicate}, $opt{object}];
354          if (defined $opt{id}) {
355            push @$triple,
356                [$opt{node},
357                 $opt{id},
358                 {uri => q<http://www.w3.org/1999/02/22-rdf-syntax-ns#subject>},
359                 $opt{subject}];
360            push @$triple,
361                [$opt{node},
362                 $opt{id},
363                 {uri => q<http://www.w3.org/1999/02/22-rdf-syntax-ns#predicate>},
364                 $opt{predicate}];
365            push @$triple,
366                [$opt{node},
367                 $opt{id},
368                 {uri => q<http://www.w3.org/1999/02/22-rdf-syntax-ns#object>},
369                 $opt{object}];
370            push @$triple,
371                [$opt{node},
372                 $opt{id},
373                 {uri => q<http://www.w3.org/1999/02/22-rdf-syntax-ns#type>},
374                 {uri => q<http://www.w3.org/1999/02/22-rdf-syntax-ns#Statement>}];
375          }
376        };
377        $rdf->convert_rdf_element ($item->{node});
378      },
379    };
380    
381    my $default_error_level = {
382      must => 'm',
383      should => 's',
384      warn => 'w',
385      good => 'w',
386      undefined => 'w',
387      info => 'i',
388    
389      uncertain => 'u',
390    
391      html4_fact => 'm',
392      html5_no_may => 'm',
393    
394      xml_error => 'm', ## TODO: correct?
395      xml_id_error => 'm', ## TODO: ?
396      nc => 'm', ## XML Namespace Constraints ## TODO: correct?
397    
398      ## |Whatpm::URIChecker|
399      uri_syntax => 'm',
400      uri_fact => 'm',
401      uri_lc_must => 'm',
402      uri_lc_should => 'w',
403    
404      ## |Whatpm::IMTChecker|
405      mime_must => 'm', # lowercase "must"
406      mime_fact => 'm',
407      mime_strongly_discouraged => 'w',
408      mime_discouraged => 'w',
409    
410      ## |Whatpm::LangTag|
411      langtag_fact => 'm',
412    
413      ## |Whatpm::RDFXML|
414      rdf_fact => 'm',
415      rdf_grammer => 'm',
416      rdf_lc_must => 'm',
417    
418      ## |Message::Charset::Info| and |Whatpm::Charset::DecodeHandle|
419      charset_variant => 'm',
420        ## An error caused by use of a variant charset that is not conforming
421        ## to the original charset (e.g. use of 0x80 in an ISO-8859-1 document
422        ## which is interpreted as a Windows-1252 document instead).
423      charset_fact => 'm',
424      iso_shall => 'm',
425  };  };
426    
427  sub check_document ($$$) {  sub check_document ($$$;$) {
428    my ($self, $doc, $onerror) = @_;    my ($self, $doc, $onerror, $onsubdoc) = @_;
429    $self = bless {}, $self unless ref $self;    $self = bless {}, $self unless ref $self;
430    $self->{onerror} = $onerror;    $self->{onerror} = $onerror;
431      $self->{onsubdoc} = $onsubdoc || sub {
432        warn "A subdocument is not conformance-checked";
433      };
434    
435      $self->{level} ||= $default_error_level;
436    
437      ## TODO: If application/rdf+xml, RDF/XML mode should be invoked.
438    
439    my $docel = $doc->document_element;    my $docel = $doc->document_element;
440    unless (defined $docel) {    unless (defined $docel) {
441      ## ISSUE: Should we check content of Document node?      ## ISSUE: Should we check content of Document node?
442      $onerror->(node => $doc, type => 'no document element');      $onerror->(node => $doc, type => 'no document element',
443                   level => $self->{level}->{must});
444      ## ISSUE: Is this non-conforming (to what spec)?  Or just a warning?      ## ISSUE: Is this non-conforming (to what spec)?  Or just a warning?
445      return;      return {
446                class => {},
447                id => {}, table => [], term => {},
448               };
449    }    }
450    
451    ## ISSUE: Unexpanded entity references and HTML5 conformance    ## ISSUE: Unexpanded entity references and HTML5 conformance
452        
453    my $docel_nsuri = $docel->namespace_uri;    my $docel_nsuri = $docel->namespace_uri;
454    $docel_nsuri = '' unless defined $docel_nsuri;    if (defined $docel_nsuri) {
455        load_ns_module ($docel_nsuri);
456      } else {
457        $docel_nsuri = '';
458      }
459    my $docel_def = $Element->{$docel_nsuri}->{$docel->manakai_local_name} ||    my $docel_def = $Element->{$docel_nsuri}->{$docel->manakai_local_name} ||
460      $Element->{$docel_nsuri}->{''} ||      $Element->{$docel_nsuri}->{''} ||
461      $ElementDefault;      $ElementDefault;
462    if ($docel_def->{is_root}) {    if ($docel_def->{is_root}) {
463      #      #
464      } elsif ($docel_def->{is_xml_root}) {
465        unless ($doc->manakai_is_html) {
466          #
467        } else {
468          $onerror->(node => $docel, type => 'element not allowed:root:xml',
469                     level => $self->{level}->{must});
470        }
471    } else {    } else {
472      $onerror->(node => $docel, type => 'element not allowed');      $onerror->(node => $docel, type => 'element not allowed:root',
473                   level => $self->{level}->{must});
474    }    }
475    
476    ## TODO: Check for other items other than document element    ## TODO: Check for other items other than document element
477    ## (second (errorous) element, text nodes, PI nodes, doctype nodes)    ## (second (errorous) element, text nodes, PI nodes, doctype nodes)
478    
479    return $self->check_element ($docel, $onerror);    my $return = $self->check_element ($docel, $onerror, $onsubdoc);
480    
481      ## TODO: Test for these checks are necessary.
482      my $charset_name = $doc->input_encoding;
483      if (defined $charset_name) {
484        require Message::Charset::Info;
485        my $charset = $Message::Charset::Info::IANACharset->{$charset_name};
486    
487        if ($doc->manakai_is_html) {
488          if (not $doc->manakai_has_bom and
489              not defined $doc->manakai_charset) {
490            unless ($charset->{is_html_ascii_superset}) {
491              $onerror->(node => $doc,
492                         level => $self->{level}->{must},
493                         type => 'non ascii superset',
494                         text => $charset_name);
495            }
496            
497            if (not $self->{has_charset} and ## TODO: This does not work now.
498                not $charset->{iana_names}->{'us-ascii'}) {
499              $onerror->(node => $doc,
500                         level => $self->{level}->{must},
501                         type => 'no character encoding declaration',
502                         text => $charset_name);
503            }
504          }
505    
506          if ($charset->{iana_names}->{'utf-8'}) {
507            #
508          } elsif ($charset->{iana_names}->{'jis_x0212-1990'} or
509                   $charset->{iana_names}->{'x-jis0208'} or
510                   $charset->{iana_names}->{'utf-32'} or ## ISSUE: UTF-32BE? UTF-32LE?
511                   ($charset->{category} & Message::Charset::Info::CHARSET_CATEGORY_EBCDIC ())) {
512            $onerror->(node => $doc,
513                       type => 'bad character encoding',
514                       text => $charset_name,
515                       level => $self->{level}->{should},
516                       layer => 'encode');
517          } elsif ($charset->{iana_names}->{'cesu-8'} or
518                   $charset->{iana_names}->{'utf-8'} or ## ISSUE: UNICODE-1-1-UTF-7?
519                   $charset->{iana_names}->{'bocu-1'} or
520                   $charset->{iana_names}->{'scsu'}) {
521            $onerror->(node => $doc,
522                       type => 'disallowed character encoding',
523                       text => $charset_name,
524                       level => $self->{level}->{must},
525                       layer => 'encode');
526          } else {
527            $onerror->(node => $doc,
528                       type => 'non-utf-8 character encoding',
529                       text => $charset_name,
530                       level => $self->{level}->{good},
531                       layer => 'encode');
532          }
533        }
534      } elsif ($doc->manakai_is_html) {
535        ## NOTE: MUST and SHOULD requirements above cannot be tested,
536        ## since the document has no input charset encoding information.
537        $onerror->(node => $doc,
538                   type => 'character encoding unchecked',
539                   level => $self->{level}->{info},
540                   layer => 'encode');
541      }
542    
543      return $return;
544  } # check_document  } # check_document
545    
546  sub check_element ($$$) {  ## Check an element.  The element is checked as if it is an orphan node (i.e.
547    my ($self, $el, $onerror) = @_;  ## an element without a parent node).
548    sub check_element ($$$;$) {
549      my ($self, $el, $onerror, $onsubdoc) = @_;
550    $self = bless {}, $self unless ref $self;    $self = bless {}, $self unless ref $self;
551    $self->{onerror} = $onerror;    $self->{onerror} = $onerror;
552      $self->{onsubdoc} = $onsubdoc || sub {
553        warn "A subdocument is not conformance-checked";
554      };
555    
556    $self->{minuses} = {};    $self->{level} ||= $default_error_level;
557    
558      $self->{plus_elements} = {};
559      $self->{minus_elements} = {};
560    $self->{id} = {};    $self->{id} = {};
561      $self->{form} = {};
562    $self->{term} = {};    $self->{term} = {};
563    $self->{usemap} = [];    $self->{usemap} = [];
564      $self->{ref} = []; # datetemplate data references
565      $self->{template} = []; # datatemplate template references
566    $self->{contextmenu} = [];    $self->{contextmenu} = [];
567    $self->{map} = {};    $self->{map} = {};
568    $self->{menu} = {};    $self->{menu} = {};
569    $self->{has_link_type} = {};    $self->{has_link_type} = {};
570      $self->{flag} = {};
571      #$self->{has_uri_attr};
572      #$self->{has_hyperlink_element};
573      #$self->{has_charset};
574      #$self->{has_base};
575    $self->{return} = {    $self->{return} = {
576      table => [], term => $self->{term},      class => {},
577        id => $self->{id},
578        table => [], # table objects returned by Whatpm::HTMLTable
579        term => $self->{term},
580        uri => {}, # URIs other than those in RDF triples
581                         ## TODO: xmlns="", SYSTEM "", atom:* src="", xml:base=""
582        rdf => [],
583    };    };
584    
585    my @todo = ({type => 'element', node => $el});    my @item = ({type => 'element', node => $el, parent_state => {}});
586    while (@todo) {    $item[-1]->{real_parent_state} = $item[-1]->{parent_state};
587      my $todo = shift @todo;    while (@item) {
588      if ($todo->{type} eq 'element') {      my $item = shift @item;
589        my $prefix = $todo->{node}->prefix;      if (ref $item eq 'ARRAY') {
590        if (defined $prefix and $prefix eq 'xmlns') {        my $code = shift @$item;
591          $self->{onerror}  next unless $code;## TODO: temp.
592            ->(node => $todo->{node}, level => 'NC',        $code->(@$item);
593               type => 'Reserved Prefixes and Namespace Names:<xmlns:>');      } elsif ($item->{type} eq 'element') {
594          my $el_nsuri = $item->{node}->namespace_uri;
595          if (defined $el_nsuri) {
596            load_ns_module ($el_nsuri);
597          } else {
598            $el_nsuri = '';
599        }        }
600        my $nsuri = $todo->{node}->namespace_uri;        my $el_ln = $item->{node}->manakai_local_name;
601        $nsuri = '' unless defined $nsuri;        
602        my $ln = $todo->{node}->manakai_local_name;        my $element_state = {};
603        my $eldef = $Element->{$nsuri}->{$ln} ||        my $eldef = $Element->{$el_nsuri}->{$el_ln} ||
604          $Element->{$nsuri}->{''} ||            $Element->{$el_nsuri}->{''} ||
605            $ElementDefault;            $ElementDefault;
606        $eldef->{attrs_checker}->($self, $todo);        my $content_def = $item->{transparent}
607        my ($new_todos) = $eldef->{checker}->($self, $todo);            ? $item->{parent_def} || $eldef : $eldef;
608        unshift @todo, @$new_todos;        my $content_state = $item->{transparent}
609      } elsif ($todo->{type} eq 'element-attributes') {            ? $item->{parent_def}
610        my $prefix = $todo->{node}->prefix;                ? $item->{parent_state} || $element_state : $element_state
611        if (defined $prefix and $prefix eq 'xmlns') {            : $element_state;
612          $self->{onerror}  
613            ->(node => $todo->{node}, level => 'NC',        unless ($eldef->{status} & FEATURE_STATUS_REC) {
614               type => 'Reserved Prefixes and Namespace Names:<xmlns:>');          my $status = $eldef->{status} & FEATURE_STATUS_CR ? 'cr' :
615                $eldef->{status} & FEATURE_STATUS_LC ? 'lc' :
616                $eldef->{status} & FEATURE_STATUS_WD ? 'wd' : 'non-standard';
617            $self->{onerror}->(node => $item->{node},
618                               type => 'status:'.$status.':element',
619                               level => $self->{level}->{info});
620          }
621          if (not ($eldef->{status} & FEATURE_ALLOWED)) {
622            $self->{onerror}->(node => $item->{node},
623                               type => 'element not defined',
624                               level => $self->{level}->{must});
625          } elsif ($eldef->{status} & FEATURE_DEPRECATED_SHOULD) {
626            $self->{onerror}->(node => $item->{node},
627                               type => 'deprecated:element',
628                               level => $self->{level}->{should});
629          } elsif ($eldef->{status} & FEATURE_DEPRECATED_INFO) {
630            $self->{onerror}->(node => $item->{node},
631                               type => 'deprecated:element',
632                               level => $self->{level}->{info});
633          }
634    
635          my @new_item;
636          push @new_item, [$eldef->{check_start}, $self, $item, $element_state];
637          push @new_item, [$eldef->{check_attrs}, $self, $item, $element_state];
638          
639          my @child = @{$item->{node}->child_nodes};
640          while (@child) {
641            my $child = shift @child;
642            my $child_nt = $child->node_type;
643            if ($child_nt == 1) { # ELEMENT_NODE
644              my $child_nsuri = $child->namespace_uri;
645              $child_nsuri = '' unless defined $child_nsuri;
646              my $child_ln = $child->manakai_local_name;
647              if ($HTMLTransparentElements->{$child_nsuri}->{$child_ln} and
648                  not (($self->{flag}->{in_head} or
649                        ($el_nsuri eq $HTML_NS and $el_ln eq 'head')) and
650                       $child_nsuri eq $HTML_NS and $child_ln eq 'noscript')) {
651                push @new_item, [$content_def->{check_child_element},
652                                 $self, $item, $child,
653                                 $child_nsuri, $child_ln, 1,
654                                 $content_state, $element_state];
655                push @new_item, {type => 'element', node => $child,
656                                 parent_state => $content_state,
657                                 parent_def => $content_def,
658                                 real_parent_state => $element_state,
659                                 transparent => 1};
660              } else {
661                if ($item->{parent_def} and # has parent
662                    $el_nsuri eq $HTML_NS) { ## $HTMLSemiTransparentElements
663                  if ($el_ln eq 'object') {
664                    if ($self->{plus_elements}->{$child_nsuri}->{$child_ln}) {
665                      #
666                    } elsif ($child_nsuri eq $HTML_NS and $child_ln eq 'param') {
667                      #
668                    } else {
669                      $content_def = $item->{parent_def} || $content_def;
670                      $content_state = $item->{parent_state} || $content_state;
671                    }
672                  } elsif ($el_ln eq 'video' or $el_ln eq 'audio') {
673                    if ($self->{plus_elements}->{$child_nsuri}->{$child_ln}) {
674                      #
675                    } elsif ($child_nsuri eq $HTML_NS and $child_ln eq 'source') {
676                      $element_state->{has_source} = 1;
677                    } else {
678                      $content_def = $item->{parent_def} || $content_def;
679                      $content_state = $item->{parent_state} || $content_state;
680                    }
681                  }
682                }
683    
684                push @new_item, [$content_def->{check_child_element},
685                                 $self, $item, $child,
686                                 $child_nsuri, $child_ln,
687                                 $HTMLSemiTransparentElements
688                                     ->{$child_nsuri}->{$child_ln},
689                                 $content_state, $element_state];
690                push @new_item, {type => 'element', node => $child,
691                                 parent_def => $content_def,
692                                 real_parent_state => $element_state,
693                                 parent_state => $content_state};
694              }
695    
696              if ($HTMLEmbeddedContent->{$child_nsuri}->{$child_ln}) {
697                $element_state->{has_significant} = 1;
698              }
699            } elsif ($child_nt == 3 or # TEXT_NODE
700                     $child_nt == 4) { # CDATA_SECTION_NODE
701              my $has_significant = ($child->data =~ /[^\x09\x0A\x0C\x0D\x20]/);
702              push @new_item, [$content_def->{check_child_text},
703                               $self, $item, $child, $has_significant,
704                               $content_state, $element_state];
705              $element_state->{has_significant} ||= $has_significant;
706              if ($has_significant and
707                  $HTMLSemiTransparentElements->{$el_nsuri}->{$el_ln}) {
708                $content_def = $item->{parent_def} || $content_def;
709              }
710            } elsif ($child_nt == 5) { # ENTITY_REFERENCE_NODE
711              push @child, @{$child->child_nodes};
712            }
713            ## TODO: PI_NODE
714            ## TODO: Unknown node type
715          }
716          
717          push @new_item, [$eldef->{check_end}, $self, $item, $element_state];
718          
719          unshift @item, @new_item;
720        } else {
721          die "$0: Internal error: Unsupported checking action type |$item->{type}|";
722        }
723      }
724    
725      for (@{$self->{template}}) {
726        ## TODO: If the document is an XML document, ...
727        ## NOTE: If the document is an HTML document:
728        ## ISSUE: We need to percent-decode?
729        F: {
730          if ($self->{id}->{$_->[0]}) {
731            my $el = $self->{id}->{$_->[0]}->[0]->owner_element;
732            if ($el->node_type == 1 and # ELEMENT_NODE
733                $el->manakai_local_name eq 'datatemplate') {
734              my $nsuri = $el->namespace_uri;
735              if (defined $nsuri and $nsuri eq $HTML_NS) {
736                if ($el eq $_->[1]->owner_element) {
737                  $self->{onerror}->(node => $_->[1],
738                                     type => 'fragment points itself',
739                                     level => $self->{level}->{must});
740                }
741                
742                last F;
743              }
744            }
745          }
746          ## TODO: Should we raise a "fragment points nothing" error instead
747          ## if the fragment identifier identifies no element?
748    
749          $self->{onerror}->(node => $_->[1], type => 'template:not template',
750                             level => $self->{level}->{must});
751        } # F
752      }
753      
754      for (@{$self->{ref}}) {
755        ## TOOD: If XML
756        ## NOTE: If it is an HTML document:
757        if ($_->[0] eq '') {
758          ## NOTE: It points the top of the document.
759        } elsif ($self->{id}->{$_->[0]}) {
760          if ($self->{id}->{$_->[0]}->[0]->owner_element
761                  eq $_->[1]->owner_element) {
762            $self->{onerror}->(node => $_->[1], type => 'fragment points itself',
763                               level => $self->{level}->{must});
764        }        }
       my $nsuri = $todo->{node}->namespace_uri;  
       $nsuri = '' unless defined $nsuri;  
       my $ln = $todo->{node}->manakai_local_name;  
       my $eldef = $Element->{$nsuri}->{$ln} ||  
         $Element->{$nsuri}->{''} ||  
           $ElementDefault;  
       $eldef->{attrs_checker}->($self, $todo);  
     } elsif ($todo->{type} eq 'plus') {  
       $self->_remove_minuses ($todo);  
     } elsif ($todo->{type} eq 'code') {  
       $todo->{code}->();  
765      } else {      } else {
766        die "$0: Internal error: Unsupported checking action type |$todo->{type}|";        $self->{onerror}->(node => $_->[1], type => 'fragment points nothing',
767                             level => $self->{level}->{must});
768      }      }
769    }    }
770    
771      ## TODO: Maybe we should have $document->manakai_get_by_fragment or something
772    
773    for (@{$self->{usemap}}) {    for (@{$self->{usemap}}) {
774      unless ($self->{map}->{$_->[0]}) {      unless ($self->{map}->{$_->[0]}) {
775        $self->{onerror}->(node => $_->[1], type => 'no referenced map');        $self->{onerror}->(node => $_->[1], type => 'no referenced map',
776                             level => $self->{level}->{must});
777      }      }
778    }    }
779    
780    for (@{$self->{contextmenu}}) {    for (@{$self->{contextmenu}}) {
781      unless ($self->{menu}->{$_->[0]}) {      unless ($self->{menu}->{$_->[0]}) {
782        $self->{onerror}->(node => $_->[1], type => 'no referenced menu');        $self->{onerror}->(node => $_->[1], type => 'no referenced menu',
783                             level => $self->{level}->{must});
784      }      }
785    }    }
786    
787    delete $self->{minuses};    delete $self->{plus_elements};
788      delete $self->{minus_elements};
789    delete $self->{onerror};    delete $self->{onerror};
790    delete $self->{id};    delete $self->{id};
791      delete $self->{form};
792    delete $self->{usemap};    delete $self->{usemap};
793      delete $self->{ref};
794      delete $self->{template};
795    delete $self->{map};    delete $self->{map};
796    return $self->{return};    return $self->{return};
797  } # check_element  } # check_element
798    
799    sub _add_minus_elements ($$@) {
800      my $self = shift;
801      my $element_state = shift;
802      for my $elements (@_) {
803        for my $nsuri (keys %$elements) {
804          for my $ln (keys %{$elements->{$nsuri}}) {
805            unless ($self->{minus_elements}->{$nsuri}->{$ln}) {
806              $element_state->{minus_elements_original}->{$nsuri}->{$ln} = 0;
807              $self->{minus_elements}->{$nsuri}->{$ln} = 1;
808            }
809          }
810        }
811      }
812    } # _add_minus_elements
813    
814    sub _remove_minus_elements ($$) {
815      my $self = shift;
816      my $element_state = shift;
817      for my $nsuri (keys %{$element_state->{minus_elements_original}}) {
818        for my $ln (keys %{$element_state->{minus_elements_original}->{$nsuri}}) {
819          delete $self->{minus_elements}->{$nsuri}->{$ln};
820        }
821      }
822    } # _remove_minus_elements
823    
824    sub _add_plus_elements ($$@) {
825      my $self = shift;
826      my $element_state = shift;
827      for my $elements (@_) {
828        for my $nsuri (keys %$elements) {
829          for my $ln (keys %{$elements->{$nsuri}}) {
830            unless ($self->{plus_elements}->{$nsuri}->{$ln}) {
831              $element_state->{plus_elements_original}->{$nsuri}->{$ln} = 0;
832              $self->{plus_elements}->{$nsuri}->{$ln} = 1;
833            }
834          }
835        }
836      }
837    } # _add_plus_elements
838    
839    sub _remove_plus_elements ($$) {
840      my $self = shift;
841      my $element_state = shift;
842      for my $nsuri (keys %{$element_state->{plus_elements_original}}) {
843        for my $ln (keys %{$element_state->{plus_elements_original}->{$nsuri}}) {
844          delete $self->{plus_elements}->{$nsuri}->{$ln};
845        }
846      }
847    } # _remove_plus_elements
848    
849    sub _attr_status_info ($$$) {
850      my ($self, $attr, $status_code) = @_;
851    
852      if (not ($status_code & FEATURE_ALLOWED)) {
853        $self->{onerror}->(node => $attr,
854                           type => 'attribute not defined',
855                           level => $self->{level}->{must});
856      } elsif ($status_code & FEATURE_DEPRECATED_SHOULD) {
857        $self->{onerror}->(node => $attr,
858                           type => 'deprecated:attr',
859                           level => $self->{level}->{should});
860      } elsif ($status_code & FEATURE_DEPRECATED_INFO) {
861        $self->{onerror}->(node => $attr,
862                           type => 'deprecated:attr',
863                           level => $self->{level}->{info});
864      }
865    
866      my $status;
867      if ($status_code & FEATURE_STATUS_REC) {
868        return;
869      } elsif ($status_code & FEATURE_STATUS_CR) {
870        $status = 'cr';
871      } elsif ($status_code & FEATURE_STATUS_LC) {
872        $status = 'lc';
873      } elsif ($status_code & FEATURE_STATUS_WD) {
874        $status = 'wd';
875      } else {
876        $status = 'non-standard';
877      }
878      $self->{onerror}->(node => $attr,
879                         type => 'status:'.$status.':attr',
880                         level => $self->{level}->{info});
881    } # _attr_status_info
882    
883  sub _add_minuses ($@) {  sub _add_minuses ($@) {
884    my $self = shift;    my $self = shift;
885    my $r = {};    my $r = {};
# Line 3070  sub _add_minuses ($@) { Line 896  sub _add_minuses ($@) {
896    return {type => 'plus', list => $r};    return {type => 'plus', list => $r};
897  } # _add_minuses  } # _add_minuses
898    
899    sub _add_pluses ($@) {
900      my $self = shift;
901      my $r = {};
902      for my $list (@_) {
903        for my $ns (keys %$list) {
904          for my $ln (keys %{$list->{$ns}}) {
905            unless ($self->{pluses}->{$ns}->{$ln}) {
906              $self->{pluses}->{$ns}->{$ln} = 1;
907              $r->{$ns}->{$ln} = 1;
908            }
909          }
910        }
911      }
912      return {type => 'minus', list => $r};
913    } # _add_pluses
914    
915  sub _remove_minuses ($$) {  sub _remove_minuses ($$) {
916    my ($self, $todo) = @_;    my ($self, $todo) = @_;
917    for my $ns (keys %{$todo->{list}}) {    if ($todo->{type} eq 'minus') {
918      for my $ln (keys %{$todo->{list}->{$ns}}) {      for my $ns (keys %{$todo->{list}}) {
919        delete $self->{minuses}->{$ns}->{$ln} if $todo->{list}->{$ns}->{$ln};        for my $ln (keys %{$todo->{list}->{$ns}}) {
920            delete $self->{pluses}->{$ns}->{$ln} if $todo->{list}->{$ns}->{$ln};
921          }
922        }
923      } elsif ($todo->{type} eq 'plus') {
924        for my $ns (keys %{$todo->{list}}) {
925          for my $ln (keys %{$todo->{list}->{$ns}}) {
926            delete $self->{minuses}->{$ns}->{$ln} if $todo->{list}->{$ns}->{$ln};
927          }
928      }      }
929      } else {
930        die "$0: Unknown +- type: $todo->{type}";
931    }    }
932    1;    1;
933  } # _remove_minuses  } # _remove_minuses
934    
935    ## NOTE: Priority for "minuses" and "pluses" are currently left
936    ## undefined and implemented inconsistently; it is not a problem for
937    ## now, since no element belongs to both lists.
938    
939  sub _check_get_children ($$$) {  sub _check_get_children ($$$) {
940    my ($self, $node, $parent_todo) = @_;    my ($self, $node, $parent_todo) = @_;
941    my $new_todos = [];    my $new_todos = [];
# Line 3088  sub _check_get_children ($$$) { Line 944  sub _check_get_children ($$$) {
944      my $node_ns = $node->namespace_uri;      my $node_ns = $node->namespace_uri;
945      $node_ns = '' unless defined $node_ns;      $node_ns = '' unless defined $node_ns;
946      my $node_ln = $node->manakai_local_name;      my $node_ln = $node->manakai_local_name;
     if ($node_ns eq $HTML_NS) {  
       if ($node_ln eq 'noscript') {  
         my $end = $self->_add_minuses ({$HTML_NS, {noscript => 1}});  
         push @$sib, $end;  
       }  
     }  
     ## TODO: |noscript| is not a transparent element in |head|.  
947      if ($HTMLTransparentElements->{$node_ns}->{$node_ln}) {      if ($HTMLTransparentElements->{$node_ns}->{$node_ln}) {
948        unshift @$sib, @{$node->child_nodes};        if ($node_ns eq $HTML_NS and $node_ln eq 'noscript') {
949        push @$new_todos, {type => 'element-attributes', node => $node};          if ($parent_todo->{flag}->{in_head}) {
950        last TP;            #
951            } else {
952              my $end = $self->_add_minuses ({$HTML_NS, {noscript => 1}});
953              push @$sib, $end;
954              
955              unshift @$sib, @{$node->child_nodes};
956              push @$new_todos, {type => 'element-attributes', node => $node};
957              last TP;
958            }
959          } elsif ($node_ns eq $HTML_NS and $node_ln eq 'del') {
960            my $sig_flag = $parent_todo->{flag}->{has_descendant}->{significant};
961            unshift @$sib, @{$node->child_nodes};
962            push @$new_todos, {type => 'element-attributes', node => $node};
963            push @$new_todos,
964                {type => 'code',
965                 code => sub {
966                   $parent_todo->{flag}->{has_descendant}->{significant} = 0
967                       if not $sig_flag;
968                 }};
969            last TP;
970          } else {
971            unshift @$sib, @{$node->child_nodes};
972            push @$new_todos, {type => 'element-attributes', node => $node};
973            last TP;
974          }
975      }      }
976      if ($node_ns eq $HTML_NS and ($node_ln eq 'video' or $node_ln eq 'audio')) {      if ($node_ns eq $HTML_NS and ($node_ln eq 'video' or $node_ln eq 'audio')) {
977        if ($node->has_attribute_ns (undef, 'src')) {        if ($node->has_attribute_ns (undef, 'src')) {
# Line 3119  sub _check_get_children ($$$) { Line 992  sub _check_get_children ($$$) {
992                last CN;                last CN;
993              }              }
994            } elsif ($cnt == 3 or $cnt == 4) {            } elsif ($cnt == 3 or $cnt == 4) {
995              if ($cn->data =~ /[^\x09-\x0D\x20]/) {              if ($cn->data =~ /[^\x09\x0A\x0C\x0D\x20]/) {
996                last CN;                last CN;
997              }              }
998            }            }
999          } # CN          } # CN
1000          unshift @$sib, @cn;          unshift @$sib, @cn;
1001        }        }
1002        } elsif ($node_ns eq $HTML_NS and $node_ln eq 'object') {
1003          my @cn = @{$node->child_nodes};
1004          CN: while (@cn) {
1005            my $cn = shift @cn;
1006            my $cnt = $cn->node_type;
1007            if ($cnt == 1) {
1008              my $cn_nsuri = $cn->namespace_uri;
1009              $cn_nsuri = '' unless defined $cn_nsuri;
1010              if ($cn_nsuri eq $HTML_NS and $cn->manakai_local_name eq 'param') {
1011                #
1012              } else {
1013                last CN;
1014              }
1015            } elsif ($cnt == 3 or $cnt == 4) {
1016              if ($cn->data =~ /[^\x09\x0A\x0C\x0D\x20]/) {
1017                last CN;
1018              }
1019            }
1020          } # CN
1021          unshift @$sib, @cn;
1022      }      }
1023      push @$new_todos, {type => 'element', node => $node};      push @$new_todos, {type => 'element', node => $node};
1024    } # TP    } # TP
# Line 3137  sub _check_get_children ($$$) { Line 1030  sub _check_get_children ($$$) {
1030    return ($sib, $new_todos);    return ($sib, $new_todos);
1031  } # _check_get_children  } # _check_get_children
1032    
1033    =head1 LICENSE
1034    
1035    Copyright 2007-2008 Wakaba <[email protected]>
1036    
1037    This library is free software; you can redistribute it
1038    and/or modify it under the same terms as Perl itself.
1039    
1040    =cut
1041    
1042  1;  1;
1043  # $Date$  # $Date$

Legend:
Removed from v.1.36  
changed lines
  Added in v.1.97

[email protected]
ViewVC Help
Powered by ViewVC 1.1.24