/[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.16 by wakaba, Sun May 20 07:12:11 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;
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 16  my $AttrChecker = { Line 59  my $AttrChecker = {
59          #          #
60        } else {        } else {
61          ## NOTE: An XML "error"          ## NOTE: An XML "error"
62          $self->{onerror}->(node => $attr,          $self->{onerror}->(node => $attr, level => $self->{level}->{xml_error},
63                             type => 'XML error:invalid xml:space value');                             type => 'invalid attribute value');
64        }        }
65      },      },
66      lang => sub {      lang => sub {
67          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        ## TODO: xml:lang MUST NOT in HTML document        ## NOTE: Is an RFC 3066-valid (but RFC 4646-invalid) language tag
83          ## 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
106            $self->{onerror}->(node => $attr, type => 'in HTML:xml:lang',
107                               level => $self->{level}->{must});
108    ## TODO: Test data...
109          }
110      },      },
111      base => sub {      base => sub {
112        my ($self, $attr) = @_;        my ($self, $attr) = @_;
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 => 'syntax error');                             type => 'invalid attribute value',
117                               level => $self->{level}->{fact}, ## TODO: correct?
118                              );
119        }        }
120        ## NOTE: Conformance to URI standard is not checked.        ## NOTE: Conformance to URI standard is not checked since there is
121          ## no author requirement on conformance in the XML Base specification.
122      },      },
123      id => sub {      id => sub {
124        my ($self, $attr) = @_;        my ($self, $attr) = @_;
# Line 45  my $AttrChecker = { Line 129  my $AttrChecker = {
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}) {        if ($self->{id}->{$value}) {
132          $self->{onerror}->(node => $attr, type => 'xml:id error:duplicate ID');          $self->{onerror}->(node => $attr,
133                               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 59  my $AttrChecker = { Line 146  my $AttrChecker = {
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,            ->(node => $attr,
149               type => 'NC: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,            ->(node => $attr,
155               type => 'NC: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,            ->(node => $attr,
162               type => 'NC: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,            ->(node => $attr,
168               type => 'NC: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 80  my $AttrChecker = { Line 175  my $AttrChecker = {
175        my ($self, $attr) = @_;        my ($self, $attr) = @_;
176        ## TODO: In XML 1.0, URI reference [RFC 3986] or an empty string        ## TODO: In XML 1.0, URI reference [RFC 3986] or an empty string
177        ## TODO: In XML 1.1, IRI reference [RFC 3987] or an empty string        ## TODO: In XML 1.1, IRI reference [RFC 3987] or an empty string
178          ## TODO: relative references are deprecated
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,            ->(node => $attr,
183               type => 'NC: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,            ->(node => $attr,
189               type => 'NC: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 97  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  
206    
207  my $ElementDefault = {  for (qw/space lang base id/) {
208    checker => sub {    $AttrStatus->{$XML_NS}->{$_} = FEATURE_STATUS_REC | FEATURE_ALLOWED;
209      my ($self, $todo) = @_;    $AttrStatus->{''}->{"xml:$_"} = FEATURE_STATUS_REC | FEATURE_ALLOWED;
210      $self->{onerror}->(node => $todo->{node}, type => 'element not supported');    ## XML 1.0: FEATURE_STATUS_CR
211      return $AnyChecker->($self, $todo);    ## XML 1.1: FEATURE_STATUS_REC
212    },    ## XML Namespaces 1.0: FEATURE_STATUS_CR
213    attrs_checker => sub {    ## XML Namespaces 1.1: FEATURE_STATUS_REC
214      my ($self, $todo) = @_;    ## XML Base: FEATURE_STATUS_REC
215      for my $attr (@{$todo->{node}->attributes}) {    ## xml:id: FEATURE_STATUS_REC
216    }
217    
218    $AttrStatus->{$XMLNS_NS}->{''} = FEATURE_STATUS_REC | FEATURE_ALLOWED;
219    
220    ## TODO: xsi:schemaLocation for XHTML2 support (very, very low priority)
221    
222    our %AnyChecker = (
223      check_start => sub { },
224      check_attrs => sub {
225        my ($self, $item, $element_state) = @_;
226        for my $attr (@{$item->{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            load_ns_module ($attr_ns);
230          } else {
231            $attr_ns = '';
232          }
233        my $attr_ln = $attr->manakai_local_name;        my $attr_ln = $attr->manakai_local_name;
234          
235        my $checker = $AttrChecker->{$attr_ns}->{$attr_ln}        my $checker = $AttrChecker->{$attr_ns}->{$attr_ln}
236          || $AttrChecker->{$attr_ns}->{''};            || $AttrChecker->{$attr_ns}->{''};
237          my $status = $AttrStatus->{$attr_ns}->{$attr_ln}
238              || $AttrStatus->{$attr_ns}->{''};
239          if (not defined $status) {
240            $status = FEATURE_ALLOWED;
241            ## NOTE: FEATURE_ALLOWED for all attributes, since the element
242            ## is not supported and therefore "attribute not defined" error
243            ## should not raised (too verbose) and global attributes should be
244            ## allowed anyway (if a global attribute has its specified creteria
245            ## for where it may be specified, then it should be checked in it's
246            ## checker function).
247          }
248        if ($checker) {        if ($checker) {
249          $checker->($self, $attr);          $checker->($self, $attr);
250          } else {
251            $self->{onerror}->(node => $attr,
252                               type => 'unknown attribute',
253                               level => $self->{level}->{uncertain});
254        }        }
255        ## Don't check otherwise, since "element type not supported" warning        $self->_attr_status_info ($attr, $status);
       ## will be reported by the element checker.  
256      }      }
257    },    },
258  };    check_child_element => sub {
259        my ($self, $item, $child_el, $child_nsuri, $child_ln,
260  my $Element = {};          $child_is_transparent, $element_state) = @_;
261        if ($self->{minus_elements}->{$child_nsuri}->{$child_ln}) {
262  my $HTML_NS = q<http://www.w3.org/1999/xhtml>;        $self->{onerror}->(node => $child_el,
263                             type => 'element not allowed:minus',
264  my $HTMLMetadataElements = {                           level => $self->{level}->{must});
265    $HTML_NS => {      } elsif ($self->{plus_elements}->{$child_nsuri}->{$child_ln}) {
266      qw/link 1 meta 1 style 1 script 1 event-source 1 command 1 base 1 title 1/,        #
267        } else {
268          #
269        }
270    },    },
271  };    check_child_text => sub { },
272      check_end => sub {
273  my $HTMLSectioningElements = {      my ($self, $item, $element_state) = @_;
274    $HTML_NS => {qw/body 1 section 1 nav 1 article 1 blockquote 1 aside 1/},      ## NOTE: There is a modified copy of the code below for |html:ruby|.
275  };      if ($element_state->{has_significant}) {
276          $item->{real_parent_state}->{has_significant} = 1;
277  my $HTMLBlockLevelElements = {      }    
278    $HTML_NS => {    },
279      qw/  );
280        section 1 nav 1 article 1 blockquote 1 aside 1  
281        h1 1 h2 1 h3 1 h4 1 h5 1 h6 1 header 1 footer 1  our $ElementDefault = {
282        address 1 p 1 hr 1 dialog 1 pre 1 ol 1 ul 1 dl 1    %AnyChecker,
283        ins 1 del 1 figure 1 map 1 table 1 script 1 noscript 1    status => FEATURE_ALLOWED,
284        event-source 1 details 1 datagrid 1 menu 1 div 1 font 1        ## 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  };  };
292    
293  my $HTMLStrictlyInlineLevelElements = {  our $HTMLEmbeddedContent = {
294      ## NOTE: All embedded content is also phrasing content.
295    $HTML_NS => {    $HTML_NS => {
296      qw/      img => 1, iframe => 1, embed => 1, object => 1, video => 1, audio => 1,
297        br 1 a 1 q 1 cite 1 em 1 strong 1 small 1 m 1 dfn 1 abbr 1      canvas => 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  
     /,  
298    },    },
299  };    q<http://www.w3.org/1998/Math/MathML> => {math => 1},
300      q<http://www.w3.org/2000/svg> => {svg => 1},
301  my $HTMLStructuredInlineLevelElements = {    ## NOTE: Foreign elements with content (but no metadata) are
302    $HTML_NS => {qw/blockquote 1 pre 1 ol 1 ul 1 dl 1 table 1 menu 1/},    ## embedded content.
303  };  };  
304    
305  my $HTMLInteractiveElements = {  our $IsInHTMLInteractiveContent = sub {
306    $HTML_NS => {a => 1, details => 1, datagrid => 1},    my ($el, $nsuri, $ln) = @_;
307  };  
308  ## NOTE: |html:a| and |html:datagrid| are not allowed as a descendant    ## NOTE: This CODE returns whether an element that is conditionally
309  ## of interactive elements    ## categorizzed as an interactive content is currently in that
310      ## condition or not.  See $HTMLInteractiveContent list defined in
311      ## Whatpm::ContentChecler::HTML for the list of all (conditionally
312      ## or permanently) interactive content.
313    
314      if ($nsuri eq $HTML_NS and ($ln eq 'video' or $ln eq 'audio')) {
315        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        return ($value eq 'toolbar');
320      } else {
321        return 1;
322      }
323    }; # $IsInHTMLInteractiveContent
324    
325  my $HTMLTransparentElements = {  my $HTMLTransparentElements = {
326    $HTML_NS => {qw/ins 1 font 1 noscript 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.    ## NOTE: |html:noscript| is transparent if scripting is disabled
328  };    ## and not in |head|.
329    };
330  #my $HTMLSemiTransparentElements = {  
331  #  $HTML_NS => {qw/video 1 audio 1/},  my $HTMLSemiTransparentElements = {
332  #};    $HTML_NS => {object => 1, video => 1, audio => 1},
333    };
334  my $HTMLEmbededElements = {  
335    $HTML_NS => {qw/img 1 iframe 1 embed 1 object 1 video 1 audio 1 canvas 1/},  our $Element = {};
336  };  
337    $Element->{q<http://www.w3.org/1999/02/22-rdf-syntax-ns#>}->{RDF} = {
338  ## Empty    %AnyChecker,
339  my $HTMLEmptyChecker = sub {    status => FEATURE_STATUS_REC | FEATURE_ALLOWED,
340    my ($self, $todo) = @_;    is_root => 1, ## ISSUE: Not explicitly allowed for non application/rdf+xml
341    my $el = $todo->{node};    check_start => sub {
342    my $new_todos = [];      my ($self, $item, $element_state) = @_;
343    my @nodes = (@{$el->child_nodes});      my $triple = [];
344        push @{$self->{return}->{rdf}}, [$item->{node}, $triple];
345    while (@nodes) {      require Whatpm::RDFXML;
346      my $node = shift @nodes;      my $rdf = Whatpm::RDFXML->new;
347      $self->_remove_minuses ($node) and next if ref $node eq 'HASH';      ## TODO: Should we make bnodeid unique in a document?
348        $rdf->{onerror} = $self->{onerror};
349      my $nt = $node->node_type;      $rdf->{level} = $self->{level};
350      if ($nt == 1) {      $rdf->{ontriple} = sub {
351        ## NOTE: |minuses| list is not checked since redundant        my %opt = @_;
352        $self->{onerror}->(node => $node, type => 'element not allowed');        push @$triple,
353        my ($sib, $ch) = $self->_check_get_children ($node);            [$opt{node}, $opt{subject}, $opt{predicate}, $opt{object}];
354        unshift @nodes, @$sib;        if (defined $opt{id}) {
355        push @$new_todos, @$ch;          push @$triple,
356      } elsif ($nt == 3 or $nt == 4) {              [$opt{node},
357        if ($node->data =~ /[^\x09-\x0D\x20]/) {               $opt{id},
358          $self->{onerror}->(node => $node, type => 'character not allowed');               {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      } elsif ($nt == 5) {      };
377        unshift @nodes, @{$node->child_nodes};      $rdf->convert_rdf_element ($item->{node});
378      }    },
   }  
   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);  
       unshift @nodes, @$sib;  
       push @$new_todos, @$ch;  
     } elsif ($nt == 5) {  
       unshift @nodes, @{$node->child_nodes};  
     }  
   }  
   return ($new_todos);  
379  };  };
380    
381  ## Zero or more |html:style| elements,  my $default_error_level = {
382  ## followed by zero or more block-level elements    must => 'm',
383  my $HTMLStylableBlockChecker = sub {    should => 's',
384    my ($self, $todo) = @_;    warn => 'w',
385    my $el = $todo->{node};    good => 'w',
386    my $new_todos = [];    undefined => 'w',
387    my @nodes = (@{$el->child_nodes});    info => 'i',
388      
389    my $has_non_style;    uncertain => 'u',
390    while (@nodes) {  
391      my $node = shift @nodes;    html4_fact => 'm',
392      $self->_remove_minuses ($node) and next if ref $node eq 'HASH';    html5_no_may => 'm',
393    
394      my $nt = $node->node_type;    xml_error => 'm', ## TODO: correct?
395      if ($nt == 1) {    xml_id_error => 'm', ## TODO: ?
396        my $node_ns = $node->namespace_uri;    nc => 'm', ## XML Namespace Constraints ## TODO: correct?
397        $node_ns = '' unless defined $node_ns;  
398        my $node_ln = $node->manakai_local_name;    ## |Whatpm::URIChecker|
399        my $not_allowed = $self->{minuses}->{$node_ns}->{$node_ln};    uri_syntax => 'm',
400        if ($node_ns eq $HTML_NS and $node_ln eq 'style') {    uri_fact => 'm',
401          $not_allowed = 1 if $has_non_style;    uri_lc_must => 'm',
402        } elsif ($HTMLBlockLevelElements->{$node_ns}->{$node_ln}) {    uri_lc_should => 'w',
403          $has_non_style = 1;  
404        } else {    ## |Whatpm::IMTChecker|
405          $has_non_style = 1;    mime_must => 'm', # lowercase "must"
406          $not_allowed = 1;    mime_fact => 'm',
407        }    mime_strongly_discouraged => 'w',
408        $self->{onerror}->(node => $node, type => 'element not allowed')    mime_discouraged => 'w',
409          if $not_allowed;  
410        my ($sib, $ch) = $self->_check_get_children ($node);    ## |Whatpm::LangTag|
411        unshift @nodes, @$sib;    langtag_fact => 'm',
412        push @$new_todos, @$ch;  
413      } elsif ($nt == 3 or $nt == 4) {    ## |Whatpm::RDFXML|
414        if ($node->data =~ /[^\x09-\x0D\x20]/) {    rdf_fact => 'm',
415          $self->{onerror}->(node => $node, type => 'character not allowed');    rdf_grammer => 'm',
416        }    rdf_lc_must => 'm',
417      } elsif ($nt == 5) {  
418        unshift @nodes, @{$node->child_nodes};    ## |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    return ($new_todos);      ## to the original charset (e.g. use of 0x80 in an ISO-8859-1 document
422  }; # $HTMLStylableBlockChecker      ## which is interpreted as a Windows-1252 document instead).
423      charset_fact => 'm',
424  ## Zero or more block-level elements    iso_shall => 'm',
425  my $HTMLBlockChecker = sub {  };
426    my ($self, $todo) = @_;  
427    my $el = $todo->{node};  sub check_document ($$$;$) {
428    my $new_todos = [];    my ($self, $doc, $onerror, $onsubdoc) = @_;
429    my @nodes = (@{$el->child_nodes});    $self = bless {}, $self unless ref $self;
430        $self->{onerror} = $onerror;
431    while (@nodes) {    $self->{onsubdoc} = $onsubdoc || sub {
432      my $node = shift @nodes;      warn "A subdocument is not conformance-checked";
433      $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);  
       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);  
       unshift @nodes, @$sib;  
       push @$new_todos, @$ch;  
     } elsif ($nt == 5) {  
       unshift @nodes, @{$node->child_nodes};  
     }  
   }  
   
   for (@$new_todos) {  
     $_->{inline} = 1;  
   }  
   return ($new_todos);  
 }; # $HTMLInlineChecker  
434    
435  my $HTMLSignificantInlineChecker = $HTMLInlineChecker;    $self->{level} ||= $default_error_level;
 ## TODO: check significant content  
436    
437  ## Strictly inline-level content    ## TODO: If application/rdf+xml, RDF/XML mode should be invoked.
 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);  
       unshift @nodes, @$sib;  
       push @$new_todos, @$ch;  
     } elsif ($nt == 5) {  
       unshift @nodes, @{$node->child_nodes};  
     }  
   }  
438    
439    for (@$new_todos) {    my $docel = $doc->document_element;
440      $_->{inline} = 1;    unless (defined $docel) {
441      $_->{strictly_inline} = 1;      ## ISSUE: Should we check content of Document node?
442        $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?
445        return {
446                class => {},
447                id => {}, table => [], term => {},
448               };
449    }    }
   return ($new_todos);  
 }; # $HTMLStrictlyInlineChecker  
   
 my $HTMLSignificantStrictlyInlineChecker = $HTMLStrictlyInlineChecker;  
 ## TODO: check significant content  
450    
451  ## Inline-level or strictly inline-kevek content    ## ISSUE: Unexpanded entity references and HTML5 conformance
 my $HTMLInlineOrStrictlyInlineChecker = sub {  
   my ($self, $todo) = @_;  
   my $el = $todo->{node};  
   my $new_todos = [];  
   my @nodes = (@{$el->child_nodes});  
452        
453    while (@nodes) {    my $docel_nsuri = $docel->namespace_uri;
454      my $node = shift @nodes;    if (defined $docel_nsuri) {
455      $self->_remove_minuses ($node) and next if ref $node eq 'HASH';      load_ns_module ($docel_nsuri);
456      } else {
457      my $nt = $node->node_type;      $docel_nsuri = '';
     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);  
       unshift @nodes, @$sib;  
       push @$new_todos, @$ch;  
     } elsif ($nt == 5) {  
       unshift @nodes, @{$node->child_nodes};  
     }  
458    }    }
459      my $docel_def = $Element->{$docel_nsuri}->{$docel->manakai_local_name} ||
460    for (@$new_todos) {      $Element->{$docel_nsuri}->{''} ||
461      $_->{inline} = 1;      $ElementDefault;
462      $_->{strictly_inline} = 1;    if ($docel_def->{is_root}) {
463    }      #
464    return ($new_todos);    } elsif ($docel_def->{is_xml_root}) {
465  }; # $HTMLInlineOrStrictlyInlineChecker      unless ($doc->manakai_is_html) {
   
 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);  
       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;  
         } 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);  
         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) {  
466        #        #
     } elsif ($states->{$value}) {  
       $self->{onerror}->(node => $attr,  
                          type => 'non-conforming enumerated attribute value');  
467      } else {      } else {
468        $self->{onerror}->(node => $attr,        $onerror->(node => $docel, type => 'element not allowed:root:xml',
469                           type => 'invalid enumerated attribute value');                   level => $self->{level}->{must});
     }  
   };  
 }; # $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 => 'invalid boolean attribute value');  
     }  
   };  
 }; # $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);  
