/[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.30 by wakaba, Sun Jun 24 14:24:21 2007 UTC revision 1.97 by wakaba, Sun Sep 21 09:45:02 2008 UTC
# Line 1  Line 1 
1  package Whatpm::ContentChecker;  package Whatpm::ContentChecker;
2  use strict;  use strict;
3    our $VERSION=do{my @r=(q$Revision$=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};
4    
5  require Whatpm::URIChecker;  require Whatpm::URIChecker;
6    
7  ## ISSUE: How XML and XML Namespaces conformance can (or cannot)  ## ISSUE: How XML and XML Namespaces conformance can (or cannot)
8  ## be applied to an in-memory representation (i.e. DOM)?  ## be applied to an in-memory representation (i.e. DOM)?
9    
10    ## TODO: Conformance of an HTML document with non-html root element.
11    
12    ## Stability
13    sub FEATURE_STATUS_REC () { 0b1 } ## Interoperable standard
14    sub FEATURE_STATUS_CR () { 0b10 } ## Call for implementation
15    sub FEATURE_STATUS_LC () { 0b100 } ## Last call for comments
16    sub FEATURE_STATUS_WD () { 0b1000 } ## Working or editor's draft
17    
18    ## Deprecated
19    sub FEATURE_DEPRECATED_SHOULD () { 0b100000 } ## SHOULD-level
20    sub FEATURE_DEPRECATED_INFO () { 0b1000000 } ## Does not affect conformance
21    
22    ## Conformance
23    sub FEATURE_ALLOWED () { 0b10000 }
24    
25    my $HTML_NS = q<http://www.w3.org/1999/xhtml>;
26  my $XML_NS = q<http://www.w3.org/XML/1998/namespace>;  my $XML_NS = q<http://www.w3.org/XML/1998/namespace>;
27  my $XMLNS_NS = q<http://www.w3.org/2000/xmlns/>;  my $XMLNS_NS = q<http://www.w3.org/2000/xmlns/>;
28    
29  my $AttrChecker = {  my $Namespace = {
30      '' => {loaded => 1},
31      q<http://www.w3.org/2005/Atom> => {module => 'Whatpm::ContentChecker::Atom'},
32      q<http://purl.org/syndication/history/1.0>
33          => {module => 'Whatpm::ContentChecker::Atom'},
34      q<http://purl.org/syndication/threading/1.0>
35          => {module => 'Whatpm::ContentChecker::Atom'},
36      $HTML_NS => {module => 'Whatpm::ContentChecker::HTML'},
37      $XML_NS => {loaded => 1},
38      $XMLNS_NS => {loaded => 1},
39      q<http://www.w3.org/1999/02/22-rdf-syntax-ns#> => {loaded => 1},
40    };
41    
42    sub load_ns_module ($) {
43      my $nsuri = shift; # namespace URI or ''
44      unless ($Namespace->{$nsuri}->{loaded}) {
45        if ($Namespace->{$nsuri}->{module}) {
46          eval qq{ require $Namespace->{$nsuri}->{module} } or die $@;
47        } else {
48          $Namespace->{$nsuri}->{loaded} = 1;
49        }
50      }
51    } # load_ns_module
52    
53    our $AttrChecker = {
54    $XML_NS => {    $XML_NS => {
55      space => sub {      space => sub {
56        my ($self, $attr) = @_;        my ($self, $attr) = @_;
# Line 18  my $AttrChecker = { Line 59  my $AttrChecker = {
59          #          #
60        } else {        } else {
61          ## NOTE: An XML "error"          ## NOTE: An XML "error"
62          $self->{onerror}->(node => $attr,          $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 since there is        ## NOTE: Conformance to URI standard is not checked since there is
121        ## no author requirement on conformance in the XML Base specification.        ## no author requirement on conformance in the XML Base specification.
# Line 48  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 62  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 88  my $AttrChecker = { Line 180  my $AttrChecker = {
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 101  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 {        } else {
251          $self->{onerror}->(node => $attr, type => 'attribute not supported');          $self->{onerror}->(node => $attr,
252                               type => 'unknown attribute',
253                               level => $self->{level}->{uncertain});
254        }        }
255          $self->_attr_status_info ($attr, $status);
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         noscript 1      } 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|.    ## and not in |head|.
329  };  };
330    
331  #my $HTMLSemiTransparentElements = {  my $HTMLSemiTransparentElements = {
332  #  $HTML_NS => {qw/video 1 audio 1/},    $HTML_NS => {object => 1, video => 1, audio => 1},
 #};  
   
 my $HTMLEmbededElements = {  
   $HTML_NS => {qw/img 1 iframe 1 embed 1 object 1 video 1 audio 1 canvas 1/},  
333  };  };
334    
335  ## Empty  our $Element = {};
 my $HTMLEmptyChecker = sub {  
   my ($self, $todo) = @_;  
   my $el = $todo->{node};  
   my $new_todos = [];  
   my @nodes = (@{$el->child_nodes});  
336    
337    while (@nodes) {  $Element->{q<http://www.w3.org/1999/02/22-rdf-syntax-ns#>}->{RDF} = {
338      my $node = shift @nodes;    %AnyChecker,
339      $self->_remove_minuses ($node) and next if ref $node eq 'HASH';    status => FEATURE_STATUS_REC | FEATURE_ALLOWED,
340      is_root => 1, ## ISSUE: Not explicitly allowed for non application/rdf+xml
341      my $nt = $node->node_type;    check_start => sub {
342      if ($nt == 1) {      my ($self, $item, $element_state) = @_;
343        ## NOTE: |minuses| list is not checked since redundant      my $triple = [];
344        $self->{onerror}->(node => $node, type => 'element not allowed');      push @{$self->{return}->{rdf}}, [$item->{node}, $triple];
345        my ($sib, $ch) = $self->_check_get_children ($node, $todo);      require Whatpm::RDFXML;
346        unshift @nodes, @$sib;      my $rdf = Whatpm::RDFXML->new;
347        push @$new_todos, @$ch;      ## TODO: Should we make bnodeid unique in a document?
348      } elsif ($nt == 3 or $nt == 4) {      $rdf->{onerror} = $self->{onerror};
349        if ($node->data =~ /[^\x09-\x0D\x20]/) {      $rdf->{level} = $self->{level};
350          $self->{onerror}->(node => $node, type => 'character not allowed');      $rdf->{ontriple} = sub {
351        }        my %opt = @_;
352      } elsif ($nt == 5) {        push @$triple,
353        unshift @nodes, @{$node->child_nodes};            [$opt{node}, $opt{subject}, $opt{predicate}, $opt{object}];
354      }        if (defined $opt{id}) {
355    }          push @$triple,
356    return ($new_todos);              [$opt{node},
357  };               $opt{id},
358                 {uri => q<http://www.w3.org/1999/02/22-rdf-syntax-ns#subject>},
359  ## Text               $opt{subject}];
360  my $HTMLTextChecker = sub {          push @$triple,
361    my ($self, $todo) = @_;              [$opt{node},
362    my $el = $todo->{node};               $opt{id},
363    my $new_todos = [];               {uri => q<http://www.w3.org/1999/02/22-rdf-syntax-ns#predicate>},
364    my @nodes = (@{$el->child_nodes});               $opt{predicate}];
365            push @$triple,
366    while (@nodes) {              [$opt{node},
367      my $node = shift @nodes;               $opt{id},
368      $self->_remove_minuses ($node) and next if ref $node eq 'HASH';               {uri => q<http://www.w3.org/1999/02/22-rdf-syntax-ns#object>},
369                 $opt{object}];
370      my $nt = $node->node_type;          push @$triple,
371      if ($nt == 1) {              [$opt{node},
372        ## NOTE: |minuses| list is not checked since redundant               $opt{id},
373        $self->{onerror}->(node => $node, type => 'element not allowed');               {uri => q<http://www.w3.org/1999/02/22-rdf-syntax-ns#type>},
374        my ($sib, $ch) = $self->_check_get_children ($node, $todo);               {uri => q<http://www.w3.org/1999/02/22-rdf-syntax-ns#Statement>}];
375        unshift @nodes, @$sib;        }
376        push @$new_todos, @$ch;      };
377      } elsif ($nt == 5) {      $rdf->convert_rdf_element ($item->{node});
378        unshift @nodes, @{$node->child_nodes};    },
379      }  };
380    }  
381    return ($new_todos);  my $default_error_level = {
382      must => 'm',
383      should => 's',
384      warn => 'w',
385      good => 'w',
386      undefined => 'w',
387      info => 'i',
388    
389      uncertain => 'u',
390    
391      html4_fact => 'm',
392      html5_no_may => 'm',
393    
394      xml_error => 'm', ## TODO: correct?
395      xml_id_error => 'm', ## TODO: ?
396      nc => 'm', ## XML Namespace Constraints ## TODO: correct?
397    
398      ## |Whatpm::URIChecker|
399      uri_syntax => 'm',
400      uri_fact => 'm',
401      uri_lc_must => 'm',
402      uri_lc_should => 'w',
403    
404      ## |Whatpm::IMTChecker|
405      mime_must => 'm', # lowercase "must"
406      mime_fact => 'm',
407      mime_strongly_discouraged => 'w',
408      mime_discouraged => 'w',
409    
410      ## |Whatpm::LangTag|
411      langtag_fact => 'm',
412    
413      ## |Whatpm::RDFXML|
414      rdf_fact => 'm',
415      rdf_grammer => 'm',
416      rdf_lc_must => 'm',
417    
418      ## |Message::Charset::Info| and |Whatpm::Charset::DecodeHandle|
419      charset_variant => 'm',
420        ## An error caused by use of a variant charset that is not conforming
421        ## to the original charset (e.g. use of 0x80 in an ISO-8859-1 document
422        ## which is interpreted as a Windows-1252 document instead).
423      charset_fact => 'm',
424      iso_shall => 'm',
425  };  };
426    
427  ## Zero or more |html:style| elements,  sub check_document ($$$;$) {
428  ## followed by zero or more block-level elements    my ($self, $doc, $onerror, $onsubdoc) = @_;
429  my $HTMLStylableBlockChecker = sub {    $self = bless {}, $self unless ref $self;
430    my ($self, $todo) = @_;    $self->{onerror} = $onerror;
431    my $el = $todo->{node};    $self->{onsubdoc} = $onsubdoc || sub {
432    my $new_todos = [];      warn "A subdocument is not conformance-checked";
433    my @nodes = (@{$el->child_nodes});    };
     
   my $has_non_style;  
   while (@nodes) {  
     my $node = shift @nodes;  
     $self->_remove_minuses ($node) and next if ref $node eq 'HASH';  
   
     my $nt = $node->node_type;  
     if ($nt == 1) {  
       my $node_ns = $node->namespace_uri;  
       $node_ns = '' unless defined $node_ns;  
       my $node_ln = $node->manakai_local_name;  
       my $not_allowed = $self->{minuses}->{$node_ns}->{$node_ln};  
       if ($node_ns eq $HTML_NS and $node_ln eq 'style') {  
         $not_allowed = 1 if $has_non_style or  
             not $node->has_attribute_ns (undef, 'scoped');  
       } elsif ($HTMLBlockLevelElements->{$node_ns}->{$node_ln}) {  
         $has_non_style = 1;  
       } else {  
         $has_non_style = 1;  
         $not_allowed = 1;  
       }  
       $self->{onerror}->(node => $node, type => 'element not allowed')  
         if $not_allowed;  
       my ($sib, $ch) = $self->_check_get_children ($node, $todo);  
       unshift @nodes, @$sib;  
       push @$new_todos, @$ch;  
     } elsif ($nt == 3 or $nt == 4) {  
       if ($node->data =~ /[^\x09-\x0D\x20]/) {  
         $self->{onerror}->(node => $node, type => 'character not allowed');  
       }  
     } elsif ($nt == 5) {  
       unshift @nodes, @{$node->child_nodes};  
     }  
   }  
   return ($new_todos);  
 }; # $HTMLStylableBlockChecker  
   
 ## Zero or more block-level elements  
 my $HTMLBlockChecker = sub {  
   my ($self, $todo) = @_;  
   my $el = $todo->{node};  
   my $new_todos = [];  
   my @nodes = (@{$el->child_nodes});  
     
   while (@nodes) {  
     my $node = shift @nodes;  
     $self->_remove_minuses ($node) and next if ref $node eq 'HASH';  
   
     my $nt = $node->node_type;  
     if ($nt == 1) {  
       my $node_ns = $node->namespace_uri;  
       $node_ns = '' unless defined $node_ns;  
       my $node_ln = $node->manakai_local_name;  
       my $not_allowed = $self->{minuses}->{$node_ns}->{$node_ln};  
       $not_allowed = 1  
         unless $HTMLBlockLevelElements->{$node_ns}->{$node_ln};  
       $self->{onerror}->(node => $node, type => 'element not allowed')  
         if $not_allowed;  
       my ($sib, $ch) = $self->_check_get_children ($node, $todo);  
       unshift @nodes, @$sib;  
       push @$new_todos, @$ch;  
     } elsif ($nt == 3 or $nt == 4) {  
       if ($node->data =~ /[^\x09-\x0D\x20]/) {  
         $self->{onerror}->(node => $node, type => 'character not allowed');  
       }  
     } elsif ($nt == 5) {  
       unshift @nodes, @{$node->child_nodes};  
     }  
   }  
   return ($new_todos);  
 }; # $HTMLBlockChecker  
   
 ## Inline-level content  
 my $HTMLInlineChecker = sub {  
   my ($self, $todo) = @_;  
   my $el = $todo->{node};  
   my $new_todos = [];  
   my @nodes = (@{$el->child_nodes});  
     
   while (@nodes) {  
     my $node = shift @nodes;  
     $self->_remove_minuses ($node) and next if ref $node eq 'HASH';  
   
     my $nt = $node->node_type;  
     if ($nt == 1) {  
       my $node_ns = $node->namespace_uri;  
       $node_ns = '' unless defined $node_ns;  
       my $node_ln = $node->manakai_local_name;  
       my $not_allowed = $self->{minuses}->{$node_ns}->{$node_ln};  
       $not_allowed = 1  
         unless $HTMLStrictlyInlineLevelElements->{$node_ns}->{$node_ln} or  
           $HTMLStructuredInlineLevelElements->{$node_ns}->{$node_ln};  
       $self->{onerror}->(node => $node, type => 'element not allowed')  
         if $not_allowed;  
       my ($sib, $ch) = $self->_check_get_children ($node, $todo);  
       unshift @nodes, @$sib;  
       push @$new_todos, @$ch;  
     } elsif ($nt == 5) {  
       unshift @nodes, @{$node->child_nodes};  
     }  
   }  
   
   for (@$new_todos) {  
     $_->{inline} = 1;  
   }  
   return ($new_todos);  
 }; # $HTMLInlineChecker  
   
 my $HTMLSignificantInlineChecker = $HTMLInlineChecker;  
 ## TODO: check significant content  
   
 ## Strictly inline-level content  
 my $HTMLStrictlyInlineChecker = sub {  
   my ($self, $todo) = @_;  
   my $el = $todo->{node};  
   my $new_todos = [];  
   my @nodes = (@{$el->child_nodes});  
     
   while (@nodes) {  
     my $node = shift @nodes;  
     $self->_remove_minuses ($node) and next if ref $node eq 'HASH';  
   
     my $nt = $node->node_type;  
     if ($nt == 1) {  
       my $node_ns = $node->namespace_uri;  
       $node_ns = '' unless defined $node_ns;  
       my $node_ln = $node->manakai_local_name;  
       my $not_allowed = $self->{minuses}->{$node_ns}->{$node_ln};  
       $not_allowed = 1  
         unless $HTMLStrictlyInlineLevelElements->{$node_ns}->{$node_ln};  
       $self->{onerror}->(node => $node, type => 'element not allowed')  
         if $not_allowed;  
       my ($sib, $ch) = $self->_check_get_children ($node, $todo);  
       unshift @nodes, @$sib;  
       push @$new_todos, @$ch;  
     } elsif ($nt == 5) {  
       unshift @nodes, @{$node->child_nodes};  
     }  
   }  
434    
435    for (@$new_todos) {    $self->{level} ||= $default_error_level;
     $_->{inline} = 1;  
     $_->{strictly_inline} = 1;  
   }  
   return ($new_todos);  
 }; # $HTMLStrictlyInlineChecker  
436    
437  my $HTMLSignificantStrictlyInlineChecker = $HTMLStrictlyInlineChecker;    ## TODO: If application/rdf+xml, RDF/XML mode should be invoked.
 ## TODO: check significant content  
438    
439  ## Inline-level or strictly inline-kevek content    my $docel = $doc->document_element;
440  my $HTMLInlineOrStrictlyInlineChecker = sub {    unless (defined $docel) {
441    my ($self, $todo) = @_;      ## ISSUE: Should we check content of Document node?
442    my $el = $todo->{node};      $onerror->(node => $doc, type => 'no document element',
443    my $new_todos = [];                 level => $self->{level}->{must});
444    my @nodes = (@{$el->child_nodes});      ## ISSUE: Is this non-conforming (to what spec)?  Or just a warning?
445          return {
446    while (@nodes) {              class => {},
447      my $node = shift @nodes;              id => {}, table => [], term => {},
448      $self->_remove_minuses ($node) and next if ref $node eq 'HASH';             };
   
     my $nt = $node->node_type;  
     if ($nt == 1) {  
       my $node_ns = $node->namespace_uri;  
       $node_ns = '' unless defined $node_ns;  
       my $node_ln = $node->manakai_local_name;  
       my $not_allowed = $self->{minuses}->{$node_ns}->{$node_ln};  
       if ($todo->{strictly_inline}) {  
         $not_allowed = 1  
           unless $HTMLStrictlyInlineLevelElements->{$node_ns}->{$node_ln};  
       } else {  
         $not_allowed = 1  
           unless $HTMLStrictlyInlineLevelElements->{$node_ns}->{$node_ln} or  
             $HTMLStructuredInlineLevelElements->{$node_ns}->{$node_ln};  
       }  
       $self->{onerror}->(node => $node, type => 'element not allowed')  
         if $not_allowed;  
       my ($sib, $ch) = $self->_check_get_children ($node, $todo);  
       unshift @nodes, @$sib;  
       push @$new_todos, @$ch;  
     } elsif ($nt == 5) {  
       unshift @nodes, @{$node->child_nodes};  
     }  
449    }    }
450    
451    for (@$new_todos) {    ## ISSUE: Unexpanded entity references and HTML5 conformance
     $_->{inline} = 1;  
     $_->{strictly_inline} = 1;  
   }  
   return ($new_todos);  
 }; # $HTMLInlineOrStrictlyInlineChecker  
   
 my $HTMLSignificantInlineOrStrictlyInlineChecker  
     = $HTMLInlineOrStrictlyInlineChecker;  
 ## TODO: check significant content  
   
 my $HTMLBlockOrInlineChecker = sub {  
   my ($self, $todo) = @_;  
   my $el = $todo->{node};  
   my $new_todos = [];  
   my @nodes = (@{$el->child_nodes});  
452        
453    my $content = 'block-or-inline'; # or 'block' or 'inline'    my $docel_nsuri = $docel->namespace_uri;
454    my @block_not_inline;    if (defined $docel_nsuri) {
455    while (@nodes) {      load_ns_module ($docel_nsuri);
456      my $node = shift @nodes;    } else {
457      $self->_remove_minuses ($node) and next if ref $node eq 'HASH';      $docel_nsuri = '';
   
     my $nt = $node->node_type;  
     if ($nt == 1) {  
       my $node_ns = $node->namespace_uri;  
       $node_ns = '' unless defined $node_ns;  
       my $node_ln = $node->manakai_local_name;  
       my $not_allowed = $self->{minuses}->{$node_ns}->{$node_ln};  
       if ($content eq 'block') {  
         $not_allowed = 1  
           unless $HTMLBlockLevelElements->{$node_ns}->{$node_ln};  
       } elsif ($content eq 'inline') {  
         $not_allowed = 1  
           unless $HTMLStrictlyInlineLevelElements->{$node_ns}->{$node_ln} or  
             $HTMLStructuredInlineLevelElements->{$node_ns}->{$node_ln};  
       } else {  
         my $is_block = $HTMLBlockLevelElements->{$node_ns}->{$node_ln};  
         my $is_inline  
           = $HTMLStrictlyInlineLevelElements->{$node_ns}->{$node_ln} ||  
             $HTMLStructuredInlineLevelElements->{$node_ns}->{$node_ln};  
           
         push @block_not_inline, $node  
           if $is_block and not $is_inline and not $not_allowed;  
         unless ($is_block) {  
           $content = 'inline';  
           for (@block_not_inline) {  
             $self->{onerror}->(node => $_, type => 'element not allowed');  
           }  
           $not_allowed = 1 unless $is_inline;  
         }  
       }  
       $self->{onerror}->(node => $node, type => 'element not allowed')  
         if $not_allowed;  
       my ($sib, $ch) = $self->_check_get_children ($node, $todo);  
       unshift @nodes, @$sib;  
       push @$new_todos, @$ch;  
     } elsif ($nt == 3 or $nt == 4) {  
       if ($node->data =~ /[^\x09-\x0D\x20]/) {  
         if ($content eq 'block') {  
           $self->{onerror}->(node => $node, type => 'character not allowed');  
         } else {  
           $content = 'inline';  
           for (@block_not_inline) {  
             $self->{onerror}->(node => $_, type => 'element not allowed');  
           }  
         }  
       }  
     } elsif ($nt == 5) {  
       unshift @nodes, @{$node->child_nodes};  
     }  
   }  
   
   if ($content eq 'inline') {  
     for (@$new_todos) {  
       $_->{inline} = 1;  
     }  
458    }    }
459    return ($new_todos);    my $docel_def = $Element->{$docel_nsuri}->{$docel->manakai_local_name} ||
460  };      $Element->{$docel_nsuri}->{''} ||
461        $ElementDefault;
462  ## Zero or more XXX element, then either block-level or inline-level    if ($docel_def->{is_root}) {
463  my $GetHTMLZeroOrMoreThenBlockOrInlineChecker = sub ($$) {      #
464    my ($elnsuri, $ellname) = @_;    } elsif ($docel_def->{is_xml_root}) {
465    return sub {      unless ($doc->manakai_is_html) {
     my ($self, $todo) = @_;  
     my $el = $todo->{node};  
     my $new_todos = [];  
     my @nodes = (@{$el->child_nodes});  
       
     my $has_non_style;  
     my $content = 'block-or-inline'; # or 'block' or 'inline'  
     my @block_not_inline;  
     while (@nodes) {  
       my $node = shift @nodes;  
       $self->_remove_minuses ($node) and next if ref $node eq 'HASH';  
   
       my $nt = $node->node_type;  
       if ($nt == 1) {  
         my $node_ns = $node->namespace_uri;  
         $node_ns = '' unless defined $node_ns;  
         my $node_ln = $node->manakai_local_name;  
         my $not_allowed = $self->{minuses}->{$node_ns}->{$node_ln};  
         if ($node_ns eq $elnsuri and $node_ln eq $ellname) {  
           $not_allowed = 1 if $has_non_style;  
           if ($ellname eq 'style' and  
               not $node->has_attribute_ns (undef, 'scoped')) {  
             $not_allowed = 1;  
           }  
         } elsif ($content eq 'block') {  
           $has_non_style = 1;  
           $not_allowed = 1  
             unless $HTMLBlockLevelElements->{$node_ns}->{$node_ln};  
         } elsif ($content eq 'inline') {  
           $has_non_style = 1;  
           $not_allowed = 1  
             unless $HTMLStrictlyInlineLevelElements->{$node_ns}->{$node_ln} or  
               $HTMLStructuredInlineLevelElements->{$node_ns}->{$node_ln};  
         } else {  
           $has_non_style = 1;  
           my $is_block = $HTMLBlockLevelElements->{$node_ns}->{$node_ln};  
           my $is_inline  
             = $HTMLStrictlyInlineLevelElements->{$node_ns}->{$node_ln} ||  
               $HTMLStructuredInlineLevelElements->{$node_ns}->{$node_ln};  
               
           push @block_not_inline, $node  
             if $is_block and not $is_inline and not $not_allowed;  
           unless ($is_block) {  
             $content = 'inline';  
             for (@block_not_inline) {  
               $self->{onerror}->(node => $_, type => 'element not allowed');  
             }  
             $not_allowed = 1 unless $is_inline;  
           }  
         }  
         $self->{onerror}->(node => $node, type => 'element not allowed')  
           if $not_allowed;  
         my ($sib, $ch) = $self->_check_get_children ($node, $todo);  
         unshift @nodes, @$sib;  
         push @$new_todos, @$ch;  
       } elsif ($nt == 3 or $nt == 4) {  
         if ($node->data =~ /[^\x09-\x0D\x20]/) {  
           $has_non_style = 1;  
           if ($content eq 'block') {  
             $self->{onerror}->(node => $node, type => 'character not allowed');  
           } else {  
             $content = 'inline';  
             for (@block_not_inline) {  
               $self->{onerror}->(node => $_, type => 'element not allowed');  
             }  
           }  
         }  
       } elsif ($nt == 5) {  
         unshift @nodes, @{$node->child_nodes};  
       }  
     }  
   
     if ($content eq 'inline') {  
       for (@$new_todos) {  
         $_->{inline} = 1;  
       }  
     }  
     return ($new_todos);  
   };  
 }; # $GetHTMLZeroOrMoreThenBlockOrInlineChecker  
   
 my $HTMLTransparentChecker = $HTMLBlockOrInlineChecker;  
   
 my $GetHTMLEnumeratedAttrChecker = sub {  
   my $states = shift; # {value => conforming ? 1 : -1}  
   return sub {  
     my ($self, $attr) = @_;  
     my $value = lc $attr->value; ## TODO: ASCII case insensitibility?  
     if ($states->{$value} > 0) {  
466        #        #
     } elsif ($states->{$value}) {  
       $self->{onerror}->(node => $attr,  
                          type => 'non-conforming enumerated attribute value');  
     } else {  
       $self->{onerror}->(node => $attr,  
                          type => 'invalid enumerated attribute value');  
     }  
   };  
 }; # $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);  
     }  
   }  
 }; # $HTMLUnorderedSetOfSpaceSeparatedTokensAttrChecker  
   
 ## |rel| attribute (unordered set of space separated tokens,  
 ## whose allowed values are defined by the section on link types)  
 my $HTMLLinkTypesAttrChecker = sub {  
   my ($a_or_area, $self, $attr) = @_;  
   my %word;  
   for my $word (grep {length $_} split /[\x09-\x0D\x20]/, $attr->value) {  
     unless ($word{$word}) {  
       $word{$word} = 1;  
     } else {  
       $self->{onerror}->(node => $attr, type => 'duplicate token:'.$word);  
     }  
   }  
   ## NOTE: Case sensitive match (since HTML5 spec does not say link  
   ## types are case-insensitive and it says "The value should not  
   ## be confusingly similar to any other defined value (e.g.  
   ## differing only in case).").  
   ## NOTE: Though there is no explicit "MUST NOT" for undefined values,  
   ## "MAY"s and "only ... MAY" restrict non-standard non-registered  
   ## values to be used conformingly.  
   require Whatpm::_LinkTypeList;  
   our $LinkType;  
   for my $word (keys %word) {  
     my $def = $LinkType->{$word};  
     if (defined $def) {  
       if ($def->{status} eq 'accepted') {  
         if (defined $def->{effect}->[$a_or_area]) {  
           #  
         } else {  
           $self->{onerror}->(node => $attr,  
                              type => 'link type bad context:'.$word);  
         }  
       } elsif ($def->{status} eq 'proposal') {  
         $self->{onerror}->(node => $attr,  
                            type => 'proposed link type:'.$word);  
       } else { # rejected or synonym  
         $self->{onerror}->(node => $attr,  
                            type => 'non-conforming link type:'.$word);  
       }  
       if ($def->{unique}) {  
         unless ($self->{has_link_type}->{$word}) {  
           $self->{has_link_type}->{$word} = 1;  
         } else {  
           $self->{onerror}->(node => $attr,  
                              type => 'link with type not unique:'.$word);  
         }  
       }  
467      } else {      } else {
468        $self->{onerror}->(node => $attr,        $onerror->(node => $docel, type => 'element not allowed:root:xml',
469                           type => 'link type not supported:'.$word);                   level => $self->{level}->{must});
470      }      }
   }  
   ## TODO: The Pingback 1.0 specification, which is referenced by HTML5,  
   ## says that using both X-Pingback: header field and HTML  
   ## <link rel=pingback> is deprecated and if both appears they  
   ## SHOULD contain exactly the same value.  
   ## ISSUE: Pingback 1.0 specification defines the exact representation  
   ## of its link element, which cannot be tested by the current arch.  
   ## ISSUE: Pingback 1.0 specification says that the document MUST NOT  
   ## include any string that matches to the pattern for the rel=pingback link,  
   ## which again inpossible to test.  
   ## ISSUE: rel=pingback href MUST NOT include entities other than predefined 4.  
 }; # $HTMLLinkTypesAttrChecker  
   
 ## URI (or IRI)  
 my $HTMLURIAttrChecker = sub {  
   my ($self, $attr) = @_;  
   ## ISSUE: Relative references are allowed? (RFC 3987 "IRI" is an absolute reference with optional fragment identifier.)  
   my $value = $attr->value;  
   Whatpm::URIChecker->check_iri_reference ($value, sub {  
     my %opt = @_;  
     $self->{onerror}->(node => $attr,  
                        type => 'URI:'.$opt{level}.':'.  
                        (defined $opt{position} ? $opt{position} : '').':'.  
                        $opt{type});  
   });  
 }; # $HTMLURIAttrChecker  
   
 ## A space separated list of one or more URIs (or IRIs)  
 my $HTMLSpaceURIsAttrChecker = sub {  
   my ($self, $attr) = @_;  
   my $i = 0;  
   for my $value (split /[\x09-\x0D\x20]+/, $attr->value) {  
     Whatpm::URIChecker->check_iri_reference ($value, sub {  
       my %opt = @_;  
       $self->{onerror}->(node => $attr,  
                          type => 'URI['.$i.']:'.$opt{level}.':'.  
                          (defined $opt{position} ? $opt{position} : '').':'.  
                          $opt{type});  
     });  
     $i++;  
   }  
   ## ISSUE: Relative references?  
   ## ISSUE: Leading or trailing white spaces are conformant?  
   ## ISSUE: A sequence of white space characters are conformant?  
   ## ISSUE: A zero-length string is conformant? (It does contain a relative reference, i.e. same as base URI.)  
   ## NOTE: Duplication seems not an error.  
 }; # $HTMLSpaceURIsAttrChecker  
   
 my $HTMLDatetimeAttrChecker = sub {  
   my ($self, $attr) = @_;  
   my $value = $attr->value;  
   ## ISSUE: "space", not "space character" (in parsing algorihtm, "space character")  
   if ($value =~ /\A([0-9]{4})-([0-9]{2})-([0-9]{2})(?>[\x09-\x0D\x20]+(?>T[\x09-\x0D\x20]*)?|T[\x09-\x0D\x20]*)([0-9]{2}):([0-9]{2})(?>:([0-9]{2}))?(?>\.([0-9]+))?[\x09-\x0D\x20]*(?>Z|[+-]([0-9]{2}):([0-9]{2}))\z/) {  
     my ($y, $M, $d, $h, $m, $s, $f, $zh, $zm)  
         = ($1, $2, $3, $4, $5, $6, $7, $8, $9);  
     if (0 < $M and $M < 13) { ## ISSUE: This is not explicitly specified (though in parsing algorithm)  
       $self->{onerror}->(node => $attr, type => 'datetime:bad day')  
           if $d < 1 or  
               $d > [0, 31, 29, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31]->[$M];  
       $self->{onerror}->(node => $attr, type => 'datetime:bad day')  
           if $M == 2 and $d == 29 and  
               not ($y % 400 == 0 or ($y % 4 == 0 and $y % 100 != 0));  
     } else {  
       $self->{onerror}->(node => $attr, type => 'datetime:bad month');  
     }  
     $self->{onerror}->(node => $attr, type => 'datetime:bad hour') if $h > 23;  
     $self->{onerror}->(node => $attr, type => 'datetime:bad minute') if $m > 59;  
     $self->{onerror}->(node => $attr, type => 'datetime:bad second')  
         if defined $s and $s > 59;  
     $self->{onerror}->(node => $attr, type => 'datetime:bad timezone hour')  
         if $zh > 23;  
     $self->{onerror}->(node => $attr, type => 'datetime:bad timezone minute')  
         if $zm > 59;  
     ## ISSUE: Maybe timezone -00:00 should have same semantics as in RFC 3339.  
471    } else {    } else {
472      $self->{onerror}->(node => $attr, type => 'datetime syntax error');      $onerror->(node => $docel, type => 'element not allowed:root',
473                   level => $self->{level}->{must});
474    }    }
 }; # $HTMLDatetimeAttrChecker  
   
 my $HTMLIntegerAttrChecker = sub {  
   my ($self, $attr) = @_;  
   my $value = $attr->value;  
   unless ($value =~ /\A-?[0-9]+\z/) {  
     $self->{onerror}->(node => $attr, type => 'integer syntax error');  
   }  
 }; # $HTMLIntegerAttrChecker  
   
 my $GetHTMLNonNegativeIntegerAttrChecker = sub {  
   my $range_check = shift;  
   return sub {  
     my ($self, $attr) = @_;  
     my $value = $attr->value;  
     if ($value =~ /\A[0-9]+\z/) {  
       unless ($range_check->($value + 0)) {  
         $self->{onerror}->(node => $attr, type => 'out of range');  
       }  
     } else {  
       $self->{onerror}->(node => $attr,  
                          type => 'non-negative integer syntax error');  
     }  
   };  
 }; # $GetHTMLNonNegativeIntegerAttrChecker  
475    
476  my $GetHTMLFloatingPointNumberAttrChecker = sub {    ## TODO: Check for other items other than document element
477    my $range_check = shift;    ## (second (errorous) element, text nodes, PI nodes, doctype nodes)
   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])*"/;  
   if ($value =~ m#\A$lws0($token)$lws0/$lws0($token)$lws0((?>;$lws0$token$lws0=$lws0(?>$token|$qs)$lws0)*)\z#) {  
     my @type = ($1, $2);  
     my $param = $3;  
     while ($param =~ s/^;$lws0($token)$lws0=$lws0(?>($token)|($qs))$lws0//) {  
       if (defined $2) {  
         push @type, $1 => $2;  
       } else {  
         my $n = $1;  
         my $v = $2;  
         $v =~ s/\\(.)/$1/gs;  
         push @type, $n => $v;  
       }  
     }  
     require Whatpm::IMTChecker;  
     Whatpm::IMTChecker->check_imt (sub {  
       my %opt = @_;  
       $self->{onerror}->(node => $attr,  
                          type => 'IMT:'.$opt{level}.':'.$opt{type});  
     }, @type);  
   } else {  
     $self->{onerror}->(node => $attr, type => 'IMT syntax error');  
   }  
 }; # $HTMLIMTAttrChecker  
   
 my $HTMLLanguageTagAttrChecker = sub {  
   my ($self, $attr) = @_;  
   if ($attr->value eq '') {  
     $self->{onerror}->(node => $attr, type => 'language tag syntax error');  
   }  
   ## TODO: RFC 3066 test  
   ## ISSUE: RFC 4646 (3066bis)?  
 }; # $HTMLLanguageTagAttrChecker  
   
 ## "A valid media query [MQ]"  
 my $HTMLMQAttrChecker = sub {  
   ## ISSUE: What is "a valid media query"?  
 }; # $HTMLMQAttrChecker  
   
 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 $HTMLUsemapAttrChecker = sub {  
   my ($self, $attr) = @_;  
   ## MUST be a valid hashed ID reference to a |map| element  
   my $value = $attr->value;  
   if ($value =~ s/^#//) {  
     ## ISSUE: Is |usemap="#"| conformant? (c.f. |id=""| is non-conformant.)  
     push @{$self->{usemap}}, [$value => $attr];  
   } else {  
     $self->{onerror}->(node => $attr, type => 'hashed idref syntax error');  
   }  
   ## NOTE: Space characters in hashed ID references are conforming.  
   ## ISSUE: UA algorithm for matching is case-insensitive; IDs only different in cases should be reported  
 }; # $HTMLUsemapAttrChecker  
   
 my $HTMLTargetAttrChecker = sub {  
   my ($self, $attr) = @_;  
   my $value = $attr->value;  
   if ($value =~ /^_/) {  
     $value = lc $value; ## ISSUE: ASCII case-insentitive?  
     unless ({  
              _self => 1, _parent => 1, _top => 1,  
             }->{$value}) {  
       $self->{onerror}->(node => $attr,  
                          type => 'reserved browsing context name');  
     }  
   } else {  
     #$ ISSUE: An empty string is conforming?  
   }  
 }; # $HTMLTargetAttrChecker  
   
 my $HTMLAttrChecker = {  
   id => sub {  
     ## NOTE: |map| has its own variant of |id=""| checker  
     my ($self, $attr) = @_;  
     my $value = $attr->value;  
     if (length $value > 0) {  
       if ($self->{id}->{$value}) {  
         $self->{onerror}->(node => $attr, type => 'duplicate ID');  
       } else {  
         $self->{id}->{$value} = 1;  
       }  
       if ($value =~ /[\x09-\x0D\x20]/) {  
         $self->{onerror}->(node => $attr, type => 'space in ID');  
       }  
     } else {  
       ## NOTE: MUST contain at least one character  
       $self->{onerror}->(node => $attr, type => 'attribute value is empty');  
     }  
   },  
   title => sub {}, ## NOTE: No conformance creteria  
   lang => sub {  
     ## TODO: RFC 3066 or empty test  
     ## ISSUE: RFC 4646 (3066bis)?  
     ## TODO: HTML vs XHTML  
   },  
   dir => $GetHTMLEnumeratedAttrChecker->({ltr => 1, rtl => 1}),  
   class => $HTMLUnorderedSetOfSpaceSeparatedTokensAttrChecker,  
   irrelevant => $GetHTMLBooleanAttrChecker->('irrelevant'),  
   tabindex => $HTMLIntegerAttrChecker,  
 };  
   
 for (qw/  
          onabort onbeforeunload onblur onchange onclick oncontextmenu  
          ondblclick ondrag ondragend ondragenter ondragleave ondragover  
          ondragstart ondrop onerror onfocus onkeydown onkeypress  
          onkeyup onload onmessage onmousedown onmousemove onmouseout  
          onmouseover onmouseup onmousewheel onresize onscroll onselect  
          onsubmit onunload  
      /) {  
   $HTMLAttrChecker->{$_} = $HTMLEventHandlerAttrChecker;  
 }  
   
 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} = {  
   is_root => 1,  
   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, $todo);  
         unshift @nodes, @$sib;  
         push @$new_todos, @$ch;  
       } elsif ($nt == 3 or $nt == 4) {  
         if ($node->data =~ /[^\x09-\x0D\x20]/) {  
           $self->{onerror}->(node => $node, type => 'character not allowed');  
         }  
       } elsif ($nt == 5) {  
         unshift @nodes, @{$node->child_nodes};  
       }  
     }  
   
     if ($phase eq 'before head') {  
       $self->{onerror}->(node => $el, type => 'child element missing:head');  
       $self->{onerror}->(node => $el, type => 'child element missing:body');  
     } elsif ($phase eq 'after head') {  
       $self->{onerror}->(node => $el, type => 'child element missing:body');  
     }  
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 ($node_ns eq $HTML_NS and $node_ln eq 'style') {  
           $phase = 'after base';  
           if ($node->has_attribute_ns (undef, 'scoped')) {  
             $not_allowed = 1;  
           }  
         } elsif ($HTMLMetadataElements->{$node_ns}->{$node_ln}) {  
           $phase = 'after base';  
         } else {  
           $not_allowed = 1;  
         }  
         $self->{onerror}->(node => $node, type => 'element not allowed')  
           if $not_allowed;  
         my ($sib, $ch) = $self->_check_get_children ($node, $todo);  
         unshift @nodes, @$sib;  
         push @$new_todos, @$ch;  
       } elsif ($nt == 3 or $nt == 4) {  
         if ($node->data =~ /[^\x09-\x0D\x20]/) {  
           $self->{onerror}->(node => $node, type => 'character not allowed');  
495          }          }
496        } elsif ($nt == 5) {          
497          unshift @nodes, @{$node->child_nodes};          if (not $self->{has_charset} and ## TODO: This does not work now.
498        }              not $charset->{iana_names}->{'us-ascii'}) {
499      }            $onerror->(node => $doc,
500      unless ($has_title) {                       level => $self->{level}->{must},
501        $self->{onerror}->(node => $el, type => 'child element missing:title');                       type => 'no character encoding declaration',
502      }                       text => $charset_name);
     return ($new_todos);  
   },  
 };  
   
 $Element->{$HTML_NS}->{title} = {  
   attrs_checker => $GetHTMLAttrsChecker->({}),  
   checker => $HTMLTextChecker,  
 };  
   
 $Element->{$HTML_NS}->{base} = {  
   attrs_checker => $GetHTMLAttrsChecker->({  
     href => $HTMLURIAttrChecker,  
     target => $HTMLTargetAttrChecker,  
   }),  
   checker => $HTMLEmptyChecker,  
 };  
   
 $Element->{$HTML_NS}->{link} = {  
   attrs_checker => sub {  
     my ($self, $todo) = @_;  
     $GetHTMLAttrsChecker->({  
       href => $HTMLURIAttrChecker,  
       rel => sub { $HTMLLinkTypesAttrChecker->(0, @_) },  
       media => $HTMLMQAttrChecker,  
       hreflang => $HTMLLanguageTagAttrChecker,  
       type => $HTMLIMTAttrChecker,  
       ## NOTE: Though |title| has special semantics,  
       ## syntactically same as the |title| as global attribute.  
     })->($self, $todo);  
     unless ($todo->{node}->has_attribute_ns (undef, 'href')) {  
       $self->{onerror}->(node => $todo->{node},  
                          type => 'attribute missing:href');  
     }  
     unless ($todo->{node}->has_attribute_ns (undef, 'rel')) {  
       $self->{onerror}->(node => $todo->{node},  
                          type => 'attribute missing:rel');  
     }  
   },  
   checker => $HTMLEmptyChecker,  
 };  
   
 $Element->{$HTML_NS}->{meta} = {  
   attrs_checker => sub {  
     my ($self, $todo) = @_;  
     my $name_attr;  
     my $http_equiv_attr;  
     my $charset_attr;  
     my $content_attr;  
     for my $attr (@{$todo->{node}->attributes}) {  
       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}->{''};  
503          }          }
       } else {  
         $checker ||= $AttrChecker->{$attr_ns}->{$attr_ln}  
           || $AttrChecker->{$attr_ns}->{''};  
504        }        }
       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');  
       }  
     }  