470      }      }
471      } else {
472        $onerror->(node => $docel, type => 'element not allowed:root',
473                   level => $self->{level}->{must});
474    }    }
 }; # $HTMLUnorderedSetOfSpaceSeparatedTokensAttrChecker  
   
 my $HTMLURIAttrChecker = sub {  
   my ($self, $attr) = @_;  
   ## TODO: URI or IRI check  
   ## ISSUE: Relative references are allowed? (RFC 3987 "IRI" is an absolute reference with optional fragment identifier.)  
 }; # $HTMLURIAttrChecker  
   
 ## A space separated list of one or more URIs (or IRIs)  
 my $HTMLSpaceURIsAttrChecker = sub {  
   my ($self, $attr) = @_;  
   ## TODO: URI or IRI check  
   ## 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 $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 => 'out of range');  
       }  
     } else {  
       $self->{onerror}->(node => $attr,  
                          type => 'non-negative integer 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 => 'out of range');  
       }  
     } else {  
       $self->{onerror}->(node => $attr,  
                          type => 'floating point number 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])*"/;  
   unless ($value =~ m#\A$lws0$token$lws0/$lws0$token$lws0(?>;$lws0$token$lws0=$lws0(?>$token|$qs)$lws0)*\z#) {  
     $self->{onerror}->(node => $attr, type => 'IMT syntax error');  
   }  
   ## TODO: Warn unless registered  
 }; # $HTMLIMTAttrChecker  
   
 my $HTMLEventHandlerAttrChecker = sub {  
   ## 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 $HTMLAttrChecker = {  
   id => sub {  
     my ($self, $attr) = @_;  
     my $value = $attr->value;  
     unless (length $value > 0) {  
       ## NOTE: MUST contain at least one character  
       $self->{onerror}->(node => $attr, type => 'attribute value is empty');  
     } else {  
       if ($self->{id}->{$value}) {  
         $self->{onerror}->(node => $attr, type => 'duplicate ID');  
       } else {  
         $self->{id}->{$value} = 1;  
       }  
     }  
   },  
   title => sub {}, ## NOTE: No conformance creteria  
   lang => sub {  
     ## TODO: RFC 3066 test  
     ## ISSUE: RFC 4646 (3066bis)?  
     ## TODO: HTML vs XHTML  
   },  
   dir => $GetHTMLEnumeratedAttrChecker->({ltr => 1, rtl => 1}),  
   class => $HTMLUnorderedSetOfSpaceSeparatedTokensAttrChecker,  
   irrelevant => $GetHTMLBooleanAttrChecker->('irrelevant'),  
   ## TODO: tabindex  
 };  
   
 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;  
 }  
   
 my $GetHTMLAttrsChecker = sub {  
   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);  
       } else {  
         $self->{onerror}->(node => $attr, type => 'attribute not supported');  
         ## ISSUE: No comformance createria for unknown attributes in the spec  
       }  
     }  
   };  
 }; # $GetHTMLAttrsChecker  
   
 $Element->{$HTML_NS}->{''} = {  
   attrs_checker => $GetHTMLAttrsChecker->({}),  
   checker => $ElementDefault->{checker},  
 };  
   
 $Element->{$HTML_NS}->{html} = {  
   attrs_checker => $GetHTMLAttrsChecker->({  
     xmlns => sub {  
       my ($self, $attr) = @_;  
       my $value = $attr->value;  
       unless ($value eq $HTML_NS) {  
         $self->{onerror}->(node => $attr, type => 'syntax error');  
         ## TODO: only in HTML documents  
       }  
     },  
   }),  
   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);  
         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};  
       }  
     }  
475    
476      if ($phase eq 'before head') {    ## TODO: Check for other items other than document element
477        $self->{onerror}->(node => $el, type => 'child element missing:head');    ## (second (errorous) element, text nodes, PI nodes, doctype nodes)
       $self->{onerror}->(node => $el, type => 'child element missing:body');  
     } elsif ($phase eq 'after head') {  
       $self->{onerror}->(node => $el, type => 'child element missing:body');  
     }  
478    
479      return ($new_todos);    my $return = $self->check_element ($docel, $onerror, $onsubdoc);
   },  
 };  
480    
481  $Element->{$HTML_NS}->{head} = {    ## TODO: Test for these checks are necessary.
482    attrs_checker => $GetHTMLAttrsChecker->({}),    my $charset_name = $doc->input_encoding;
483    checker => sub {    if (defined $charset_name) {
484      my ($self, $todo) = @_;      require Message::Charset::Info;
485      my $el = $todo->{node};      my $charset = $Message::Charset::Info::IANACharset->{$charset_name};
486      my $new_todos = [];  
487      my @nodes = (@{$el->child_nodes});      if ($doc->manakai_is_html) {
488          if (not $doc->manakai_has_bom and
489      my $has_title;            not defined $doc->manakai_charset) {
490      my $phase = 'initial'; # 'after charset', 'after base'          unless ($charset->{is_html_ascii_superset}) {
491      while (@nodes) {            $onerror->(node => $doc,
492        my $node = shift @nodes;                       level => $self->{level}->{must},
493        $self->_remove_minuses ($node) and next if ref $node eq 'HASH';                       type => 'non ascii superset',
494                         text => $charset_name);
       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 ($HTMLMetadataElements->{$node_ns}->{$node_ln}) {  
           $phase = 'after base';  
         } else {  
           $not_allowed = 1;  
495          }          }
496          $self->{onerror}->(node => $node, type => 'element not allowed')          
497            if $not_allowed;          if (not $self->{has_charset} and ## TODO: This does not work now.
498          my ($sib, $ch) = $self->_check_get_children ($node);              not $charset->{iana_names}->{'us-ascii'}) {
499          unshift @nodes, @$sib;            $onerror->(node => $doc,
500          push @$new_todos, @$ch;                       level => $self->{level}->{must},
501        } elsif ($nt == 3 or $nt == 4) {                       type => 'no character encoding declaration',
502          if ($node->data =~ /[^\x09-\x0D\x20]/) {                       text => $charset_name);
           $self->{onerror}->(node => $node, type => 'character not allowed');  
503          }          }
       } elsif ($nt == 5) {  
         unshift @nodes, @{$node->child_nodes};  
504        }        }
     }  
     unless ($has_title) {  
       $self->{onerror}->(node => $el, type => 'child element missing:title');  
     }  
     return ($new_todos);  
   },  
 };  