505    
506      ## TODO: metadata conformance        if ($charset->{iana_names}->{'utf-8'}) {
   
     ## 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        } else {        } elsif ($charset->{iana_names}->{'jis_x0212-1990'} or
509          $self->{onerror}->(node => $http_equiv_attr,                 $charset->{iana_names}->{'x-jis0208'} or
510                             type => 'invalid enumerated attribute value');                 $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      ## TODO: charset                     text => $charset_name,
515    },                     level => $self->{level}->{should},
516    checker => $HTMLEmptyChecker,                     layer => 'encode');
517  };        } elsif ($charset->{iana_names}->{'cesu-8'} or
518                   $charset->{iana_names}->{'utf-8'} or ## ISSUE: UNICODE-1-1-UTF-7?
519  ## NOTE: |html:style| has no conformance creteria on content model                 $charset->{iana_names}->{'bocu-1'} or
520  $Element->{$HTML_NS}->{style} = {                 $charset->{iana_names}->{'scsu'}) {
521    attrs_checker => $GetHTMLAttrsChecker->({          $onerror->(node => $doc,
522      type => $HTMLIMTAttrChecker, ## TODO: MUST be a styling language                     type => 'disallowed character encoding',
523      media => $HTMLMQAttrChecker,                     text => $charset_name,
524      scoped => $GetHTMLBooleanAttrChecker->('scoped'),                     level => $self->{level}->{must},
525      ## NOTE: |title| has special semantics for |style|s, but is syntactically                     layer => 'encode');
526      ## not different        } else {
527    }),          $onerror->(node => $doc,
528    checker => $AnyChecker,                     type => 'non-utf-8 character encoding',
529  };                     text => $charset_name,
530                       level => $self->{level}->{good},
531  $Element->{$HTML_NS}->{body} = {                     layer => 'encode');
532    attrs_checker => $GetHTMLAttrsChecker->({}),        }
533    checker => $HTMLBlockChecker,      }
534  };    } elsif ($doc->manakai_is_html) {
535        ## NOTE: MUST and SHOULD requirements above cannot be tested,
536  $Element->{$HTML_NS}->{section} = {      ## since the document has no input charset encoding information.
537    attrs_checker => $GetHTMLAttrsChecker->({}),      $onerror->(node => $doc,
538    checker => $HTMLStylableBlockChecker,                 type => 'character encoding unchecked',
539  };                 level => $self->{level}->{info},
540                   layer => 'encode');
541  $Element->{$HTML_NS}->{nav} = {    }
   attrs_checker => $GetHTMLAttrsChecker->({}),  
   checker => $HTMLBlockOrInlineChecker,  
 };  
   
 $Element->{$HTML_NS}->{article} = {  
   attrs_checker => $GetHTMLAttrsChecker->({}),  
   checker => $HTMLStylableBlockChecker,  
 };  
   
 $Element->{$HTML_NS}->{blockquote} = {  
   attrs_checker => $GetHTMLAttrsChecker->({  
     cite => $HTMLURIAttrChecker,  
   }),  
   checker => $HTMLBlockChecker,  
 };  
   
 $Element->{$HTML_NS}->{aside} = {  
   attrs_checker => $GetHTMLAttrsChecker->({}),  
   checker => $GetHTMLZeroOrMoreThenBlockOrInlineChecker->($HTML_NS, 'style'),  
 };  
   
 $Element->{$HTML_NS}->{h1} = {  
   attrs_checker => $GetHTMLAttrsChecker->({}),  
   checker => sub {  
     my ($self, $todo) = @_;  
     $todo->{flag}->{has_heading}->[0] = 1;  
     return $HTMLSignificantStrictlyInlineChecker->($self, $todo);  
   },  
 };  
   
 $Element->{$HTML_NS}->{h2} = {  
   attrs_checker => $GetHTMLAttrsChecker->({}),  
   checker => $Element->{$HTML_NS}->{h1}->{checker},  
 };  
   
 $Element->{$HTML_NS}->{h3} = {  
   attrs_checker => $GetHTMLAttrsChecker->({}),  
   checker => $Element->{$HTML_NS}->{h1}->{checker},  
 };  
   
 $Element->{$HTML_NS}->{h4} = {  
   attrs_checker => $GetHTMLAttrsChecker->({}),  
   checker => $Element->{$HTML_NS}->{h1}->{checker},  
 };  
   
 $Element->{$HTML_NS}->{h5} = {  
   attrs_checker => $GetHTMLAttrsChecker->({}),  
   checker => $Element->{$HTML_NS}->{h1}->{checker},  
 };  
   
 $Element->{$HTML_NS}->{h6} = {  
   attrs_checker => $GetHTMLAttrsChecker->({}),  
   checker => $Element->{$HTML_NS}->{h1}->{checker},  
 };  
   
 $Element->{$HTML_NS}->{header} = {  
   attrs_checker => $GetHTMLAttrsChecker->({}),  
   checker => sub {  
     my ($self, $todo) = @_;  
     my $old_flag = $todo->{flag}->{has_heading} || [];  
     my $new_flag = [];  
     local $todo->{flag}->{has_heading} = $new_flag;  
     my $node = $todo->{node};  
   
     my $end = $self->_add_minuses  
         ({$HTML_NS => {qw/header 1 footer 1/}},  
          $HTMLSectioningElements);  
     my ($new_todos, $ch) = $HTMLBlockChecker->($self, $todo);  
     push @$new_todos, $end,  
         {type => 'code', code => sub {  
            if ($new_flag->[0]) {  
              $old_flag->[0] = 1;  
            } else {  
              $self->{onerror}->(node => $node, type => 'element missing:hn');  
            }  
          }};  
     return ($new_todos, $ch);  
   },  
 };  
   
 $Element->{$HTML_NS}->{footer} = {  
   attrs_checker => $GetHTMLAttrsChecker->({}),  
   checker => sub { ## block -hn -header -footer -sectioning or inline  
     my ($self, $todo) = @_;  
     my $el = $todo->{node};  
     my $new_todos = [];  
     my @nodes = (@{$el->child_nodes});  
     
     my $content = 'block-or-inline'; # or 'block' or 'inline'  
     my @block_not_inline;  
     while (@nodes) {  
       my $node = shift @nodes;  
       $self->_remove_minuses ($node) and next if ref $node eq 'HASH';  
   
       my $nt = $node->node_type;  
       if ($nt == 1) {  
         my $node_ns = $node->namespace_uri;  
         $node_ns = '' unless defined $node_ns;    
         my $node_ln = $node->manakai_local_name;  
         my $not_allowed;  
         if ($self->{minuses}->{$node_ns}->{$node_ln}) {  
           $not_allowed = 1;  
         } elsif ($node_ns eq $HTML_NS and  
                  {  
                    qw/h1 1 h2 1 h3 1 h4 1 h5 1 h6 1 header 1 footer 1/  
                  }->{$node_ln}) {  
           $not_allowed = 1;  
         } elsif ($HTMLSectioningElements->{$node_ns}->{$node_ln}) {  
           $not_allowed = 1;  
         }  
         if ($content eq 'block') {  
           $not_allowed = 1  
             unless $HTMLBlockLevelElements->{$node_ns}->{$node_ln};  
         } elsif ($content eq 'inline') {  
           $not_allowed = 1  
             unless $HTMLStrictlyInlineLevelElements->{$node_ns}->{$node_ln} or  
               $HTMLStructuredInlineLevelElements->{$node_ns}->{$node_ln};  
         } else {  
           my $is_block = $HTMLBlockLevelElements->{$node_ns}->{$node_ln};  
           my $is_inline  
             = $HTMLStrictlyInlineLevelElements->{$node_ns}->{$node_ln} ||  
               $HTMLStructuredInlineLevelElements->{$node_ns}->{$node_ln};  
             
           push @block_not_inline, $node  
             if $is_block and not $is_inline and not $not_allowed;  
           unless ($is_block) {  
             $content = 'inline';  
             for (@block_not_inline) {  
               $self->{onerror}->(node => $_, type => 'element not allowed');  
             }  
             $not_allowed = 1 unless $is_inline;  
           }  
         }  
         $self->{onerror}->(node => $node, type => 'element not allowed')  
           if $not_allowed;  
         my ($sib, $ch) = $self->_check_get_children ($node, $todo);  
         unshift @nodes, @$sib;  
         push @$new_todos, @$ch;  
       } elsif ($nt == 3 or $nt == 4) {  
         if ($node->data =~ /[^\x09-\x0D\x20]/) {  
           if ($content eq 'block') {  
             $self->{onerror}->(node => $node, type => 'character not allowed');  
           } else {  
             $content = 'inline';  
             for (@block_not_inline) {  
               $self->{onerror}->(node => $_, type => 'element not allowed');  
             }  
           }  
         }  
       } elsif ($nt == 5) {  
         unshift @nodes, @{$node->child_nodes};  
       }  
     }  
   
     my $end = $self->_add_minuses  
       ({$HTML_NS => {qw/h1 1 h2 1 h3 1 h4 1 h5 1 h6 1/}},  
        $HTMLSectioningElements);  
     push @$new_todos, $end;  
   
     if ($content eq 'inline') {  
       for (@$new_todos) {  
         $_->{inline} = 1;  
       }  
     }  
   
     return ($new_todos);  
   },  
 };  
   
 $Element->{$HTML_NS}->{address} = {  
   attrs_checker => $GetHTMLAttrsChecker->({}),  
   checker => $HTMLInlineChecker,  
 };  
   
 $Element->{$HTML_NS}->{p} = {  
   attrs_checker => $GetHTMLAttrsChecker->({}),  
   checker => $HTMLSignificantInlineChecker,  
 };  
   
 $Element->{$HTML_NS}->{hr} = {  
   attrs_checker => $GetHTMLAttrsChecker->({}),  
   checker => $HTMLEmptyChecker,  
 };  
   
 $Element->{$HTML_NS}->{br} = {  
   attrs_checker => $GetHTMLAttrsChecker->({}),  
   checker => $HTMLEmptyChecker,  
 };  
   
 $Element->{$HTML_NS}->{dialog} = {  
   attrs_checker => $GetHTMLAttrsChecker->({}),  
   checker => sub {  
     my ($self, $todo) = @_;  
     my $el = $todo->{node};  
     my $new_todos = [];  
     my @nodes = (@{$el->child_nodes});  
   
     my $phase = 'before dt';  
     while (@nodes) {  
       my $node = shift @nodes;  
       $self->_remove_minuses ($node) and next if ref $node eq 'HASH';  
   
       my $nt = $node->node_type;  
       if ($nt == 1) {  
         my $node_ns = $node->namespace_uri;  
         $node_ns = '' unless defined $node_ns;  
         my $node_ln = $node->manakai_local_name;  
         ## NOTE: |minuses| list is not checked since redundant  
         if ($phase eq 'before dt') {  
           if ($node_ns eq $HTML_NS and $node_ln eq 'dt') {  
             $phase = 'before dd';  
           } elsif ($node_ns eq $HTML_NS and $node_ln eq 'dd') {  
             $self->{onerror}  
               ->(node => $node, type => 'ps element missing:dt');  
             $phase = 'before dt';  
           } else {  
             $self->{onerror}->(node => $node, type => 'element not allowed');  
           }  
         } else { # before dd  
           if ($node_ns eq $HTML_NS and $node_ln eq 'dd') {  
             $phase = 'before dt';  
           } elsif ($node_ns eq $HTML_NS and $node_ln eq 'dt') {  
             $self->{onerror}  
               ->(node => $node, type => 'ps element missing:dd');  
             $phase = 'before dd';  
           } else {  
             $self->{onerror}->(node => $node, type => 'element not allowed');  
           }  
         }  
         my ($sib, $ch) = $self->_check_get_children ($node, $todo);  
         unshift @nodes, @$sib;  
         push @$new_todos, @$ch;  
       } elsif ($nt == 3 or $nt == 4) {  
         if ($node->data =~ /[^\x09-\x0D\x20]/) {  
           $self->{onerror}->(node => $node, type => 'character not allowed');  
         }  
       } elsif ($nt == 5) {  
         unshift @nodes, @{$node->child_nodes};  
       }  
     }  
     if ($phase eq 'before dd') {  
       $self->{onerror}->(node => $el, type => 'ps element missing:dd');  
     }  
     return ($new_todos);  
   },  
 };  
   
 $Element->{$HTML_NS}->{pre} = {  
   attrs_checker => $GetHTMLAttrsChecker->({}),  
   checker => $HTMLStrictlyInlineChecker,  
 };  
   
 $Element->{$HTML_NS}->{ol} = {  
   attrs_checker => $GetHTMLAttrsChecker->({  
     start => $HTMLIntegerAttrChecker,  
   }),  
   checker => sub {  
     my ($self, $todo) = @_;  
     my $el = $todo->{node};  
     my $new_todos = [];  
     my @nodes = (@{$el->child_nodes});  
   
     while (@nodes) {  
       my $node = shift @nodes;  
       $self->_remove_minuses ($node) and next if ref $node eq 'HASH';  
   
       my $nt = $node->node_type;  
       if ($nt == 1) {  
         my $node_ns = $node->namespace_uri;  
         $node_ns = '' unless defined $node_ns;  
         my $node_ln = $node->manakai_local_name;  
         ## NOTE: |minuses| list is not checked since redundant  
         unless ($node_ns eq $HTML_NS and $node_ln eq 'li') {  
           $self->{onerror}->(node => $node, type => 'element not allowed');  
         }  
         my ($sib, $ch) = $self->_check_get_children ($node, $todo);  
         unshift @nodes, @$sib;  
         push @$new_todos, @$ch;  
       } elsif ($nt == 3 or $nt == 4) {  
         if ($node->data =~ /[^\x09-\x0D\x20]/) {  
           $self->{onerror}->(node => $node, type => 'character not allowed');  
         }  
       } elsif ($nt == 5) {  
         unshift @nodes, @{$node->child_nodes};  
       }  
     }  
   
     if ($todo->{inline}) {  
       for (@$new_todos) {  
         $_->{inline} = 1;  
       }  
     }  
     return ($new_todos);  
   },  
 };  
   
 $Element->{$HTML_NS}->{ul} = {  
   attrs_checker => $GetHTMLAttrsChecker->({}),  
   checker => $Element->{$HTML_NS}->{ol}->{checker},  
 };  
   
   
 $Element->{$HTML_NS}->{li} = {  
   attrs_checker => $GetHTMLAttrsChecker->({  
     start => sub {  
       my ($self, $attr) = @_;  
       my $parent = $attr->owner_element->manakai_parent_element;  
       if (defined $parent) {  
         my $parent_ns = $parent->namespace_uri;  
         $parent_ns = '' unless defined $parent_ns;  
         my $parent_ln = $parent->manakai_local_name;  
         unless ($parent_ns eq $HTML_NS and $parent_ln eq 'ol') {  
           $self->{onerror}->(node => $attr, 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, $todo);  
         unshift @nodes, @$sib;  
         push @$new_todos, @$ch;  
       } elsif ($nt == 3 or $nt == 4) {  
         if ($node->data =~ /[^\x09-\x0D\x20]/) {  
           $self->{onerror}->(node => $node, type => 'character not allowed');  
         }  
       } elsif ($nt == 5) {  
         unshift @nodes, @{$node->child_nodes};  
       }  
     }  
     if ($phase eq 'in dts') {  
       $self->{onerror}->(node => $el, type => 'ps element missing:dd');  
     }  
   
     if ($todo->{inline}) {  
       for (@$new_todos) {  
         $_->{inline} = 1;  
       }  
     }  
     return ($new_todos);  
   },  
 };  
   
 $Element->{$HTML_NS}->{dt} = {  
   attrs_checker => $GetHTMLAttrsChecker->({}),  
   checker => $HTMLStrictlyInlineChecker,  
 };  
   
 $Element->{$HTML_NS}->{dd} = {  
   attrs_checker => $GetHTMLAttrsChecker->({}),  
   checker => $Element->{$HTML_NS}->{li}->{checker},  
 };  
   
 $Element->{$HTML_NS}->{a} = {  
   attrs_checker => sub {  
     my ($self, $todo) = @_;  
     my %attr;  
     for my $attr (@{$todo->{node}->attributes}) {  
       my $attr_ns = $attr->namespace_uri;  
       $attr_ns = '' unless defined $attr_ns;  
       my $attr_ln = $attr->manakai_local_name;  
       my $checker;  
       if ($attr_ns eq '') {  
         $checker = {  
                      target => $HTMLTargetAttrChecker,  
                      href => $HTMLURIAttrChecker,  
                      ping => $HTMLSpaceURIsAttrChecker,  
                      rel => sub { $HTMLLinkTypesAttrChecker->(1, @_) },  
                      media => $HTMLMQAttrChecker,  
                      hreflang => $HTMLLanguageTagAttrChecker,  
                      type => $HTMLIMTAttrChecker,  
                    }->{$attr_ln};  
         if ($checker) {  
           $attr{$attr_ln} = $attr;  
         } else {  
           $checker = $HTMLAttrChecker->{$attr_ln};  
         }  
       }  
       $checker ||= $AttrChecker->{$attr_ns}->{$attr_ln}  
         || $AttrChecker->{$attr_ns}->{''};  
       if ($checker) {  
         $checker->($self, $attr) if ref $checker;  
       } else {  
         $self->{onerror}->(node => $attr, type => 'attribute not supported');  
         ## ISSUE: No comformance createria for unknown attributes in the spec  
       }  
     }  
   
     unless (defined $attr{href}) {  
       for (qw/target ping rel media hreflang type/) {  
         if (defined $attr{$_}) {  
           $self->{onerror}->(node => $attr{$_},  
                              type => 'attribute not allowed');  
         }  
       }  
     }  
   },  
   checker => sub {  
     my ($self, $todo) = @_;  
   
     my $end = $self->_add_minuses ($HTMLInteractiveElements);  
     my ($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,  
 };  
542    
543  $Element->{$HTML_NS}->{em} = {    return $return;
544    attrs_checker => $GetHTMLAttrsChecker->({}),  } # check_document
   checker => $HTMLInlineOrStrictlyInlineChecker,  
 };  
545    
546  $Element->{$HTML_NS}->{strong} = {  ## 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    checker => $HTMLInlineOrStrictlyInlineChecker,  sub check_element ($$$;$) {
549  };    my ($self, $el, $onerror, $onsubdoc) = @_;
550      $self = bless {}, $self unless ref $self;
551      $self->{onerror} = $onerror;
552      $self->{onsubdoc} = $onsubdoc || sub {
553        warn "A subdocument is not conformance-checked";
554      };
555    
556  $Element->{$HTML_NS}->{small} = {    $self->{level} ||= $default_error_level;
   attrs_checker => $GetHTMLAttrsChecker->({}),  
   checker => $HTMLInlineOrStrictlyInlineChecker,  
 };  
557    
558  $Element->{$HTML_NS}->{m} = {    $self->{plus_elements} = {};
559    attrs_checker => $GetHTMLAttrsChecker->({}),    $self->{minus_elements} = {};
560    checker => $HTMLInlineOrStrictlyInlineChecker,    $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}->{dfn} = {    my @item = ({type => 'element', node => $el, parent_state => {}});
586    attrs_checker => $GetHTMLAttrsChecker->({}),    $item[-1]->{real_parent_state} = $item[-1]->{parent_state};
587    checker => sub {    while (@item) {
588      my ($self, $todo) = @_;      my $item = shift @item;
589        if (ref $item eq 'ARRAY') {
590      my $end = $self->_add_minuses ({$HTML_NS => {dfn => 1}});        my $code = shift @$item;
591      my ($sib, $ch) = $HTMLStrictlyInlineChecker->($self, $todo);  next unless $code;## TODO: temp.
592      push @$sib, $end;        $code->(@$item);
593        } elsif ($item->{type} eq 'element') {
594      my $node = $todo->{node};        my $el_nsuri = $item->{node}->namespace_uri;
595      my $term = $node->get_attribute_ns (undef, 'title');        if (defined $el_nsuri) {
596      unless (defined $term) {          load_ns_module ($el_nsuri);
597        for my $child (@{$node->child_nodes}) {        } else {
598          if ($child->node_type == 1) { # ELEMENT_NODE          $el_nsuri = '';
599            if (defined $term) {        }
600              undef $term;        my $el_ln = $item->{node}->manakai_local_name;
601              last;        
602            } elsif ($child->manakai_local_name eq 'abbr') {        my $element_state = {};
603              my $nsuri = $child->namespace_uri;        my $eldef = $Element->{$el_nsuri}->{$el_ln} ||
604              if (defined $nsuri and $nsuri eq $HTML_NS) {            $Element->{$el_nsuri}->{''} ||
605                my $attr = $child->get_attribute_node_ns (undef, 'title');            $ElementDefault;
606                if ($attr) {        my $content_def = $item->{transparent}
607                  $term = $attr->value;            ? $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              }              }
           }  
         } elsif ($child->node_type == 3 or $child->node_type == 4) {  
           ## TEXT_NODE or CDATA_SECTION_NODE  
           if ($child->data =~ /\A[\x09-\x0D\x20]+\z/) { # Inter-element whitespace  
             next;  
           }  
           undef $term;  
           last;  
         }  
       }  
       unless (defined $term) {  
         $term = $node->text_content;  
       }  
     }  
     if ($self->{term}->{$term}) {  
       $self->{onerror}->(node => $node, type => 'duplicate term');  
     } else {  
       $self->{term}->{$term} = 1;  
     }  
   
     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,  
 };  
683    
684  $Element->{$HTML_NS}->{progress} = { ## TODO: recommended to use content              push @new_item, [$content_def->{check_child_element},
685    attrs_checker => $GetHTMLAttrsChecker->({                               $self, $item, $child,
686      value => $GetHTMLFloatingPointNumberAttrChecker->(sub { shift >= 0 }),                               $child_nsuri, $child_ln,
687      max => $GetHTMLFloatingPointNumberAttrChecker->(sub { shift > 0 }),                               $HTMLSemiTransparentElements
688    }),                                   ->{$child_nsuri}->{$child_ln},
689    checker => $HTMLStrictlyInlineChecker,                               $content_state, $element_state];
690  };              push @new_item, {type => 'element', node => $child,
691                                 parent_def => $content_def,
692  $Element->{$HTML_NS}->{code} = {                               real_parent_state => $element_state,
693    attrs_checker => $GetHTMLAttrsChecker->({}),                               parent_state => $content_state};
694    ## NOTE: Though |title| has special semantics,            }
695    ## syntatically same as the |title| as global attribute.  
696    checker => $HTMLInlineOrStrictlyInlineChecker,            if ($HTMLEmbeddedContent->{$child_nsuri}->{$child_ln}) {
697  };              $element_state->{has_significant} = 1;
698              }
699  $Element->{$HTML_NS}->{var} = {          } elsif ($child_nt == 3 or # TEXT_NODE
700    attrs_checker => $GetHTMLAttrsChecker->({}),                   $child_nt == 4) { # CDATA_SECTION_NODE
701    ## NOTE: Though |title| has special semantics,            my $has_significant = ($child->data =~ /[^\x09\x0A\x0C\x0D\x20]/);
702    ## syntatically same as the |title| as global attribute.            push @new_item, [$content_def->{check_child_text},
703    checker => $HTMLStrictlyInlineChecker,                             $self, $item, $child, $has_significant,
704  };                             $content_state, $element_state];
705              $element_state->{has_significant} ||= $has_significant;
706  $Element->{$HTML_NS}->{samp} = {            if ($has_significant and
707    attrs_checker => $GetHTMLAttrsChecker->({}),                $HTMLSemiTransparentElements->{$el_nsuri}->{$el_ln}) {
708    ## NOTE: Though |title| has special semantics,              $content_def = $item->{parent_def} || $content_def;
709    ## syntatically same as the |title| as global attribute.            }
710    checker => $HTMLInlineOrStrictlyInlineChecker,          } elsif ($child_nt == 5) { # ENTITY_REFERENCE_NODE
711  };            push @child, @{$child->child_nodes};
712            }
713  $Element->{$HTML_NS}->{kbd} = {          ## TODO: PI_NODE
714    attrs_checker => $GetHTMLAttrsChecker->({}),          ## TODO: Unknown node type
715    checker => $HTMLStrictlyInlineChecker,        }
716  };        
717          push @new_item, [$eldef->{check_end}, $self, $item, $element_state];
718  $Element->{$HTML_NS}->{sub} = {        
719    attrs_checker => $GetHTMLAttrsChecker->({}),        unshift @item, @new_item;
   checker => $HTMLStrictlyInlineChecker,  
 };  
   
 $Element->{$HTML_NS}->{sup} = {  
   attrs_checker => $GetHTMLAttrsChecker->({}),  
   checker => $HTMLStrictlyInlineChecker,  
 };  
   
 $Element->{$HTML_NS}->{span} = {  
   attrs_checker => $GetHTMLAttrsChecker->({}),  
   ## NOTE: Though |title| has special semantics,  
   ## syntatically same as the |title| as global attribute.  
   checker => $HTMLInlineOrStrictlyInlineChecker,  
 };  
   
 $Element->{$HTML_NS}->{i} = {  
   attrs_checker => $GetHTMLAttrsChecker->({}),  
   ## NOTE: Though |title| has special semantics,  
   ## syntatically same as the |title| as global attribute.  
   checker => $HTMLStrictlyInlineChecker,  
 };  
   
 $Element->{$HTML_NS}->{b} = {  
   attrs_checker => $GetHTMLAttrsChecker->({}),  
   checker => $HTMLStrictlyInlineChecker,  
 };  
   
 $Element->{$HTML_NS}->{bdo} = {  
   attrs_checker => sub {  
     my ($self, $todo) = @_;  
     $GetHTMLAttrsChecker->({})->($self, $todo);  
     unless ($todo->{node}->has_attribute_ns (undef, 'dir')) {  
       $self->{onerror}->(node => $todo->{node}, type => 'attribute missing:dir');  
     }  
   },  
   ## ISSUE: The spec does not directly say that |dir| is a enumerated attr.  
   checker => $HTMLStrictlyInlineChecker,  
 };  
   
 $Element->{$HTML_NS}->{ins} = {  
   attrs_checker => $GetHTMLAttrsChecker->({  
     cite => $HTMLURIAttrChecker,  
     datetime => $HTMLDatetimeAttrChecker,  
   }),  
   checker => $HTMLTransparentChecker,  
 };  
   
 $Element->{$HTML_NS}->{del} = {  
   attrs_checker => $GetHTMLAttrsChecker->({  
     cite => $HTMLURIAttrChecker,  
     datetime => $HTMLDatetimeAttrChecker,  
   }),  
   checker => sub {  
     my ($self, $todo) = @_;  
   
     my $parent = $todo->{node}->manakai_parent_element;  
     if (defined $parent) {  
       my $nsuri = $parent->namespace_uri;  
       $nsuri = '' unless defined $nsuri;  
       my $ln = $parent->manakai_local_name;  
       my $eldef = $Element->{$nsuri}->{$ln} ||  
         $Element->{$nsuri}->{''} ||  
         $ElementDefault;  
       return $eldef->{checker}->($self, $todo);  
     } else {  
       return $HTMLBlockOrInlineChecker->($self, $todo);  
     }  
   },  
 };  
   
 ## TODO: figure  
   
 $Element->{$HTML_NS}->{img} = {  
   attrs_checker => sub {  
     my ($self, $todo) = @_;  
     $GetHTMLAttrsChecker->({  
       alt => sub { }, ## NOTE: No syntactical requirement  
       src => $HTMLURIAttrChecker,  
       usemap => $HTMLUsemapAttrChecker,  
       ismap => $GetHTMLBooleanAttrChecker->('ismap'), ## TODO: MUST ancestor <a>  
       ## TODO: height  
       ## TODO: width  
     })->($self, $todo);  
     unless ($todo->{node}->has_attribute_ns (undef, 'alt')) {  
       $self->{onerror}->(node => $todo->{node}, type => 'attribute missing:alt');  
     }  
     unless ($todo->{node}->has_attribute_ns (undef, 'src')) {  
       $self->{onerror}->(node => $todo->{node}, type => 'attribute missing:src');  
     }  
   },  
   checker => $HTMLEmptyChecker,  
 };  
   
 $Element->{$HTML_NS}->{iframe} = {  
   attrs_checker => $GetHTMLAttrsChecker->({  
     src => $HTMLURIAttrChecker,  
   }),  
   checker => $HTMLTextChecker,  
 };  
   
 $Element->{$HTML_NS}->{embed} = {  
   attrs_checker => sub {  
     my ($self, $todo) = @_;  
     my $has_src;  
     for my $attr (@{$todo->{node}->attributes}) {  
       my $attr_ns = $attr->namespace_uri;  
       $attr_ns = '' unless defined $attr_ns;  
       my $attr_ln = $attr->manakai_local_name;  
       my $checker;  
       if ($attr_ns eq '') {  
         if ($attr_ln eq 'src') {  
           $checker = $HTMLURIAttrChecker;  
           $has_src = 1;  
         } elsif ($attr_ln eq 'type') {  
           $checker = $HTMLIMTAttrChecker;  
         } else {  
           ## TODO: height  
           ## TODO: width  
           $checker = $HTMLAttrChecker->{$attr_ln}  
             || sub { }; ## NOTE: Any local attribute is ok.  
         }  
       }  
       $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 => sub {  
     my ($self, $todo) = @_;  
     $GetHTMLAttrsChecker->({  
       data => $HTMLURIAttrChecker,  
       type => $HTMLIMTAttrChecker,  
       usemap => $HTMLUsemapAttrChecker,  
       ## TODO: width  
       ## TODO: height  
     })->($self, $todo);  
     unless ($todo->{node}->has_attribute_ns (undef, 'data')) {  
       unless ($todo->{node}->has_attribute_ns (undef, 'type')) {  
         $self->{onerror}->(node => $todo->{node},  
                            type => 'attribute missing:data|type');  
       }  
     }  
   },  
   checker => $ElementDefault->{checker}, ## TODO  
 };  
   
 $Element->{$HTML_NS}->{param} = {  
   attrs_checker => sub {  
     my ($self, $todo) = @_;  
     $GetHTMLAttrsChecker->({  
       name => sub { },  
       value => sub { },  
     })->($self, $todo);  
     unless ($todo->{node}->has_attribute_ns (undef, 'name')) {  
       $self->{onerror}->(node => $todo->{node},  
                          type => 'attribute missing:name');  
     }  
     unless ($todo->{node}->has_attribute_ns (undef, 'value')) {  
       $self->{onerror}->(node => $todo->{node},  
                          type => 'attribute missing:value');  
     }  
   },  
   checker => $HTMLEmptyChecker,  
 };  
   
 $Element->{$HTML_NS}->{video} = {  
   attrs_checker => $GetHTMLAttrsChecker->({  
     src => $HTMLURIAttrChecker,  
     ## TODO: start, loopstart, loopend, end  
     ## ISSUE: they MUST be "value time offset"s.  Value?  
     ## ISSUE: loopcount has no conformance creteria  
     autoplay => $GetHTMLBooleanAttrChecker->('autoplay'),  
     controls => $GetHTMLBooleanAttrChecker->('controls'),  
   }),  
   checker => sub {  
     my ($self, $todo) = @_;  
   
     if ($todo->{node}->has_attribute_ns (undef, 'src')) {  
       return $HTMLBlockOrInlineChecker->($self, $todo);  
720      } else {      } else {
721        return $GetHTMLZeroOrMoreThenBlockOrInlineChecker->($HTML_NS, 'source')        die "$0: Internal error: Unsupported checking action type |$item->{type}|";
         ->($self, $todo);  
     }  
   },  
 };  
   
 $Element->{$HTML_NS}->{audio} = {  
   attrs_checker => $Element->{$HTML_NS}->{video}->{attrs_checker},  
   checker => $Element->{$HTML_NS}->{video}->{checker},  
 };  
   
 $Element->{$HTML_NS}->{source} = {  
   attrs_checker => sub {  
     my ($self, $todo) = @_;  
     $GetHTMLAttrsChecker->({  
       src => $HTMLURIAttrChecker,  
       type => $HTMLIMTAttrChecker,  
       media => $HTMLMQAttrChecker,  
     })->($self, $todo);  
     unless ($todo->{node}->has_attribute_ns (undef, 'src')) {  
       $self->{onerror}->(node => $todo->{node},  
                          type => 'attribute missing:src');  
     }  
   },  
   checker => $HTMLEmptyChecker,  
 };  
   
 $Element->{$HTML_NS}->{canvas} = {  
   attrs_checker => $GetHTMLAttrsChecker->({  
     height => $GetHTMLNonNegativeIntegerAttrChecker->(sub { 1 }),  
     width => $GetHTMLNonNegativeIntegerAttrChecker->(sub { 1 }),  
   }),  
   checker => $HTMLInlineChecker,  
 };  
   
 $Element->{$HTML_NS}->{map} = {  
   attrs_checker => $GetHTMLAttrsChecker->({  
     id => sub {  
       ## NOTE: same as global |id=""|, with |$self->{map}| registeration  
       my ($self, $attr) = @_;  
       my $value = $attr->value;  
       if (length $value > 0) {  
         if ($self->{id}->{$value}) {  
           $self->{onerror}->(node => $attr, type => 'duplicate ID');  
         } else {  
           $self->{id}->{$value} = 1;  
         }  
       } else {  
         ## NOTE: MUST contain at least one character  
         $self->{onerror}->(node => $attr, type => 'attribute value is empty');  
       }  
       if ($value =~ /[\x09-\x0D\x20]/) {  
         $self->{onerror}->(node => $attr, type => 'space in ID');  
       }  
       $self->{map}->{$value} ||= $attr;  
     },  
   }),  
   checker => $HTMLBlockChecker,  
 };  
   
 $Element->{$HTML_NS}->{area} = {  
   attrs_checker => sub {  
     my ($self, $todo) = @_;  
     my %attr;  
     my $coords;  
     for my $attr (@{$todo->{node}->attributes}) {  
       my $attr_ns = $attr->namespace_uri;  
       $attr_ns = '' unless defined $attr_ns;  
       my $attr_ln = $attr->manakai_local_name;  
       my $checker;  
       if ($attr_ns eq '') {  
         $checker = {  
                      alt => sub { },  
                          ## NOTE: |alt| value has no conformance creteria.  
                      shape => $GetHTMLEnumeratedAttrChecker->({  
                        circ => -1, circle => 1,  
                        default => 1,  
                        poly => 1, polygon => -1,  
                        rect => 1, rectangle => -1,  
                      }),  
                      coords => sub {  
                        my ($self, $attr) = @_;  
                        my $value = $attr->value;  
                        if ($value =~ /\A-?[0-9]+(?>,-?[0-9]+)*\z/) {  
                          $coords = [split /,/, $value];  
                        } else {  
                          $self->{onerror}->(node => $attr,  
                                             type => 'syntax error');  
                        }  
                      },  
                      target => $HTMLTargetAttrChecker,  
                      href => $HTMLURIAttrChecker,  
                      ping => $HTMLSpaceURIsAttrChecker,  
                      rel => sub { $HTMLLinkTypesAttrChecker->(1, @_) },  
                      media => $HTMLMQAttrChecker,  
                      hreflang => $HTMLLanguageTagAttrChecker,  
                      type => $HTMLIMTAttrChecker,  
                    }->{$attr_ln};  
         if ($checker) {  
           $attr{$attr_ln} = $attr;  
         } else {  
           $checker = $HTMLAttrChecker->{$attr_ln};  
         }  
       }  
       $checker ||= $AttrChecker->{$attr_ns}->{$attr_ln}  
         || $AttrChecker->{$attr_ns}->{''};  
       if ($checker) {  
         $checker->($self, $attr) if ref $checker;  
       } else {  
         $self->{onerror}->(node => $attr, type => 'attribute not supported');  
         ## ISSUE: No comformance createria for unknown attributes in the spec  
       }  
     }  
   
     if (defined $attr{href}) {  
       unless (defined $attr{alt}) {  
         $self->{onerror}->(node => $todo->{node},  
                            type => 'attribute missing:alt');  
       }  
     } else {  
       for (qw/target ping rel media hreflang type alt/) {  
         if (defined $attr{$_}) {  
           $self->{onerror}->(node => $attr{$_},  
                              type => 'attribute not allowed');  
         }  
       }  
     }  
   
     my $shape = 'rectangle';  
     if (defined $attr{shape}) {  
       $shape = {  
                 circ => 'circle', circle => 'circle',  
                 default => 'default',  
                 poly => 'polygon', polygon => 'polygon',  
                 rect => 'rectangle', rectangle => 'rectangle',  
                }->{lc $attr{shape}->value} || 'rectangle';  
       ## TODO: ASCII lowercase?  
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            } else {              $el->manakai_local_name eq 'datatemplate') {
734              $self->{onerror}->(node => $attr{coords},            my $nsuri = $el->namespace_uri;
735                                 type => 'list item number:3:'.@$coords);            if (defined $nsuri and $nsuri eq $HTML_NS) {
736            }              if ($el eq $_->[1]->owner_element) {
737          } else {                $self->{onerror}->(node => $_->[1],
738            ## NOTE: A syntax error has been reported.                                   type => 'fragment points itself',
739          }                                   level => $self->{level}->{must});
       } 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);  
740              }              }
741            } else {              
742              $self->{onerror}->(node => $attr{coords},              last F;
                                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, $todo);  
         unshift @nodes, @$sib;  
         push @$new_todos, @$ch;  
       } elsif ($nt == 3 or $nt == 4) {  
         if ($node->data =~ /[^\x09-\x0D\x20]/) {  
           $self->{onerror}->(node => $node, type => 'character not allowed');  
         }  
       } elsif ($nt == 5) {  
         unshift @nodes, @{$node->child_nodes};  
764        }        }
765        } else {
766          $self->{onerror}->(node => $_->[1], type => 'fragment points nothing',
767                             level => $self->{level}->{must});
768      }      }
769      }
770    
771      ## Table model errors    ## TODO: Maybe we should have $document->manakai_get_by_fragment or something
     require Whatpm::HTMLTable;  
     Whatpm::HTMLTable->form_table ($todo->{node}, sub {  
       my %opt = @_;  
       $self->{onerror}->(type => 'table:'.$opt{type}, node => $opt{node});  
     });  
   
     return ($new_todos);  
   },  
 };  
   
 $Element->{$HTML_NS}->{caption} = {  
   attrs_checker => $GetHTMLAttrsChecker->({}),  
   checker => $HTMLSignificantStrictlyInlineChecker,  
 };  