505    
506  $Element->{$HTML_NS}->{title} = {        if ($charset->{iana_names}->{'utf-8'}) {
   attrs_checker => $GetHTMLAttrsChecker->({}),  
   checker => $HTMLTextChecker,  
 };  
   
 $Element->{$HTML_NS}->{base} = {  
   attrs_checker => $GetHTMLAttrsChecker->({  
     href => $HTMLURIAttrChecker,  
     ## TODO: target  
   }),  
   checker => $HTMLEmptyChecker,  
 };  
   
 $Element->{$HTML_NS}->{link} = {  
   attrs_checker => sub {  
     my ($self, $todo) = @_;  
     $GetHTMLAttrsChecker->({  
       href => $HTMLURIAttrChecker,  
       rel => $HTMLUnorderedSetOfSpaceSeparatedTokensAttrChecker, ## TODO: registered? check  
       ## TODO: media  
       ## TODO: hreflang  
       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}) {  
       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 '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, type => 'attribute not supported');  
         ## 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');  
       }  
       ## TODO: Allowed only in HTML documents  
     } 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}) {  
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 {        } else {
527          $self->{onerror}->(node => $http_equiv_attr,          $onerror->(node => $doc,
528                             type => 'invalid enumerated attribute value');                     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      ## TODO: charset    return $return;
544    },  } # check_document
   checker => $HTMLEmptyChecker,  
 };  
   
 ## NOTE: |html:style| has no conformance creteria on content model  
 $Element->{$HTML_NS}->{style} = {  
   attrs_checker => $GetHTMLAttrsChecker->({  
     type => $HTMLIMTAttrChecker, ## TODO: MUST be a styling language  
     ## TODO: media  
     scoped => $GetHTMLBooleanAttrChecker->('scoped'),  
     ## NOTE: |title| has special semantics for |style|s, but is syntactically  
     ## not different  
   }),  
   checker => $AnyChecker,  
 };  
   
 $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 => $HTMLSignificantStrictlyInlineChecker,  
 };  
   
 $Element->{$HTML_NS}->{h2} = {  
   attrs_checker => $GetHTMLAttrsChecker->({}),  
   checker => $HTMLSignificantStrictlyInlineChecker,  
 };  
   
 $Element->{$HTML_NS}->{h3} = {  
   attrs_checker => $GetHTMLAttrsChecker->({}),  
   checker => $HTMLSignificantStrictlyInlineChecker,  
 };  
   
 $Element->{$HTML_NS}->{h4} = {  
   attrs_checker => $GetHTMLAttrsChecker->({}),  
   checker => $HTMLSignificantStrictlyInlineChecker,  
 };  
   
 $Element->{$HTML_NS}->{h5} = {  
   attrs_checker => $GetHTMLAttrsChecker->({}),  
   checker => $HTMLSignificantStrictlyInlineChecker,  
 };  
   
 $Element->{$HTML_NS}->{h6} = {  
   attrs_checker => $GetHTMLAttrsChecker->({}),  
   checker => $HTMLSignificantStrictlyInlineChecker,  
 };  
   
 ## TODO: header  
   
 $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);  
         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;  
       }  
     }  
   
     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);  
         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);  
         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, type => 'attribute not supported');  
         }  
       }  
       $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);  
         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 => do {  
     my %attr;  
     my $all_checker = $GetHTMLAttrsChecker->({  
       href => sub { $HTMLURIAttrChecker->(@_); $attr{href} = $_[1] },  
       ## TODO: target  
       ping => sub { $HTMLSpaceURIsAttrChecker->(@_); $attr{ping} = $_[1] },  
       rel => sub {  
         $HTMLUnorderedSetOfSpaceSeparatedTokensAttrChecker->(@_); ## TODO: registered? check  
         $attr{rel} = $_[1];  
       },  
       ## TODO: media  
       ## TODO: hreflang  
       type => sub { $HTMLIMTAttrChecker->(@_); $attr{type} = $_[1] },  
     });  
     sub {  
       $all_checker->(@_);  
       unless (defined $attr{href}) {  
         for (qw/target ping rel media hreflang type/) {  
           if (defined $attr{$_}) {  
             $_[0]->{onerror}->(node => $attr{$_},  
                                type => 'attribute not allowed');  
           }  
         }  
       }  
       %attr = ();  
     };  
   },  
   checker => sub {  
     my ($self, $todo) = @_;  
   
     my $end = $self->_add_minuses ($HTMLInteractiveElements);  
     my ($sib, $ch)  
       = $HTMLSignificantInlineOrStrictlyInlineChecker->($self, $todo);  
     push @$sib, $end;  
     return ($sib, $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} = { ## TODO: term duplication  
   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;  
     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,  
     ## TODO: datetime  
   }),  
   checker => $HTMLTransparentChecker,  
 };  
   
 $Element->{$HTML_NS}->{del} = {  
   attrs_checker => $GetHTMLAttrsChecker->({  
     cite => $HTMLURIAttrChecker,  
     ## TODO: datetime  
   }),  
   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 => $GetHTMLAttrsChecker->({}), ## TODO  
   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.  
         }  
       }  
       $checker ||= $AttrChecker->{$attr_ns}->{$attr_ln}  
         || $AttrChecker->{$attr_ns}->{''};  
       if ($checker) {  
         $checker->($self, $attr);  
       } else {  
         $self->{onerror}->(node => $attr, type => 'attribute not supported');  
         ## ISSUE: No comformance createria for global attributes in the spec  
       }  
     }  
   
     unless ($has_src) {  
       $self->{onerror}->(node => $todo->{node},  
                          type => 'attribute missing:src');  
     }  
   },  
   checker => $HTMLEmptyChecker,  
 };  
   
 $Element->{$HTML_NS}->{object} = {  
   attrs_checker => $GetHTMLAttrsChecker->({  
     data => $HTMLURIAttrChecker,  
     type => $HTMLIMTAttrChecker, ## TODO: one of |data| and |type| is required  
     ## TODO: usemap  
     ## TODO: width  
     ## TODO: height  
   }),  
   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},  
 };  
545    
546  $Element->{$HTML_NS}->{source} = {  ## Check an element.  The element is checked as if it is an orphan node (i.e.
547    attrs_checker => $GetHTMLAttrsChecker->({  ## an element without a parent node).
548      src => $HTMLURIAttrChecker, # TODO: REQUIRED  sub check_element ($$$;$) {
549      type => $HTMLIMTAttrChecker,    my ($self, $el, $onerror, $onsubdoc) = @_;
550      ## TODO: media    $self = bless {}, $self unless ref $self;
551    }),    $self->{onerror} = $onerror;
552    checker => $HTMLEmptyChecker,    $self->{onsubdoc} = $onsubdoc || sub {
553  };      warn "A subdocument is not conformance-checked";
554      };
555    
556  $Element->{$HTML_NS}->{canvas} = {    $self->{level} ||= $default_error_level;
   attrs_checker => $GetHTMLAttrsChecker->({  
     height => $GetHTMLNonNegativeIntegerAttrChecker->(sub { 1 }),  
     width => $GetHTMLNonNegativeIntegerAttrChecker->(sub { 1 }),  
   }),  
   checker => $HTMLInlineChecker,  
 };  
557    
558  $Element->{$HTML_NS}->{map} = {    $self->{plus_elements} = {};
559    attrs_checker => $GetHTMLAttrsChecker->({}),    $self->{minus_elements} = {};
560    checker => $HTMLBlockChecker,    $self->{id} = {};
561  };    $self->{form} = {};
562      $self->{term} = {};
563      $self->{usemap} = [];
564      $self->{ref} = []; # datetemplate data references
565      $self->{template} = []; # datatemplate template references
566      $self->{contextmenu} = [];
567      $self->{map} = {};
568      $self->{menu} = {};
569      $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} = {
576        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  $Element->{$HTML_NS}->{area} = {    my @item = ({type => 'element', node => $el, parent_state => {}});
586    attrs_checker => sub {    $item[-1]->{real_parent_state} = $item[-1]->{parent_state};
587      my ($self, $todo) = @_;    while (@item) {
588      my %attr;      my $item = shift @item;
589      my $coords;      if (ref $item eq 'ARRAY') {
590      for my $attr (@{$todo->{node}->attributes}) {        my $code = shift @$item;
591        my $attr_ns = $attr->namespace_uri;  next unless $code;## TODO: temp.
592        $attr_ns = '' unless defined $attr_ns;        $code->(@$item);
593        my $attr_ln = $attr->manakai_local_name;      } elsif ($item->{type} eq 'element') {
594        my $checker;        my $el_nsuri = $item->{node}->namespace_uri;
595        if ($attr_ns eq '') {        if (defined $el_nsuri) {
596          $checker = {          load_ns_module ($el_nsuri);
                      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 => 'syntax error');  
                        }  
                      },  
                      ## TODO: coords  
                      target => sub { $self->{onerror}->(node => $attr, type => 'attribute not supported') }, ## TODO  
                      href => $HTMLURIAttrChecker,  
                      ping => $HTMLSpaceURIsAttrChecker,  
                      rel => $HTMLUnorderedSetOfSpaceSeparatedTokensAttrChecker, ## TODO: registered? check  
                      media => sub { $self->{onerror}->(node => $attr, type => 'attribute not supported') }, ## TODO  
                      hreflang => sub { $self->{onerror}->(node => $attr, type => 'attribute not supported') }, ## TODO  
                      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;  
597        } else {        } else {
598          $self->{onerror}->(node => $attr, type => 'attribute not supported');          $el_nsuri = '';
         ## ISSUE: No comformance createria for unknown attributes in the spec  
599        }        }
600      }        my $el_ln = $item->{node}->manakai_local_name;
601          
602          my $element_state = {};
603          my $eldef = $Element->{$el_nsuri}->{$el_ln} ||
604              $Element->{$el_nsuri}->{''} ||
605              $ElementDefault;
606          my $content_def = $item->{transparent}
607              ? $item->{parent_def} || $eldef : $eldef;
608          my $content_state = $item->{transparent}
609              ? $item->{parent_def}
610                  ? $item->{parent_state} || $element_state : $element_state
611              : $element_state;
612    
613          unless ($eldef->{status} & FEATURE_STATUS_REC) {
614            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      if (defined $attr{href}) {              push @new_item, [$content_def->{check_child_element},
685        unless (defined $attr{alt}) {                               $self, $item, $child,
686          $self->{onerror}->(node => $todo->{node},                               $child_nsuri, $child_ln,
687                             type => 'attribute missing:alt');                               $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 {      } else {
721        for (qw/target ping rel media hreflang type alt/) {        die "$0: Internal error: Unsupported checking action type |$item->{type}|";
         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?  
722      }      }
723      }
724    
725      if ($shape eq 'circle') {    for (@{$self->{template}}) {
726        if (defined $attr{coords}) {      ## TODO: If the document is an XML document, ...
727          if (defined $coords) {      ## NOTE: If the document is an HTML document:
728            if (@$coords == 3) {      ## ISSUE: We need to percent-decode?
729              if ($coords->[2] < 0) {      F: {
730                $self->{onerror}->(node => $attr{coords},        if ($self->{id}->{$_->[0]}) {
731                                   type => 'out of range:2');          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            } else {              
742              $self->{onerror}->(node => $attr{coords},              last F;
                                type => 'list item 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 => 'list item number:even:'.@$coords);  
             }  
           } else {  
             $self->{onerror}->(node => $attr{coords},  
                                type => 'list item 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 => 'out of range:0');  
             }  
             unless ($coords->[1] < $coords->[3]) {  
               $self->{onerror}->(node => $attr{coords},  
                                  type => 'out of range:1');  
             }  
           } else {  
             $self->{onerror}->(node => $attr{coords},  
                                type => 'list item number:4:'.@$coords);  
743            }            }
         } else {  
           ## NOTE: A syntax error has been reported.  
744          }          }
       } else {  
         $self->{onerror}->(node => $todo->{node},  
                            type => 'attribute missing:coords');  
745        }        }
746      }        ## TODO: Should we raise a "fragment points nothing" error instead
747    },        ## if the fragment identifier identifies no element?
   checker => $HTMLEmptyChecker,  
 };  
 ## TODO: only in map  
748    
749  $Element->{$HTML_NS}->{table} = {        $self->{onerror}->(node => $_->[1], type => 'template:not template',
750    attrs_checker => $GetHTMLAttrsChecker->({}),                           level => $self->{level}->{must});
751    checker => sub {      } # F
752      my ($self, $todo) = @_;    }
753      my $el = $todo->{node};    
754      my $new_todos = [];    for (@{$self->{ref}}) {
755      my @nodes = (@{$el->child_nodes});      ## TOOD: If XML
756        ## NOTE: If it is an HTML document:
757      my $phase = 'before caption';      if ($_->[0] eq '') {
758      my $has_tfoot;        ## NOTE: It points the top of the document.
759      while (@nodes) {      } elsif ($self->{id}->{$_->[0]}) {
760        my $node = shift @nodes;        if ($self->{id}->{$_->[0]}->[0]->owner_element
761        $self->_remove_minuses ($node) and next if ref $node eq 'HASH';                eq $_->[1]->owner_element) {
762            $self->{onerror}->(node => $_->[1], type => 'fragment points itself',
763        my $nt = $node->node_type;                             level => $self->{level}->{must});
       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);  
         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};  
764        }        }
765        } else {
766          $self->{onerror}->(node => $_->[1], type => 'fragment points nothing',
767                             level => $self->{level}->{must});
768      }      }
769      return ($new_todos);    }
   },  
 };  