772    
773  $Element->{$HTML_NS}->{colgroup} = {    for (@{$self->{usemap}}) {
774    attrs_checker => $GetHTMLAttrsChecker->({      unless ($self->{map}->{$_->[0]}) {
775      span => $GetHTMLNonNegativeIntegerAttrChecker->(sub { shift > 0 }),        $self->{onerror}->(node => $_->[1], type => 'no referenced map',
776        ## NOTE: Defined only if "the |colgroup| element contains no |col| elements"                           level => $self->{level}->{must});
       ## TODO: "attribute not supported" if |col|.  
       ## ISSUE: MUST NOT if any |col|?  
       ## ISSUE: MUST NOT for |<colgroup span="1"><any><col/></any></colgroup>| (though non-conforming)?  
   }),  
   checker => sub {  
     my ($self, $todo) = @_;  
     my $el = $todo->{node};  
     my $new_todos = [];  
     my @nodes = (@{$el->child_nodes});  
   
     while (@nodes) {  
       my $node = shift @nodes;  
       $self->_remove_minuses ($node) and next if ref $node eq 'HASH';  
   
       my $nt = $node->node_type;  
       if ($nt == 1) {  
         my $node_ns = $node->namespace_uri;  
         $node_ns = '' unless defined $node_ns;  
         my $node_ln = $node->manakai_local_name;  
         ## NOTE: |minuses| list is not checked since redundant  
         unless ($node_ns eq $HTML_NS and $node_ln eq 'col') {  
           $self->{onerror}->(node => $node, type => 'element not allowed');  
         }  
         my ($sib, $ch) = $self->_check_get_children ($node, $todo);  
         unshift @nodes, @$sib;  
         push @$new_todos, @$ch;  
       } elsif ($nt == 3 or $nt == 4) {  
         if ($node->data =~ /[^\x09-\x0D\x20]/) {  
           $self->{onerror}->(node => $node, type => 'character not allowed');  
         }  
       } elsif ($nt == 5) {  
         unshift @nodes, @{$node->child_nodes};  
       }  
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, $todo);  
         unshift @nodes, @$sib;  
         push @$new_todos, @$ch;  
       } elsif ($nt == 3 or $nt == 4) {  
         if ($node->data =~ /[^\x09-\x0D\x20]/) {  
           $self->{onerror}->(node => $node, type => 'character not allowed');  
         }  
       } elsif ($nt == 5) {  
         unshift @nodes, @{$node->child_nodes};  
       }  
     }  
     unless ($has_tr) {  
       $self->{onerror}->(node => $el, type => 'child element missing:tr');  
784      }      }
785      return ($new_todos);    }
   },  
 };  
   
 $Element->{$HTML_NS}->{thead} = {  
   attrs_checker => $GetHTMLAttrsChecker->({}),  
   checker => $Element->{$HTML_NS}->{tbody}->{checker},  
 };  