770    
771  $Element->{$HTML_NS}->{caption} = {    ## TODO: Maybe we should have $document->manakai_get_by_fragment or something
   attrs_checker => $GetHTMLAttrsChecker->({}),  
   checker => $HTMLSignificantStrictlyInlineChecker,  
 };  
772    
773  $Element->{$HTML_NS}->{colgroup} = {    for (@{$self->{usemap}}) {
774    attrs_checker => $GetHTMLAttrsChecker->({}), ## TODO      unless ($self->{map}->{$_->[0]}) {
775    checker => sub {        $self->{onerror}->(node => $_->[1], type => 'no referenced map',
776      my ($self, $todo) = @_;                           level => $self->{level}->{must});
     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);  
         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};  
       }  
777      }      }
778      return ($new_todos);    }
   },  
 };  
   
 $Element->{$HTML_NS}->{col} = {  
   attrs_checker => $GetHTMLAttrsChecker->({  
     span => $GetHTMLNonNegativeIntegerAttrChecker->(sub { shift > 0 }),  
   }),  
   checker => $HTMLEmptyChecker,  
 };  
779    
780  $Element->{$HTML_NS}->{tbody} = {    for (@{$self->{contextmenu}}) {
781    attrs_checker => $GetHTMLAttrsChecker->({}),      unless ($self->{menu}->{$_->[0]}) {
782    checker => sub {        $self->{onerror}->(node => $_->[1], type => 'no referenced menu',
783      my ($self, $todo) = @_;                           level => $self->{level}->{must});
     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);  
         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};  
       }  
784      }      }
785      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},  
 };  