786    
787  $Element->{$HTML_NS}->{tfoot} = {    delete $self->{plus_elements};
788    attrs_checker => $GetHTMLAttrsChecker->({}),    delete $self->{minus_elements};
789    checker => $Element->{$HTML_NS}->{tbody}->{checker},    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, $todo);  
         unshift @nodes, @$sib;  
         push @$new_todos, @$ch;  
       } elsif ($nt == 3 or $nt == 4) {  
         if ($node->data =~ /[^\x09-\x0D\x20]/) {  
           $self->{onerror}->(node => $node, type => 'character not allowed');  
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: forms  
   
 $Element->{$HTML_NS}->{script} = {  
   attrs_checker => sub {  
     my ($self, $todo) = @_;  
     $GetHTMLAttrsChecker->({  
       src => $HTMLURIAttrChecker,  
       defer => $GetHTMLBooleanAttrChecker->('defer'),  
       async => $GetHTMLBooleanAttrChecker->('async'),  
       type => $HTMLIMTAttrChecker,  
     })->($self, $todo);  
     if ($todo->{node}->has_attribute_ns (undef, 'defer')) {  
       my $async_attr = $todo->{node}->get_attribute_node_ns (undef, 'async');  
       if ($async_attr) {  
         $self->{onerror}->(node => $async_attr,  
                            type => 'attribute not allowed'); # MUST NOT  
       }  
     }  
   },  
   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);  
   },  
 };  
 ## TODO: noscript in head  
   
 $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);  
     ## TODO: (Block-table)+ | table | select | datalist  
     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, $todo);  
         unshift @nodes, @$sib;  
         push @$new_todos, @$ch;  
       } elsif ($nt == 3 or $nt == 4) {  
         if ($node->data =~ /[^\x09-\x0D\x20]/) {  
           if ($content eq 'li') {  
             $self->{onerror}->(node => $node, type => 'character not allowed');  
           } elsif ($content eq 'li or inline') {  
             $content = 'inline';  
           }  
833          }          }
       } elsif ($nt == 5) {  
         unshift @nodes, @{$node->child_nodes};  
834        }        }
835      }      }
   
     for (@$new_todos) {  
       $_->{inline} = 1;  
     }  
     return ($new_todos);  
   },  
 };  
   
 $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);  
     }  
   
     ## ISSUE: Content model is defined only for fieldset/legend,  
     ## details/legend, and figure/legend.  
   },  
 };  
   
 $Element->{$HTML_NS}->{div} = {  
   attrs_checker => $GetHTMLAttrsChecker->({}),  
   checker => $GetHTMLZeroOrMoreThenBlockOrInlineChecker->($HTML_NS, 'style'),  
 };  
   
 $Element->{$HTML_NS}->{font} = {  
   attrs_checker => $GetHTMLAttrsChecker->({}), ## TODO  
   checker => $HTMLTransparentChecker,  
 };  
   
 sub check_document ($$$) {  
   my ($self, $doc, $onerror) = @_;  
   $self = bless {}, $self unless ref $self;  
   $self->{onerror} = $onerror;  
   
   my $docel = $doc->document_element;  
   unless (defined $docel) {  
     ## ISSUE: Should we check content of Document node?  
     $onerror->(node => $doc, type => 'no document element');  
     ## ISSUE: Is this non-conforming (to what spec)?  Or just a warning?  
     return;  
836    }    }
837    } # _add_plus_elements
838    
839    ## ISSUE: Unexpanded entity references and HTML5 conformance  sub _remove_plus_elements ($$) {
840        my $self = shift;
841    my $docel_nsuri = $docel->namespace_uri;    my $element_state = shift;
842    $docel_nsuri = '' unless defined $docel_nsuri;    for my $nsuri (keys %{$element_state->{plus_elements_original}}) {
843    my $docel_def = $Element->{$docel_nsuri}->{$docel->manakai_local_name} ||      for my $ln (keys %{$element_state->{plus_elements_original}->{$nsuri}}) {
844      $Element->{$docel_nsuri}->{''} ||        delete $self->{plus_elements}->{$nsuri}->{$ln};
845      $ElementDefault;      }
   if ($docel_def->{is_root}) {  
     #  
   } else {  
     $onerror->(node => $docel, type => 'element not allowed');  
846    }    }
847    } # _remove_plus_elements
848    
849    ## TODO: Check for other items other than document element  sub _attr_status_info ($$$) {
850    ## (second (errorous) element, text nodes, PI nodes, doctype nodes)    my ($self, $attr, $status_code) = @_;
   
   $self->check_element ($docel, $onerror);  
 } # check_document  