786    
787  $Element->{$HTML_NS}->{tfoot} = {    delete $self->{plus_elements};
788    attrs_checker => $GetHTMLAttrsChecker->({}),    delete $self->{minus_elements};
789    checker => $Element->{$HTML_NS}->{tbody},    delete $self->{onerror};
790  };    delete $self->{id};
791      delete $self->{form};
792      delete $self->{usemap};
793      delete $self->{ref};
794      delete $self->{template};
795      delete $self->{map};
796      return $self->{return};
797    } # check_element
798    
799  $Element->{$HTML_NS}->{tr} = {  sub _add_minus_elements ($$@) {
800    attrs_checker => $GetHTMLAttrsChecker->({}),    my $self = shift;
801    checker => sub {    my $element_state = shift;
802      my ($self, $todo) = @_;    for my $elements (@_) {
803      my $el = $todo->{node};      for my $nsuri (keys %$elements) {
804      my $new_todos = [];        for my $ln (keys %{$elements->{$nsuri}}) {
805      my @nodes = (@{$el->child_nodes});          unless ($self->{minus_elements}->{$nsuri}->{$ln}) {
806              $element_state->{minus_elements_original}->{$nsuri}->{$ln} = 0;
807      my $has_td;            $self->{minus_elements}->{$nsuri}->{$ln} = 1;
     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);  
         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');  
808          }          }
       } elsif ($nt == 5) {  
         unshift @nodes, @{$node->child_nodes};  
809        }        }
810      }      }
811      unless ($has_td) {    }
812        $self->{onerror}->(node => $el, type => 'child element missing:td|th');  } # _add_minus_elements
     }  
     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: table model error checking  
   
 ## TODO: forms  
   
 $Element->{$HTML_NS}->{script} = {  
   attrs_checker => $GetHTMLAttrsChecker->({  
     src => $HTMLURIAttrChecker,  
     defer => $GetHTMLBooleanAttrChecker->('defer'), ## TODO: if src ## ISSUE: no MUST NOT  
     async => $GetHTMLBooleanAttrChecker->('async'), ## TODO: if src ## ISSUE: no MUST NOT  
     type => $HTMLIMTAttrChecker,  
   }),  
   checker => sub {  
     my ($self, $todo) = @_;  
813    
814      if ($todo->{node}->has_attribute_ns (undef, 'src')) {  sub _remove_minus_elements ($$) {
815        return $HTMLEmptyChecker->($self, $todo);    my $self = shift;
816      } else {    my $element_state = shift;
817        ## NOTE: No content model conformance in HTML5 spec.    for my $nsuri (keys %{$element_state->{minus_elements_original}}) {
818        return $AnyChecker->($self, $todo);      for my $ln (keys %{$element_state->{minus_elements_original}->{$nsuri}}) {
819          delete $self->{minus_elements}->{$nsuri}->{$ln};
820      }      }
821    },    }
822  };  } # _remove_minus_elements
   
 ## NOTE: When script is disabled.  
 $Element->{$HTML_NS}->{noscript} = {  
   attrs_checker => $GetHTMLAttrsChecker->({}),  
   checker => sub {  
     my ($self, $todo) = @_;  
   
     my $end = $self->_add_minuses ({$HTML_NS => {noscript => 1}});  
     my ($sib, $ch) = $HTMLBlockOrInlineChecker->($self, $todo);  
     push @$sib, $end;  
     return ($sib, $ch);  
   },  
 };  
   
 $Element->{$HTML_NS}->{'event-source'} = {  
   attrs_checker => $GetHTMLAttrsChecker->({  
     src => $HTMLURIAttrChecker,  
   }),  
   checker => $HTMLEmptyChecker,  
 };  
   
 $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 $end = $self->_add_minuses ({$HTML_NS => {a => 1, datagrid => 1}});  
     my ($sib, $ch) = $HTMLBlockChecker->($self, $todo);  
     push @$sib, $end;  
     return ($sib, $ch);  
   },  
 };  
   
 $Element->{$HTML_NS}->{command} = {  
   attrs_checker => $GetHTMLAttrsChecker->({}), ## TODO  
   checker => $HTMLEmptyChecker,  
 };  