851    
852  sub check_element ($$$) {    if (not ($status_code & FEATURE_ALLOWED)) {
853    my ($self, $el, $onerror) = @_;      $self->{onerror}->(node => $attr,
854    $self = bless {}, $self unless ref $self;                         type => 'attribute not defined',
855    $self->{onerror} = $onerror;                         level => $self->{level}->{must});
856      } elsif ($status_code & FEATURE_DEPRECATED_SHOULD) {
857    $self->{minuses} = {};      $self->{onerror}->(node => $attr,
858    $self->{id} = {};                         type => 'deprecated:attr',
859    $self->{term} = {};                         level => $self->{level}->{should});
860    $self->{usemap} = [];    } elsif ($status_code & FEATURE_DEPRECATED_INFO) {
861    $self->{map} = {};      $self->{onerror}->(node => $attr,
862    $self->{has_link_type} = {};                         type => 'deprecated:attr',
863                           level => $self->{level}->{info});
   my @todo = ({type => 'element', node => $el});  
   while (@todo) {  
     my $todo = shift @todo;  
     if ($todo->{type} eq 'element') {  
       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);  
       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);  
     } elsif ($todo->{type} eq 'code') {  
       $todo->{code}->();  
     } else {  
       die "$0: Internal error: Unsupported checking action type |$todo->{type}|";  
     }  
864    }    }
865    
866    for (@{$self->{usemap}}) {    my $status;
867      unless ($self->{map}->{$_->[0]}) {    if ($status_code & FEATURE_STATUS_REC) {
868        $self->{onerror}->(node => $_->[1], type => 'no referenced map');      return;
869      }    } elsif ($status_code & FEATURE_STATUS_CR) {
870        $status = 'cr';
871      } elsif ($status_code & FEATURE_STATUS_LC) {
872        $status = 'lc';
873      } elsif ($status_code & FEATURE_STATUS_WD) {
874        $status = 'wd';
875      } else {
876        $status = 'non-standard';
877    }    }
878      $self->{onerror}->(node => $attr,
879    delete $self->{minuses};                       type => 'status:'.$status.':attr',
880    delete $self->{onerror};                       level => $self->{level}->{info});
881    delete $self->{id};  } # _attr_status_info
   delete $self->{usemap};  
   delete $self->{map};  
 } # check_element  
882    
883  sub _add_minuses ($@) {  sub _add_minuses ($@) {
884    my $self = shift;    my $self = shift;
# Line 2901  sub _add_minuses ($@) { Line 896  sub _add_minuses ($@) {
896    return {type => 'plus', list => $r};    return {type => 'plus', list => $r};
897  } # _add_minuses  } # _add_minuses
898    
899    sub _add_pluses ($@) {
900      my $self = shift;
901      my $r = {};
902      for my $list (@_) {
903        for my $ns (keys %$list) {
904          for my $ln (keys %{$list->{$ns}}) {
905            unless ($self->{pluses}->{$ns}->{$ln}) {
906              $self->{pluses}->{$ns}->{$ln} = 1;
907              $r->{$ns}->{$ln} = 1;
908            }
909          }
910        }
911      }
912      return {type => 'minus', list => $r};
913    } # _add_pluses
914    
915  sub _remove_minuses ($$) {  sub _remove_minuses ($$) {
916    my ($self, $todo) = @_;    my ($self, $todo) = @_;
917    for my $ns (keys %{$todo->{list}}) {    if ($todo->{type} eq 'minus') {
918      for my $ln (keys %{$todo->{list}->{$ns}}) {      for my $ns (keys %{$todo->{list}}) {
919        delete $self->{minuses}->{$ns}->{$ln} if $todo->{list}->{$ns}->{$ln};        for my $ln (keys %{$todo->{list}->{$ns}}) {
920            delete $self->{pluses}->{$ns}->{$ln} if $todo->{list}->{$ns}->{$ln};
921          }
922      }      }
923      } elsif ($todo->{type} eq 'plus') {
924        for my $ns (keys %{$todo->{list}}) {
925          for my $ln (keys %{$todo->{list}->{$ns}}) {
926            delete $self->{minuses}->{$ns}->{$ln} if $todo->{list}->{$ns}->{$ln};
927          }
928        }
929      } else {
930        die "$0: Unknown +- type: $todo->{type}";
931    }    }
932    1;    1;
933  } # _remove_minuses  } # _remove_minuses
934    
935    ## NOTE: Priority for "minuses" and "pluses" are currently left
936    ## undefined and implemented inconsistently; it is not a problem for
937    ## now, since no element belongs to both lists.
938    
939  sub _check_get_children ($$$) {  sub _check_get_children ($$$) {
940    my ($self, $node, $parent_todo) = @_;    my ($self, $node, $parent_todo) = @_;
941    my $new_todos = [];    my $new_todos = [];
# Line 2919  sub _check_get_children ($$$) { Line 944  sub _check_get_children ($$$) {
944      my $node_ns = $node->namespace_uri;      my $node_ns = $node->namespace_uri;
945      $node_ns = '' unless defined $node_ns;      $node_ns = '' unless defined $node_ns;
946      my $node_ln = $node->manakai_local_name;      my $node_ln = $node->manakai_local_name;
     if ($node_ns eq $HTML_NS) {  
       if ($node_ln eq 'noscript') {  
         my $end = $self->_add_minuses ({$HTML_NS, {noscript => 1}});  
         push @$sib, $end;  
       }  
     }  
     ## TODO: |script| is not a transparent element in |head|.  
947      if ($HTMLTransparentElements->{$node_ns}->{$node_ln}) {      if ($HTMLTransparentElements->{$node_ns}->{$node_ln}) {
948        unshift @$sib, @{$node->child_nodes};        if ($node_ns eq $HTML_NS and $node_ln eq 'noscript') {
949        push @$new_todos, {type => 'element-attributes', node => $node};          if ($parent_todo->{flag}->{in_head}) {
950        last TP;            #
951            } else {
952              my $end = $self->_add_minuses ({$HTML_NS, {noscript => 1}});
953              push @$sib, $end;
954              
955              unshift @$sib, @{$node->child_nodes};
956              push @$new_todos, {type => 'element-attributes', node => $node};
957              last TP;
958            }
959          } elsif ($node_ns eq $HTML_NS and $node_ln eq 'del') {
960            my $sig_flag = $parent_todo->{flag}->{has_descendant}->{significant};
961            unshift @$sib, @{$node->child_nodes};
962            push @$new_todos, {type => 'element-attributes', node => $node};
963            push @$new_todos,
964                {type => 'code',
965                 code => sub {
966                   $parent_todo->{flag}->{has_descendant}->{significant} = 0
967                       if not $sig_flag;
968                 }};
969            last TP;
970          } else {
971            unshift @$sib, @{$node->child_nodes};
972            push @$new_todos, {type => 'element-attributes', node => $node};
973            last TP;
974          }
975      }      }
976      if ($node_ns eq $HTML_NS and ($node_ln eq 'video' or $node_ln eq 'audio')) {      if ($node_ns eq $HTML_NS and ($node_ln eq 'video' or $node_ln eq 'audio')) {
977        if ($node->has_attribute_ns (undef, 'src')) {        if ($node->has_attribute_ns (undef, 'src')) {
# Line 2950  sub _check_get_children ($$$) { Line 992  sub _check_get_children ($$$) {
992                last CN;                last CN;
993              }              }
994            } elsif ($cnt == 3 or $cnt == 4) {            } elsif ($cnt == 3 or $cnt == 4) {
995              if ($cn->data =~ /[^\x09-\x0D\x20]/) {              if ($cn->data =~ /[^\x09\x0A\x0C\x0D\x20]/) {
996                last CN;                last CN;
997              }              }
998            }            }
999          } # CN          } # CN
1000          unshift @$sib, @cn;          unshift @$sib, @cn;
1001        }        }
1002        } elsif ($node_ns eq $HTML_NS and $node_ln eq 'object') {
1003          my @cn = @{$node->child_nodes};
1004          CN: while (@cn) {
1005            my $cn = shift @cn;
1006            my $cnt = $cn->node_type;
1007            if ($cnt == 1) {
1008              my $cn_nsuri = $cn->namespace_uri;
1009              $cn_nsuri = '' unless defined $cn_nsuri;
1010              if ($cn_nsuri eq $HTML_NS and $cn->manakai_local_name eq 'param') {
1011                #
1012              } else {
1013                last CN;
1014              }
1015            } elsif ($cnt == 3 or $cnt == 4) {
1016              if ($cn->data =~ /[^\x09\x0A\x0C\x0D\x20]/) {
1017                last CN;
1018              }
1019            }
1020          } # CN
1021          unshift @$sib, @cn;
1022      }      }
1023      push @$new_todos, {type => 'element', node => $node};      push @$new_todos, {type => 'element', node => $node};
1024    } # TP    } # TP
# Line 2968  sub _check_get_children ($$$) { Line 1030  sub _check_get_children ($$$) {
1030    return ($sib, $new_todos);    return ($sib, $new_todos);
1031  } # _check_get_children  } # _check_get_children
1032    
1033    =head1 LICENSE
1034    
1035    Copyright 2007-2008 Wakaba <[email protected]>
1036    
1037    This library is free software; you can redistribute it
1038    and/or modify it under the same terms as Perl itself.
1039    
1040    =cut
1041    
1042  1;  1;
1043  # $Date$  # $Date$

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

[email protected]
ViewVC Help
Powered by ViewVC 1.1.24