823    
824  $Element->{$HTML_NS}->{menu} = {  sub _add_plus_elements ($$@) {
825    attrs_checker => $GetHTMLAttrsChecker->({}), ## TODO    my $self = shift;
826    checker => sub {    my $element_state = shift;
827      my ($self, $todo) = @_;    for my $elements (@_) {
828      my $el = $todo->{node};      for my $nsuri (keys %$elements) {
829      my $new_todos = [];        for my $ln (keys %{$elements->{$nsuri}}) {
830      my @nodes = (@{$el->child_nodes});          unless ($self->{plus_elements}->{$nsuri}->{$ln}) {
831                  $element_state->{plus_elements_original}->{$nsuri}->{$ln} = 0;
832      my $content = 'li or inline';            $self->{plus_elements}->{$nsuri}->{$ln} = 1;
     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);  
         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';  
           }  
833          }          }
       } elsif ($nt == 5) {  
         unshift @nodes, @{$node->child_nodes};  
834        }        }
835      }      }
836      }
837    } # _add_plus_elements
838    
839      for (@$new_todos) {  sub _remove_plus_elements ($$) {
840        $_->{inline} = 1;    my $self = shift;
841      }    my $element_state = shift;
842      return ($new_todos);    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};
   
 $Element->{$HTML_NS}->{legend} = {  
   attrs_checker => $GetHTMLAttrsChecker->({}),  
   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);  
845      }      }
846      }
847    } # _remove_plus_elements
848    
849      ## ISSUE: Content model is defined only for fieldset/legend,  sub _attr_status_info ($$$) {
850      ## details/legend, and figure/legend.    my ($self, $attr, $status_code) = @_;
   },  
 };  
   
 $Element->{$HTML_NS}->{div} = {  
   attrs_checker => $GetHTMLAttrsChecker->({}),  
   checker => $GetHTMLZeroOrMoreThenBlockOrInlineChecker->($HTML_NS, 'style'),  
 };  
   
 $Element->{$HTML_NS}->{font} = {  
   attrs_checker => $GetHTMLAttrsChecker->({}), ## TODO  
   checker => $HTMLTransparentChecker,  
 };  
   
 sub new ($) {  
   return bless {}, shift;  
 } # new  
   
 sub check_element ($$$) {  
   my ($self, $el, $onerror) = @_;  
851    
852    $self->{minuses} = {};    if (not ($status_code & FEATURE_ALLOWED)) {
853    $self->{onerror} = $onerror;      $self->{onerror}->(node => $attr,
854    $self->{id} = {};                         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 @todo = ({type => 'element', node => $el});    my $status;
867    while (@todo) {    if ($status_code & FEATURE_STATUS_REC) {
868      my $todo = shift @todo;      return;
869      if ($todo->{type} eq 'element') {    } elsif ($status_code & FEATURE_STATUS_CR) {
870        my $prefix = $todo->{node}->prefix;      $status = 'cr';
871        if (defined $prefix and $prefix eq 'xmlns') {    } elsif ($status_code & FEATURE_STATUS_LC) {
872          $self->{onerror}      $status = 'lc';
873            ->(node => $todo->{node},    } elsif ($status_code & FEATURE_STATUS_WD) {
874               type => 'NC:Reserved Prefixes and Namespace Names:<xmlns:>');      $status = 'wd';
875        }    } else {
876        my $nsuri = $todo->{node}->namespace_uri;      $status = 'non-standard';
       $nsuri = '' unless defined $nsuri;  
       my $ln = $todo->{node}->manakai_local_name;  
       my $eldef = $Element->{$nsuri}->{$ln} ||  
         $Element->{$nsuri}->{''} ||  
           $ElementDefault;  
       $eldef->{attrs_checker}->($self, $todo);  
       my ($new_todos) = $eldef->{checker}->($self, $todo);  
       unshift @todo, @$new_todos;  
     } elsif ($todo->{type} eq 'element-attributes') {  
       my $prefix = $todo->{node}->prefix;  
       if (defined $prefix and $prefix eq 'xmlns') {  
         $self->{onerror}  
           ->(node => $todo->{node},  
              type => 'NC:Reserved Prefixes and Namespace Names:<xmlns:>');  
       }  
       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);  
     }  
877    }    }
878  } # check_element    $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;
# Line 2501  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  sub _check_get_children ($$) {  ## NOTE: Priority for "minuses" and "pluses" are currently left
936    my ($self, $node) = @_;  ## 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 ($$$) {
940      my ($self, $node, $parent_todo) = @_;
941    my $new_todos = [];    my $new_todos = [];
942    my $sib = [];    my $sib = [];
943    TP: {    TP: {
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;  
       }  
     }  
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 2549  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
1025      
1026      for my $new_todo (@$new_todos) {
1027        $new_todo->{flag} = {%{$parent_todo->{flag} or {}}};
1028      }
1029      
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.16  
changed lines
  Added in v.1.97

[email protected]
ViewVC Help
Powered by ViewVC 1.1.24