/[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.1 by wakaba, Fri May 4 09:18:20 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  my $ElementDefault = {  require Whatpm::URIChecker;
6    checker => sub {  
7      my (undef, $el, $onerror) = @_;  ## ISSUE: How XML and XML Namespaces conformance can (or cannot)
8      my $children = [];  ## be applied to an in-memory representation (i.e. DOM)?
9      my @nodes = (@{$el->child_nodes});  
10      while (@nodes) {  ## TODO: Conformance of an HTML document with non-html root element.
11        my $node = shift @nodes;  
12        my $nt = $node->node_type;  ## Stability
13        if ($nt == 1) {  sub FEATURE_STATUS_REC () { 0b1 } ## Interoperable standard
14          push @$children, $node;  sub FEATURE_STATUS_CR () { 0b10 } ## Call for implementation
15        } elsif ($nt == 5) {  sub FEATURE_STATUS_LC () { 0b100 } ## Last call for comments
16          unshift @nodes, @{$node->child_nodes};  sub FEATURE_STATUS_WD () { 0b1000 } ## Working or editor's draft
       }  
     }  
     return ($children);  
   },  
 };  
17    
18  my $Element = {};  ## 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>;  my $HTML_NS = q<http://www.w3.org/1999/xhtml>;
26    my $XML_NS = q<http://www.w3.org/XML/1998/namespace>;
27    my $XMLNS_NS = q<http://www.w3.org/2000/xmlns/>;
28    
29  my $HTMLMetadataElements = [  my $Namespace = {
30    [$HTML_NS, 'link'],    '' => {loaded => 1},
31    [$HTML_NS, 'meta'],    q<http://www.w3.org/2005/Atom> => {module => 'Whatpm::ContentChecker::Atom'},
32    [$HTML_NS, 'style'],    q<http://purl.org/syndication/history/1.0>
33    [$HTML_NS, 'script'],        => {module => 'Whatpm::ContentChecker::Atom'},
34    [$HTML_NS, 'event-source'],    q<http://purl.org/syndication/threading/1.0>
35    [$HTML_NS, 'command'],        => {module => 'Whatpm::ContentChecker::Atom'},
36    [$HTML_NS, 'title'],    $HTML_NS => {module => 'Whatpm::ContentChecker::HTML'},
37  ];    $XML_NS => {loaded => 1},
38      $XMLNS_NS => {loaded => 1},
39  my $HTMLSectioningElements = [    q<http://www.w3.org/1999/02/22-rdf-syntax-ns#> => {loaded => 1},
40    [$HTML_NS, 'body'],  };
41    [$HTML_NS, 'section'],  
42    [$HTML_NS, 'nav'],  sub load_ns_module ($) {
43    [$HTML_NS, 'article'],    my $nsuri = shift; # namespace URI or ''
44    [$HTML_NS, 'blockquote'],    unless ($Namespace->{$nsuri}->{loaded}) {
45    [$HTML_NS, 'aside'],      if ($Namespace->{$nsuri}->{module}) {
46  ];        eval qq{ require $Namespace->{$nsuri}->{module} } or die $@;
47        } else {
48  my $HTMLBlockLevelElements = [        $Namespace->{$nsuri}->{loaded} = 1;
   [$HTML_NS, 'section'],  
   [$HTML_NS, 'nav'],  
   [$HTML_NS, 'article'],  
   [$HTML_NS, 'blockquote'],  
   [$HTML_NS, 'aside'],  
   [$HTML_NS, 'header'],  
   [$HTML_NS, 'footer'],  
   [$HTML_NS, 'address'],  
   [$HTML_NS, 'p'],  
   [$HTML_NS, 'hr'],  
   [$HTML_NS, 'dialog'],  
   [$HTML_NS, 'pre'],  
   [$HTML_NS, 'ol'],  
   [$HTML_NS, 'ul'],  
   [$HTML_NS, 'dl'],  
   [$HTML_NS, 'ins'],  
   [$HTML_NS, 'del'],  
   [$HTML_NS, 'figure'],  
   [$HTML_NS, 'map'],  
   [$HTML_NS, 'table'],  
   [$HTML_NS, 'script'],  
   [$HTML_NS, 'noscript'],  
   [$HTML_NS, 'event-source'],  
   [$HTML_NS, 'details'],  
   [$HTML_NS, 'datagrid'],  
   [$HTML_NS, 'menu'],  
   [$HTML_NS, 'div'],  
   [$HTML_NS, 'font'],  
 ];  
   
 my $HTMLStrictlyInlineLevelElements = [  
   [$HTML_NS, 'br'],  
   [$HTML_NS, 'a'],  
   [$HTML_NS, 'q'],  
   [$HTML_NS, 'cite'],  
   [$HTML_NS, 'em'],  
   [$HTML_NS, 'strong'],  
   [$HTML_NS, 'small'],  
   [$HTML_NS, 'm'],  
   [$HTML_NS, 'dfn'],  
   [$HTML_NS, 'abbr'],  
   [$HTML_NS, 'time'],  
   [$HTML_NS, 'meter'],  
   [$HTML_NS, 'progress'],  
   [$HTML_NS, 'code'],  
   [$HTML_NS, 'var'],  
   [$HTML_NS, 'samp'],  
   [$HTML_NS, 'kbd'],  
   [$HTML_NS, 'sub'],  
   [$HTML_NS, 'sup'],  
   [$HTML_NS, 'span'],  
   [$HTML_NS, 'i'],  
   [$HTML_NS, 'b'],  
   [$HTML_NS, 'bdo'],  
   [$HTML_NS, 'ins'],  
   [$HTML_NS, 'del'],  
   [$HTML_NS, 'img'],  
   [$HTML_NS, 'iframe'],  
   [$HTML_NS, 'embed'],  
   [$HTML_NS, 'object'],  
   [$HTML_NS, 'video'],  
   [$HTML_NS, 'audio'],  
   [$HTML_NS, 'canvas'],  
   [$HTML_NS, 'area'],  
   [$HTML_NS, 'script'],  
   [$HTML_NS, 'noscript'],  
   [$HTML_NS, 'event-source'],  
   [$HTML_NS, 'command'],  
   [$HTML_NS, 'font'],  
 ];  
   
 my $HTMLStructuredInlineLevelElements = [  
   [$HTML_NS, 'blockquote'],  
   [$HTML_NS, 'pre'],  
   [$HTML_NS, 'ol'],  
   [$HTML_NS, 'ul'],  
   [$HTML_NS, 'dl'],  
   [$HTML_NS, 'table'],  
   [$HTML_NS, 'menu'],  
 ];  
   
 my $HTMLInteractiveElements = [  
   [$HTML_NS, 'a'],  
   [$HTML_NS, 'details'],  
   [$HTML_NS, 'datagrid'],  
 ];  
   
 my $HTMLTransparentElements = [  
   [$HTML_NS, 'ins'],  
   [$HTML_NS, 'font'],  
 ];  
 # TODO: script, if scripting is disabled  
   
 # TODO: semi-transparent video, audio  
   
 my $HTMLEmbededElements = [  
   [$HTML_NS, 'img'],  
   [$HTML_NS, 'iframe'],  
   [$HTML_NS, 'embed'],  
   [$HTML_NS, 'object'],  
   [$HTML_NS, 'video'],  
   [$HTML_NS, 'audio'],  
   [$HTML_NS, 'canvas'],  
 ];  
   
 ## Empty  
 my $HTMLEmptyChecker = sub {  
   my (undef, $el, $onerror) = @_;  
   my $children = [];  
   my @nodes = (@{$el->child_nodes});  
   
   while (@nodes) {  
     my $node = shift @nodes;  
     my $nt = $node->node_type;  
     if ($nt == 1) {  
       $onerror->(node => $node, type => 'element not allowed');  
       TP: {  
         for (@{$HTMLTransparentElements}) {  
           if ($node->manakai_element_type_match ($_->[0], $_->[1])) {  
             unshift @nodes, @{$node->child_nodes};  
             last TP;  
           }  
         }  
         push @$children, $node;  
       } # TP  
     } elsif ($nt == 3 or $nt == 4) {  
       $onerror->(node => $node, type => 'character not allowed');  
     } elsif ($nt == 5) {  
       unshift @nodes, @{$node->child_nodes};  
49      }      }
50    }    }
51    return ($children);  } # load_ns_module
 };  
52    
53  ## Text  our $AttrChecker = {
54  my $HTMLTextChecker = sub {    $XML_NS => {
55    my (undef, $el, $onerror) = @_;      space => sub {
56    my $children = [];        my ($self, $attr) = @_;
57    my @nodes = (@{$el->child_nodes});        my $value = $attr->value;
58          if ($value eq 'default' or $value eq 'preserve') {
59    while (@nodes) {          #
60      my $node = shift @nodes;        } else {
61      my $nt = $node->node_type;          ## NOTE: An XML "error"
62      if ($nt == 1) {          $self->{onerror}->(node => $attr, level => $self->{level}->{xml_error},
63        $onerror->(node => $node, type => 'element not allowed');                             type => 'invalid attribute value');
64        TP: {        }
65          for (@{$HTMLTransparentElements}) {      },
66            if ($node->manakai_element_type_match ($_->[0], $_->[1])) {      lang => sub {
67              unshift @nodes, @{$node->child_nodes};        my ($self, $attr) = @_;
68              last TP;        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
79          ## as defined by [IETF RFC 3066], Tags for the Identification
80          ## of Languages, or its successor; in addition, the empty string
81          ## may be specified." ("may" in lower case)
82          ## 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          push @$children, $node;        }
104        } # TP  
105      } elsif ($nt == 5) {        if ($attr->owner_document->manakai_is_html) { # MUST NOT
106        unshift @nodes, @{$node->child_nodes};          $self->{onerror}->(node => $attr, type => 'in HTML:xml:lang',
107      }                             level => $self->{level}->{must});
108    }  ## TODO: Test data...
109    return ($children);        }
110        },
111        base => sub {
112          my ($self, $attr) = @_;
113          my $value = $attr->value;
114          if ($value =~ /[^\x{0000}-\x{10FFFF}]/) { ## ISSUE: Should we disallow noncharacters?
115            $self->{onerror}->(node => $attr,
116                               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
121          ## no author requirement on conformance in the XML Base specification.
122        },
123        id => sub {
124          my ($self, $attr) = @_;
125          my $value = $attr->value;
126          $value =~ s/[\x09\x0A\x0D\x20]+/ /g;
127          $value =~ s/^\x20//;
128          $value =~ s/\x20$//;
129          ## TODO: NCName in XML 1.0 or 1.1
130          ## TODO: declared type is ID?
131          if ($self->{id}->{$value}) {
132            $self->{onerror}->(node => $attr,
133                               type => 'duplicate ID',
134                               level => $self->{level}->{xml_id_error});
135            push @{$self->{id}->{$value}}, $attr;
136          } else {
137            $self->{id}->{$value} = [$attr];
138          }
139        },
140      },
141      $XMLNS_NS => {
142        '' => sub {
143          my ($self, $attr) = @_;
144          my $ln = $attr->manakai_local_name;
145          my $value = $attr->value;
146          if ($value eq $XML_NS and $ln ne 'xml') {
147            $self->{onerror}
148              ->(node => $attr,
149                 type => 'Reserved Prefixes and Namespace Names:Name',
150                 text => $value,
151                 level => $self->{level}->{nc});
152          } elsif ($value eq $XMLNS_NS) {
153            $self->{onerror}
154              ->(node => $attr,
155                 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) {
160            $self->{onerror}
161              ->(node => $attr,
162                 type => 'Reserved Prefixes and Namespace Names:Prefix',
163                 text => $ln,
164                 level => $self->{level}->{nc});
165          } elsif ($ln eq 'xmlns') {
166            $self->{onerror}
167              ->(node => $attr,
168                 type => 'Reserved Prefixes and Namespace Names:Prefix',
169                 text => $ln,
170                 level => $self->{level}->{nc});
171          }
172          ## TODO: If XML 1.0 and empty
173        },
174        xmlns => sub {
175          my ($self, $attr) = @_;
176          ## TODO: In XML 1.0, URI reference [RFC 3986] or an empty string
177          ## TODO: In XML 1.1, IRI reference [RFC 3987] or an empty string
178          ## TODO: relative references are deprecated
179          my $value = $attr->value;
180          if ($value eq $XML_NS) {
181            $self->{onerror}
182              ->(node => $attr,
183                 type => 'Reserved Prefixes and Namespace Names:Name',
184                 text => $value,
185                 level => $self->{level}->{nc});
186          } elsif ($value eq $XMLNS_NS) {
187            $self->{onerror}
188              ->(node => $attr,
189                 type => 'Reserved Prefixes and Namespace Names:Name',
190                 text => $value,
191                 level => $self->{level}->{nc});
192          }
193        },
194      },
195  };  };
196    
197  ## Zero or more |html:style| elements,  ## ISSUE: Should we really allow these attributes?
198  ## followed by zero or more block-level elements  $AttrChecker->{''}->{'xml:space'} = $AttrChecker->{$XML_NS}->{space};
199  my $HTMLStylableBlockChecker = sub {  $AttrChecker->{''}->{'xml:lang'} = $AttrChecker->{$XML_NS}->{lang};
200    my (undef, $el, $onerror) = @_;      ## NOTE: Checker for (null, "xml:lang") attribute is shadowed for
201    my $children = [];      ## HTML elements in Whatpm::ContentChecker::HTML.
202    my @nodes = (@{$el->child_nodes});  $AttrChecker->{''}->{'xml:base'} = $AttrChecker->{$XML_NS}->{base};
203      $AttrChecker->{''}->{'xml:id'} = $AttrChecker->{$XML_NS}->{id};
204    my $has_non_style;  
205    while (@nodes) {  our $AttrStatus;
206      my $node = shift @nodes;  
207      my $nt = $node->node_type;  for (qw/space lang base id/) {
208      if ($nt == 1) {    $AttrStatus->{$XML_NS}->{$_} = FEATURE_STATUS_REC | FEATURE_ALLOWED;
209        if ($node->manakai_element_type_match ($HTML_NS, 'style')) {    $AttrStatus->{''}->{"xml:$_"} = FEATURE_STATUS_REC | FEATURE_ALLOWED;
210          if ($has_non_style) {    ## XML 1.0: FEATURE_STATUS_CR
211            $onerror->(node => $node, type => 'element not allowed');    ## XML 1.1: FEATURE_STATUS_REC
212          }    ## XML Namespaces 1.0: FEATURE_STATUS_CR
213      ## XML Namespaces 1.1: FEATURE_STATUS_REC
214      ## XML Base: FEATURE_STATUS_REC
215      ## 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;
228          if (defined $attr_ns) {
229            load_ns_module ($attr_ns);
230        } else {        } else {
231          $has_non_style = 1;          $attr_ns = '';
         CHK: {  
           for (@{$HTMLBlockLevelElements}) {  
             if ($node->manakai_element_type_match ($_->[0], $_->[1])) {  
               last CHK;  
             }  
           }  
           $onerror->(node => $node, type => 'element not allowed');  
         } # CHK  
232        }        }
233        TP: {        my $attr_ln = $attr->manakai_local_name;
234          for (@{$HTMLTransparentElements}) {        
235            if ($node->manakai_element_type_match ($_->[0], $_->[1])) {        my $checker = $AttrChecker->{$attr_ns}->{$attr_ln}
236              unshift @nodes, @{$node->child_nodes};            || $AttrChecker->{$attr_ns}->{''};
237              last TP;        my $status = $AttrStatus->{$attr_ns}->{$attr_ln}
238            }            || $AttrStatus->{$attr_ns}->{''};
239          }        if (not defined $status) {
240          push @$children, $node;          $status = FEATURE_ALLOWED;
241        } # TP          ## NOTE: FEATURE_ALLOWED for all attributes, since the element
242      } elsif ($nt == 3 or $nt == 4) {          ## is not supported and therefore "attribute not defined" error
243        if ($node->data =~ /[^\x09-\x0D\x20]/) {          ## should not raised (too verbose) and global attributes should be
244          $onerror->(node => $node, type => 'character not allowed');          ## 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) {
249            $checker->($self, $attr);
250          } else {
251            $self->{onerror}->(node => $attr,
252                               type => 'unknown attribute',
253                               level => $self->{level}->{uncertain});
254        }        }
255      } elsif ($nt == 5) {        $self->_attr_status_info ($attr, $status);
       unshift @nodes, @{$node->child_nodes};  
256      }      }
257      },
258      check_child_element => sub {
259        my ($self, $item, $child_el, $child_nsuri, $child_ln,
260            $child_is_transparent, $element_state) = @_;
261        if ($self->{minus_elements}->{$child_nsuri}->{$child_ln}) {
262          $self->{onerror}->(node => $child_el,
263                             type => 'element not allowed:minus',
264                             level => $self->{level}->{must});
265        } elsif ($self->{plus_elements}->{$child_nsuri}->{$child_ln}) {
266          #
267        } else {
268          #
269        }
270      },
271      check_child_text => sub { },
272      check_end => sub {
273        my ($self, $item, $element_state) = @_;
274        ## 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        }    
278      },
279    );
280    
281    our $ElementDefault = {
282      %AnyChecker,
283      status => FEATURE_ALLOWED,
284          ## NOTE: No "element not defined" error - it is not supported anyway.
285      check_start => sub {
286        my ($self, $item, $element_state) = @_;
287        $self->{onerror}->(node => $item->{node},
288                           type => 'unknown element',
289                           level => $self->{level}->{uncertain});
290      },
291    };
292    
293    our $HTMLEmbeddedContent = {
294      ## NOTE: All embedded content is also phrasing content.
295      $HTML_NS => {
296        img => 1, iframe => 1, embed => 1, object => 1, video => 1, audio => 1,
297        canvas => 1,
298      },
299      q<http://www.w3.org/1998/Math/MathML> => {math => 1},
300      q<http://www.w3.org/2000/svg> => {svg => 1},
301      ## NOTE: Foreign elements with content (but no metadata) are
302      ## embedded content.
303    };  
304    
305    our $IsInHTMLInteractiveContent = sub {
306      my ($el, $nsuri, $ln) = @_;
307    
308      ## NOTE: This CODE returns whether an element that is conditionally
309      ## 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    return ($children);  }; # $IsInHTMLInteractiveContent
 }; # $HTMLStylableBlockChecker  
324    
325  ## Zero or more block-level elements  my $HTMLTransparentElements = {
326  my $HTMLBlockChecker = sub {    $HTML_NS => {qw/ins 1 del 1 font 1 noscript 1 canvas 1 a 1/},
327    my (undef, $el, $onerror) = @_;    ## NOTE: |html:noscript| is transparent if scripting is disabled
328    my $children = [];    ## and not in |head|.
329    my @nodes = (@{$el->child_nodes});  };
330      
331    while (@nodes) {  my $HTMLSemiTransparentElements = {
332      my $node = shift @nodes;    $HTML_NS => {object => 1, video => 1, audio => 1},
333      my $nt = $node->node_type;  };
334      if ($nt == 1) {  
335        CHK: {  our $Element = {};
336          for (@{$HTMLBlockLevelElements}) {  
337            if ($node->manakai_element_type_match ($_->[0], $_->[1])) {  $Element->{q<http://www.w3.org/1999/02/22-rdf-syntax-ns#>}->{RDF} = {
338              last CHK;    %AnyChecker,
339            }    status => FEATURE_STATUS_REC | FEATURE_ALLOWED,
340          }    is_root => 1, ## ISSUE: Not explicitly allowed for non application/rdf+xml
341          $onerror->(node => $node, type => 'element not allowed');    check_start => sub {
342        } # CHK      my ($self, $item, $element_state) = @_;
343        TP: {      my $triple = [];
344          for (@{$HTMLTransparentElements}) {      push @{$self->{return}->{rdf}}, [$item->{node}, $triple];
345            if ($node->manakai_element_type_match ($_->[0], $_->[1])) {      require Whatpm::RDFXML;
346              unshift @nodes, @{$node->child_nodes};      my $rdf = Whatpm::RDFXML->new;
347              last TP;      ## TODO: Should we make bnodeid unique in a document?
348            }      $rdf->{onerror} = $self->{onerror};
349          }      $rdf->{level} = $self->{level};
350          push @$children, $node;      $rdf->{ontriple} = sub {
351        } # TP        my %opt = @_;
352      } elsif ($nt == 3 or $nt == 4) {        push @$triple,
353        if ($node->data =~ /[^\x09-\x0D\x20]/) {            [$opt{node}, $opt{subject}, $opt{predicate}, $opt{object}];
354          $onerror->(node => $node, type => 'character not allowed');        if (defined $opt{id}) {
355            push @$triple,
356                [$opt{node},
357                 $opt{id},
358                 {uri => q<http://www.w3.org/1999/02/22-rdf-syntax-ns#subject>},
359                 $opt{subject}];
360            push @$triple,
361                [$opt{node},
362                 $opt{id},
363                 {uri => q<http://www.w3.org/1999/02/22-rdf-syntax-ns#predicate>},
364                 $opt{predicate}];
365            push @$triple,
366                [$opt{node},
367                 $opt{id},
368                 {uri => q<http://www.w3.org/1999/02/22-rdf-syntax-ns#object>},
369                 $opt{object}];
370            push @$triple,
371                [$opt{node},
372                 $opt{id},
373                 {uri => q<http://www.w3.org/1999/02/22-rdf-syntax-ns#type>},
374                 {uri => q<http://www.w3.org/1999/02/22-rdf-syntax-ns#Statement>}];
375        }        }
376      } elsif ($nt == 5) {      };
377        unshift @nodes, @{$node->child_nodes};      $rdf->convert_rdf_element ($item->{node});
378      }    },
379    }  };
   return ($children);  
 }; # $HTMLBlockChecker  
380    
381  ## Inline-level content  my $default_error_level = {
382  my $HTMLInlineChecker = sub {    must => 'm',
383    my (undef, $el, $onerror) = @_;    should => 's',
384    my $children = [];    warn => 'w',
385    my @nodes = (@{$el->child_nodes});    good => 'w',
386        undefined => 'w',
387    while (@nodes) {    info => 'i',
388      my $node = shift @nodes;  
389      my $nt = $node->node_type;    uncertain => 'u',
390      if ($nt == 1) {  
391        CHK: {    html4_fact => 'm',
392          for (@{$HTMLStrictlyInlineLevelElements},    html5_no_may => 'm',
393               @{$HTMLStructuredInlineLevelElements}) {  
394            if ($node->manakai_element_type_match ($_->[0], $_->[1])) {    xml_error => 'm', ## TODO: correct?
395              last CHK;    xml_id_error => 'm', ## TODO: ?
396            }    nc => 'm', ## XML Namespace Constraints ## TODO: correct?
397          }  
398          $onerror->(node => $node, type => 'element not allowed');    ## |Whatpm::URIChecker|
399        } # CHK    uri_syntax => 'm',
400        TP: {    uri_fact => 'm',
401          for (@{$HTMLTransparentElements}) {    uri_lc_must => 'm',
402            if ($node->manakai_element_type_match ($_->[0], $_->[1])) {    uri_lc_should => 'w',
403              unshift @nodes, @{$node->child_nodes};  
404              last TP;    ## |Whatpm::IMTChecker|
405            }    mime_must => 'm', # lowercase "must"
406          }    mime_fact => 'm',
407          push @$children, $node;    mime_strongly_discouraged => 'w',
408        } # TP    mime_discouraged => 'w',
409      } elsif ($nt == 5) {  
410        unshift @nodes, @{$node->child_nodes};    ## |Whatpm::LangTag|
411      }    langtag_fact => 'm',
412    
413      ## |Whatpm::RDFXML|
414      rdf_fact => 'm',
415      rdf_grammer => 'm',
416      rdf_lc_must => 'm',
417    
418      ## |Message::Charset::Info| and |Whatpm::Charset::DecodeHandle|
419      charset_variant => 'm',
420        ## An error caused by use of a variant charset that is not conforming
421        ## to the original charset (e.g. use of 0x80 in an ISO-8859-1 document
422        ## which is interpreted as a Windows-1252 document instead).
423      charset_fact => 'm',
424      iso_shall => 'm',
425    };
426    
427    sub check_document ($$$;$) {
428      my ($self, $doc, $onerror, $onsubdoc) = @_;
429      $self = bless {}, $self unless ref $self;
430      $self->{onerror} = $onerror;
431      $self->{onsubdoc} = $onsubdoc || sub {
432        warn "A subdocument is not conformance-checked";
433      };
434    
435      $self->{level} ||= $default_error_level;
436    
437      ## TODO: If application/rdf+xml, RDF/XML mode should be invoked.
438    
439      my $docel = $doc->document_element;
440      unless (defined $docel) {
441        ## ISSUE: Should we check content of Document node?
442        $onerror->(node => $doc, type => 'no document element',
443                   level => $self->{level}->{must});
444        ## ISSUE: Is this non-conforming (to what spec)?  Or just a warning?
445        return {
446                class => {},
447                id => {}, table => [], term => {},
448               };
449    }    }
   return ($children);  
 }; # $HTMLStrictlyInlineChecker  
450    
451  my $HTMLSignificantInlineChecker = $HTMLInlineChecker;    ## ISSUE: Unexpanded entity references and HTML5 conformance
 ## TODO: check significant content  
   
 ## Strictly inline-level content  
 my $HTMLStrictlyInlineChecker = sub {  
   my (undef, $el, $onerror) = @_;  
   my $children = [];  
   my @nodes = (@{$el->child_nodes});  
452        
453    while (@nodes) {    my $docel_nsuri = $docel->namespace_uri;
454      my $node = shift @nodes;    if (defined $docel_nsuri) {
455      my $nt = $node->node_type;      load_ns_module ($docel_nsuri);
456      if ($nt == 1) {    } else {
457        CHK: {      $docel_nsuri = '';
458          for (@{$HTMLStrictlyInlineLevelElements}) {    }
459            if ($node->manakai_element_type_match ($_->[0], $_->[1])) {    my $docel_def = $Element->{$docel_nsuri}->{$docel->manakai_local_name} ||
460              last CHK;      $Element->{$docel_nsuri}->{''} ||
461            }      $ElementDefault;
462          }    if ($docel_def->{is_root}) {
463          $onerror->(node => $node, type => 'element not allowed');      #
464        } # CHK    } elsif ($docel_def->{is_xml_root}) {
465        TP: {      unless ($doc->manakai_is_html) {
466          for (@{$HTMLTransparentElements}) {        #
467            if ($node->manakai_element_type_match ($_->[0], $_->[1])) {      } else {
468              unshift @nodes, @{$node->child_nodes};        $onerror->(node => $docel, type => 'element not allowed:root:xml',
469              last TP;                   level => $self->{level}->{must});
           }  
         }  
         push @$children, $node;  
       } # TP  
     } elsif ($nt == 5) {  
       unshift @nodes, @{$node->child_nodes};  
470      }      }
471      } else {
472        $onerror->(node => $docel, type => 'element not allowed:root',
473                   level => $self->{level}->{must});
474    }    }
   return ($children);  
 }; # $HTMLStrictlyInlineChecker  
475    
476  my $HTMLSignificantStrictlyInlineChecker = $HTMLStrictlyInlineChecker;    ## TODO: Check for other items other than document element
477  ## TODO: check significant content    ## (second (errorous) element, text nodes, PI nodes, doctype nodes)
478    
479  my $HTMLBlockOrInlineChecker = sub {    my $return = $self->check_element ($docel, $onerror, $onsubdoc);
480    my (undef, $el, $onerror) = @_;  
481    my $children = [];    ## TODO: Test for these checks are necessary.
482    my @nodes = (@{$el->child_nodes});    my $charset_name = $doc->input_encoding;
483        if (defined $charset_name) {
484    my $content = 'block-or-inline'; # or 'block' or 'inline'      require Message::Charset::Info;
485    my @block_not_inline;      my $charset = $Message::Charset::Info::IANACharset->{$charset_name};
486    while (@nodes) {  
487      my $node = shift @nodes;      if ($doc->manakai_is_html) {
488      my $nt = $node->node_type;        if (not $doc->manakai_has_bom and
489      if ($nt == 1) {            not defined $doc->manakai_charset) {
490        if ($content eq 'block') {          unless ($charset->{is_html_ascii_superset}) {
491          CHK: {            $onerror->(node => $doc,
492            for (@{$HTMLBlockLevelElements}) {                       level => $self->{level}->{must},
493              if ($node->manakai_element_type_match ($_->[0], $_->[1])) {                       type => 'non ascii superset',
494                last CHK;                       text => $charset_name);
             }  
           }  
           $onerror->(node => $node, type => 'element not allowed');  
         } # CHK  
       } elsif ($content eq 'inline') {  
         CHK: {  
           for (@{$HTMLStrictlyInlineLevelElements},  
                @{$HTMLStructuredInlineLevelElements}) {  
             if ($node->manakai_element_type_match ($_->[0], $_->[1])) {  
               last CHK;  
             }  
           }  
           $onerror->(node => $node, type => 'element not allowed');  
         } # CHK  
       } else {  
         my $is_block;  
         my $is_inline;  
         for (@{$HTMLBlockLevelElements}) {  
           if ($node->manakai_element_type_match ($_->[0], $_->[1])) {  
             $is_block = 1;  
             last;  
           }  
495          }          }
496                    
497          for (@{$HTMLStrictlyInlineLevelElements},          if (not $self->{has_charset} and ## TODO: This does not work now.
498               @{$HTMLStructuredInlineLevelElements}) {              not $charset->{iana_names}->{'us-ascii'}) {
499            if ($node->manakai_element_type_match ($_->[0], $_->[1])) {            $onerror->(node => $doc,
500              $is_inline = 1;                       level => $self->{level}->{must},
501              last;                       type => 'no character encoding declaration',
502            }                       text => $charset_name);
         }  
           
         push @block_not_inline, $node if $is_block and not $is_inline;  
         unless ($is_block) {  
           $content = 'inline';  
           for (@block_not_inline) {  
             $onerror->(node => $_, type => 'element not allowed');  
           }  
           unless ($is_inline) {  
             $onerror->(node => $node, type => 'element not allowed');  
           }  
503          }          }
504        }        }
505        TP: {  
506          for (@{$HTMLTransparentElements}) {        if ($charset->{iana_names}->{'utf-8'}) {
507            if ($node->manakai_element_type_match ($_->[0], $_->[1])) {          #
508              unshift @nodes, @{$node->child_nodes};        } elsif ($charset->{iana_names}->{'jis_x0212-1990'} or
509              last TP;                 $charset->{iana_names}->{'x-jis0208'} or
510            }                 $charset->{iana_names}->{'utf-32'} or ## ISSUE: UTF-32BE? UTF-32LE?
511          }                 ($charset->{category} & Message::Charset::Info::CHARSET_CATEGORY_EBCDIC ())) {
512          push @$children, $node;          $onerror->(node => $doc,
513        } # TP                     type => 'bad character encoding',
514      } elsif ($nt == 3 or $nt == 4) {                     text => $charset_name,
515        if ($node->data =~ /[^\x09-\x0D\x20]/) {                     level => $self->{level}->{should},
516          if ($content eq 'block') {                     layer => 'encode');
517            $onerror->(node => $node, type => 'character not allowed');        } elsif ($charset->{iana_names}->{'cesu-8'} or
518          } else {                 $charset->{iana_names}->{'utf-8'} or ## ISSUE: UNICODE-1-1-UTF-7?
519            $content = 'inline';                 $charset->{iana_names}->{'bocu-1'} or
520            for (@block_not_inline) {                 $charset->{iana_names}->{'scsu'}) {
521              $onerror->(node => $_, type => 'element not allowed');          $onerror->(node => $doc,
522            }                     type => 'disallowed character encoding',
523          }                     text => $charset_name,
524                       level => $self->{level}->{must},
525                       layer => 'encode');
526          } else {
527            $onerror->(node => $doc,
528                       type => 'non-utf-8 character encoding',
529                       text => $charset_name,
530                       level => $self->{level}->{good},
531                       layer => 'encode');
532        }        }
     } elsif ($nt == 5) {  
       unshift @nodes, @{$node->child_nodes};  
533      }      }
534      } elsif ($doc->manakai_is_html) {
535        ## NOTE: MUST and SHOULD requirements above cannot be tested,
536        ## since the document has no input charset encoding information.
537        $onerror->(node => $doc,
538                   type => 'character encoding unchecked',
539                   level => $self->{level}->{info},
540                   layer => 'encode');
541    }    }
   return ($children);  
 };  
542    
543  my $HTMLStyledBlockOrInlineChecker = sub {    return $return;
544    my (undef, $el, $onerror) = @_;  } # check_document
545    my $children = [];  
546    my @nodes = (@{$el->child_nodes});  ## Check an element.  The element is checked as if it is an orphan node (i.e.
547      ## an element without a parent node).
548    my $has_non_style;  sub check_element ($$$;$) {
549    my $content = 'block-or-inline'; # or 'block' or 'inline'    my ($self, $el, $onerror, $onsubdoc) = @_;
550    my @block_not_inline;    $self = bless {}, $self unless ref $self;
551    while (@nodes) {    $self->{onerror} = $onerror;
552      my $node = shift @nodes;    $self->{onsubdoc} = $onsubdoc || sub {
553      my $nt = $node->node_type;      warn "A subdocument is not conformance-checked";
554      if ($nt == 1) {    };
555        if ($node->manakai_element_type_match ($HTML_NS, 'style')) {  
556          if ($has_non_style) {    $self->{level} ||= $default_error_level;
557            $onerror->(node => $node, type => 'element not allowed');  
558          }    $self->{plus_elements} = {};
559        } elsif ($content eq 'block') {    $self->{minus_elements} = {};
560          $has_non_style = 1;    $self->{id} = {};
561          CHK: {    $self->{form} = {};
562            for (@{$HTMLBlockLevelElements}) {    $self->{term} = {};
563              if ($node->manakai_element_type_match ($_->[0], $_->[1])) {    $self->{usemap} = [];
564                last CHK;    $self->{ref} = []; # datetemplate data references
565              }    $self->{template} = []; # datatemplate template references
566            }    $self->{contextmenu} = [];
567            $onerror->(node => $node, type => 'element not allowed');    $self->{map} = {};
568          } # CHK    $self->{menu} = {};
569        } elsif ($content eq 'inline') {    $self->{has_link_type} = {};
570          $has_non_style = 1;    $self->{flag} = {};
571          CHK: {    #$self->{has_uri_attr};
572            for (@{$HTMLStrictlyInlineLevelElements},    #$self->{has_hyperlink_element};
573                 @{$HTMLStructuredInlineLevelElements}) {    #$self->{has_charset};
574              if ($node->manakai_element_type_match ($_->[0], $_->[1])) {    #$self->{has_base};
575                last CHK;    $self->{return} = {
576              }      class => {},
577            }      id => $self->{id},
578            $onerror->(node => $node, type => 'element not allowed');      table => [], # table objects returned by Whatpm::HTMLTable
579          } # CHK      term => $self->{term},
580        uri => {}, # URIs other than those in RDF triples
581                         ## TODO: xmlns="", SYSTEM "", atom:* src="", xml:base=""
582        rdf => [],
583      };
584    
585      my @item = ({type => 'element', node => $el, parent_state => {}});
586      $item[-1]->{real_parent_state} = $item[-1]->{parent_state};
587      while (@item) {
588        my $item = shift @item;
589        if (ref $item eq 'ARRAY') {
590          my $code = shift @$item;
591    next unless $code;## TODO: temp.
592          $code->(@$item);
593        } elsif ($item->{type} eq 'element') {
594          my $el_nsuri = $item->{node}->namespace_uri;
595          if (defined $el_nsuri) {
596            load_ns_module ($el_nsuri);
597        } else {        } else {
598          $has_non_style = 1;          $el_nsuri = '';
         my $is_block;  
         my $is_inline;  
         for (@{$HTMLBlockLevelElements}) {  
           if ($node->manakai_element_type_match ($_->[0], $_->[1])) {  
             $is_block = 1;  
             last;  
           }  
         }  
           
         for (@{$HTMLStrictlyInlineLevelElements},  
              @{$HTMLStructuredInlineLevelElements}) {  
           if ($node->manakai_element_type_match ($_->[0], $_->[1])) {  
             $is_inline = 1;  
             last;  
           }  
         }  
           
         push @block_not_inline, $node if $is_block and not $is_inline;  
         unless ($is_block) {  
           $content = 'inline';  
           for (@block_not_inline) {  
             $onerror->(node => $_, type => 'element not allowed');  
           }  
           unless ($is_inline) {  
             $onerror->(node => $node, type => 'element not allowed');  
           }  
         }  
599        }        }
600        TP: {        my $el_ln = $item->{node}->manakai_local_name;
601          for (@{$HTMLTransparentElements}) {        
602            if ($node->manakai_element_type_match ($_->[0], $_->[1])) {        my $element_state = {};
603              unshift @nodes, @{$node->child_nodes};        my $eldef = $Element->{$el_nsuri}->{$el_ln} ||
604              last TP;            $Element->{$el_nsuri}->{''} ||
605            }            $ElementDefault;
606          }        my $content_def = $item->{transparent}
607          push @$children, $node;            ? $item->{parent_def} || $eldef : $eldef;
608        } # TP        my $content_state = $item->{transparent}
609      } elsif ($nt == 3 or $nt == 4) {            ? $item->{parent_def}
610        if ($node->data =~ /[^\x09-\x0D\x20]/) {                ? $item->{parent_state} || $element_state : $element_state
611          $has_non_style = 1;            : $element_state;
612          if ($content eq 'block') {  
613            $onerror->(node => $node, type => 'character not allowed');        unless ($eldef->{status} & FEATURE_STATUS_REC) {
614          } else {          my $status = $eldef->{status} & FEATURE_STATUS_CR ? 'cr' :
615            $content = 'inline';              $eldef->{status} & FEATURE_STATUS_LC ? 'lc' :
616            for (@block_not_inline) {              $eldef->{status} & FEATURE_STATUS_WD ? 'wd' : 'non-standard';
617              $onerror->(node => $_, type => 'element not allowed');          $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        }        }
     } elsif ($nt == 5) {  
       unshift @nodes, @{$node->child_nodes};  
     }  
   }  
   return ($children);  
 };  
   
 my $HTMLTransparentChecker = $HTMLBlockOrInlineChecker;  
634    
635  $Element->{$HTML_NS}->{html} = {        my @new_item;
636    checker => sub {        push @new_item, [$eldef->{check_start}, $self, $item, $element_state];
637      my (undef, $el, $onerror) = @_;        push @new_item, [$eldef->{check_attrs}, $self, $item, $element_state];
638      my $children = [];        
639      my @nodes = (@{$el->child_nodes});        my @child = @{$item->{node}->child_nodes};
640          while (@child) {
641      my $phase = 'before head';          my $child = shift @child;
642      while (@nodes) {          my $child_nt = $child->node_type;
643        my $node = shift @nodes;          if ($child_nt == 1) { # ELEMENT_NODE
644        my $nt = $node->node_type;            my $child_nsuri = $child->namespace_uri;
645        if ($nt == 1) {            $child_nsuri = '' unless defined $child_nsuri;
646          if ($phase eq 'before head') {            my $child_ln = $child->manakai_local_name;
647            if ($node->manakai_element_type_match ($HTML_NS, 'head')) {            if ($HTMLTransparentElements->{$child_nsuri}->{$child_ln} and
648              $phase = 'after head';                            not (($self->{flag}->{in_head} or
649            } elsif ($node->manakai_element_type_match ($HTML_NS, 'body')) {                      ($el_nsuri eq $HTML_NS and $el_ln eq 'head')) and
650              $onerror->(node => $node, type => 'element missing before:head');                     $child_nsuri eq $HTML_NS and $child_ln eq 'noscript')) {
651              $phase = 'after body';              push @new_item, [$content_def->{check_child_element},
652            } else {                               $self, $item, $child,
653              $onerror->(node => $node, type => 'element not allowed');                               $child_nsuri, $child_ln, 1,
654              # before head                               $content_state, $element_state];
655            }              push @new_item, {type => 'element', node => $child,
656          } elsif ($phase eq 'after head') {                               parent_state => $content_state,
657            if ($node->manakai_element_type_match ($HTML_NS, 'body')) {                               parent_def => $content_def,
658              $phase = 'after body';                               real_parent_state => $element_state,
659                                 transparent => 1};
660            } else {            } else {
661              $onerror->(node => $node, type => 'element not allowed');              if ($item->{parent_def} and # has parent
662              # after head                  $el_nsuri eq $HTML_NS) { ## $HTMLSemiTransparentElements
663            }                if ($el_ln eq 'object') {
664          } else { #elsif ($phase eq 'after body') {                  if ($self->{plus_elements}->{$child_nsuri}->{$child_ln}) {
665            $onerror->(node => $node, type => 'element not allowed');                    #
666            # after body                  } elsif ($child_nsuri eq $HTML_NS and $child_ln eq 'param') {
667          }                    #
668          TP: {                  } else {
669            for (@{$HTMLTransparentElements}) {                    $content_def = $item->{parent_def} || $content_def;
670              if ($node->manakai_element_type_match ($_->[0], $_->[1])) {                    $content_state = $item->{parent_state} || $content_state;
671                unshift @nodes, @{$node->child_nodes};                  }
672                last TP;                } elsif ($el_ln eq 'video' or $el_ln eq 'audio') {
673                    if ($self->{plus_elements}->{$child_nsuri}->{$child_ln}) {
674                      #
675                    } elsif ($child_nsuri eq $HTML_NS and $child_ln eq 'source') {
676                      $element_state->{has_source} = 1;
677                    } else {
678                      $content_def = $item->{parent_def} || $content_def;
679                      $content_state = $item->{parent_state} || $content_state;
680                    }
681                  }
682              }              }
683    
684                push @new_item, [$content_def->{check_child_element},
685                                 $self, $item, $child,
686                                 $child_nsuri, $child_ln,
687                                 $HTMLSemiTransparentElements
688                                     ->{$child_nsuri}->{$child_ln},
689                                 $content_state, $element_state];
690                push @new_item, {type => 'element', node => $child,
691                                 parent_def => $content_def,
692                                 real_parent_state => $element_state,
693                                 parent_state => $content_state};
694              }
695    
696              if ($HTMLEmbeddedContent->{$child_nsuri}->{$child_ln}) {
697                $element_state->{has_significant} = 1;
698              }
699            } elsif ($child_nt == 3 or # TEXT_NODE
700                     $child_nt == 4) { # CDATA_SECTION_NODE
701              my $has_significant = ($child->data =~ /[^\x09\x0A\x0C\x0D\x20]/);
702              push @new_item, [$content_def->{check_child_text},
703                               $self, $item, $child, $has_significant,
704                               $content_state, $element_state];
705              $element_state->{has_significant} ||= $has_significant;
706              if ($has_significant and
707                  $HTMLSemiTransparentElements->{$el_nsuri}->{$el_ln}) {
708                $content_def = $item->{parent_def} || $content_def;
709            }            }
710            push @$children, $node;          } elsif ($child_nt == 5) { # ENTITY_REFERENCE_NODE
711          } # TP            push @child, @{$child->child_nodes};
       } elsif ($nt == 3 or $nt == 4) {  
         if ($node->data =~ /[^\x09-\x0D\x20]/) {  
           $onerror->(node => $node, type => 'character not allowed');  
712          }          }
713        } elsif ($nt == 5) {          ## TODO: PI_NODE
714          unshift @nodes, @{$node->child_nodes};          ## TODO: Unknown node type
715        }        }
716          
717          push @new_item, [$eldef->{check_end}, $self, $item, $element_state];
718          
719          unshift @item, @new_item;
720        } else {
721          die "$0: Internal error: Unsupported checking action type |$item->{type}|";
722      }      }
723      return ($children);    }
   },  
 };  
724    
725  $Element->{$HTML_NS}->{head} = {    for (@{$self->{template}}) {
726    checker => sub {      ## TODO: If the document is an XML document, ...
727      my (undef, $el, $onerror) = @_;      ## NOTE: If the document is an HTML document:
728      my $children = [];      ## ISSUE: We need to percent-decode?
729      my @nodes = (@{$el->child_nodes});      F: {
730          if ($self->{id}->{$_->[0]}) {
731      my $has_meta_charset;          my $el = $self->{id}->{$_->[0]}->[0]->owner_element;
732      my $has_title;          if ($el->node_type == 1 and # ELEMENT_NODE
733      my $has_base;              $el->manakai_local_name eq 'datatemplate') {
734      my $has_non_base;            my $nsuri = $el->namespace_uri;
735      while (@nodes) {            if (defined $nsuri and $nsuri eq $HTML_NS) {
736        my $node = shift @nodes;              if ($el eq $_->[1]->owner_element) {
737        my $nt = $node->node_type;                $self->{onerror}->(node => $_->[1],
738        if ($nt == 1) {                                   type => 'fragment points itself',
739          if ($node->manakai_element_type_match ($HTML_NS, 'title')) {                                   level => $self->{level}->{must});
           $has_non_base = 1;  
           unless ($has_title) {  
             $has_title = 1;  
           } else {  
             $onerror->(node => $node, type => 'duplicate:title');  
           }  
         } elsif ($node->manakai_element_type_match ($HTML_NS, 'meta')) {  
           $has_non_base = 1;  
           if ($node->has_attribute_ns (undef, 'charset')) {  
             unless ($has_meta_charset) {  
               if ($has_base) {  
                 $onerror->(node => $node, type => 'element not allowed');  
                 ## NOTE: See |base|'s "contexts" field in the spec  
               }  
               $has_meta_charset = 1;  
             } else {  
               $onerror->(node => $node, type => 'duplicate:meta charset');  
740              }              }
741            } else {              
742              # metadata element              last F;
743            }            }
         } elsif ($node->manakai_element_type_match ($HTML_NS, 'base')) {  
           unless ($has_base) {  
             if ($has_non_base) {  
               $onerror->(node => $node, type => 'element not allowed');  
             }  
             $has_base = 1;  
           } else {  
             $onerror->(node => $node, type => 'duplicate:base');  
           }  
         } else {  
           $has_non_base = 1;  
           CHK: {  
             for (@{$HTMLMetadataElements}) {  
               if ($node->manakai_element_type_match ($_->[0], $_->[1])) {  
                 last CHK;  
               }  
             }  
             $onerror->(node => $node, type => 'element not allowed');  
           } # CHK  
744          }          }
         TP: {  
           for (@{$HTMLTransparentElements}) {  
             if ($node->manakai_element_type_match ($_->[0], $_->[1])) {  
               unshift @nodes, @{$node->child_nodes};  
               last TP;  
             }  
           }  
           push @$children, $node;  
         } # TP  
       } elsif ($nt == 3 or $nt == 4) {  
         if ($node->data =~ /[^\x09-\x0D\x20]/) {  
           $onerror->(node => $node, type => 'character not allowed');  
         }  
       } elsif ($nt == 5) {  
         unshift @nodes, @{$node->child_nodes};  
745        }        }
746      }        ## TODO: Should we raise a "fragment points nothing" error instead
747      unless ($has_title) {        ## if the fragment identifier identifies no element?
       $onerror->(node => $el, type => 'element missing in:title');  
     }  
     return ($children);  
   },  
 };  
   
 $Element->{$HTML_NS}->{title} = {  
   checker => $HTMLTextChecker,  
 };  
   
 $Element->{$HTML_NS}->{base} = {  
   checker => $HTMLEmptyChecker,  
 };  
   
 $Element->{$HTML_NS}->{link} = {  
   checker => $HTMLEmptyChecker,  
 };  
   
 $Element->{$HTML_NS}->{meta} = {  
   checker => $HTMLEmptyChecker,  
 };  
   
 ## NOTE: |html:style| has no conformance creteria on content model  
   
 $Element->{$HTML_NS}->{body} = {  
   checker => $HTMLBlockChecker,  
 };  
   
 $Element->{$HTML_NS}->{section} = {  
   checker => $HTMLStylableBlockChecker,  
 };  
   
 $Element->{$HTML_NS}->{nav} = {  
   checker => $HTMLBlockOrInlineChecker,  
 };  
   
 $Element->{$HTML_NS}->{article} = {  
   checker => $HTMLStylableBlockChecker,  
 };  
   
 $Element->{$HTML_NS}->{blockquote} = {  
   checker => $HTMLBlockChecker,  
 };  
   
 $Element->{$HTML_NS}->{aside} = {  
   checker => $HTMLStyledBlockOrInlineChecker,  
 };  
   
 $Element->{$HTML_NS}->{h1} = {  
   checker => $HTMLSignificantStrictlyInlineChecker,  
 };  
   
 $Element->{$HTML_NS}->{h2} = {  
   checker => $HTMLSignificantStrictlyInlineChecker,  
 };  
   
 $Element->{$HTML_NS}->{h3} = {  
   checker => $HTMLSignificantStrictlyInlineChecker,  
 };  
   
 $Element->{$HTML_NS}->{h4} = {  
   checker => $HTMLSignificantStrictlyInlineChecker,  
 };  
   
 $Element->{$HTML_NS}->{h5} = {  
   checker => $HTMLSignificantStrictlyInlineChecker,  
 };  
   
 $Element->{$HTML_NS}->{h6} = {  
   checker => $HTMLSignificantStrictlyInlineChecker,  
 };  
   
 ## TODO: header  
   
 ## TODO: footer  
   
 $Element->{$HTML_NS}->{address} = {  
   checker => $HTMLInlineChecker,  
 };  
748    
749  $Element->{$HTML_NS}->{p} = {        $self->{onerror}->(node => $_->[1], type => 'template:not template',
750    checker => $HTMLSignificantInlineChecker,                           level => $self->{level}->{must});
751  };      } # F
752      }
753  $Element->{$HTML_NS}->{hr} = {    
754    checker => $HTMLEmptyChecker,    for (@{$self->{ref}}) {
755  };      ## TOOD: If XML
756        ## NOTE: If it is an HTML document:
757        if ($_->[0] eq '') {
758          ## NOTE: It points the top of the document.
759        } elsif ($self->{id}->{$_->[0]}) {
760          if ($self->{id}->{$_->[0]}->[0]->owner_element
761                  eq $_->[1]->owner_element) {
762            $self->{onerror}->(node => $_->[1], type => 'fragment points itself',
763                               level => $self->{level}->{must});
764          }
765        } else {
766          $self->{onerror}->(node => $_->[1], type => 'fragment points nothing',
767                             level => $self->{level}->{must});
768        }
769      }
770    
771  $Element->{$HTML_NS}->{br} = {    ## TODO: Maybe we should have $document->manakai_get_by_fragment or something
   checker => $HTMLEmptyChecker,  
 };  
772    
773  $Element->{$HTML_NS}->{dialog} = {    for (@{$self->{usemap}}) {
774    checker => sub {      unless ($self->{map}->{$_->[0]}) {
775      my (undef, $el, $onerror) = @_;        $self->{onerror}->(node => $_->[1], type => 'no referenced map',
776      my $children = [];                           level => $self->{level}->{must});
     my @nodes = (@{$el->child_nodes});  
   
     my $phase = 'before dt';  
     while (@nodes) {  
       my $node = shift @nodes;  
       my $nt = $node->node_type;  
       if ($nt == 1) {  
         if ($phase eq 'before dt') {  
           if ($node->manakai_element_type_match ($HTML_NS, 'dt')) {  
             $phase = 'before dd';  
           } elsif ($node->manakai_element_type_match ($HTML_NS, 'dd')) {  
             $onerror->(node => $node, type => 'element missing before:dt');  
             $phase = 'before dt';  
           } else {  
             $onerror->(node => $node, type => 'element not allowed');  
           }  
         } else { # before dd  
           if ($node->manakai_element_type_match ($HTML_NS, 'dd')) {  
             $phase = 'before dt';  
           } elsif ($node->manakai_element_type_match ($HTML_NS, 'dt')) {  
             $onerror->(node => $node, type => 'element missing before:dd');  
             $phase = 'before dd';  
           } else {  
             $onerror->(node => $node, type => 'element not allowed');  
           }  
         }  
         TP: {  
           for (@{$HTMLTransparentElements}) {  
             if ($node->manakai_element_type_match ($_->[0], $_->[1])) {  
               unshift @nodes, @{$node->child_nodes};  
               last TP;  
             }  
           }  
           push @$children, $node;  
         } # TP  
       } elsif ($nt == 3 or $nt == 4) {  
         if ($node->data =~ /[^\x09-\x0D\x20]/) {  
           $onerror->(node => $node, type => 'character not allowed');  
         }  
       } elsif ($nt == 5) {  
         unshift @nodes, @{$node->child_nodes};  
       }  
777      }      }
778      if ($phase eq 'before dd') {    }
779        $onerror->(node => $el, type => 'element missing before:dd');  
780      for (@{$self->{contextmenu}}) {
781        unless ($self->{menu}->{$_->[0]}) {
782          $self->{onerror}->(node => $_->[1], type => 'no referenced menu',
783                             level => $self->{level}->{must});
784      }      }
785      return ($children);    }
   },  
 };  
786    
787  $Element->{$HTML_NS}->{pre} = {    delete $self->{plus_elements};
788    checker => $HTMLStrictlyInlineChecker,    delete $self->{minus_elements};
789  };    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}->{ol} = {  sub _add_minus_elements ($$@) {
800    checker => sub {    my $self = shift;
801      my (undef, $el, $onerror) = @_;    my $element_state = shift;
802      my $children = [];    for my $elements (@_) {
803      my @nodes = (@{$el->child_nodes});      for my $nsuri (keys %$elements) {
804          for my $ln (keys %{$elements->{$nsuri}}) {
805      while (@nodes) {          unless ($self->{minus_elements}->{$nsuri}->{$ln}) {
806        my $node = shift @nodes;            $element_state->{minus_elements_original}->{$nsuri}->{$ln} = 0;
807        my $nt = $node->node_type;            $self->{minus_elements}->{$nsuri}->{$ln} = 1;
       if ($nt == 1) {  
         unless ($node->manakai_element_type_match ($HTML_NS, 'li')) {  
           $onerror->(node => $node, type => 'element not allowed');  
         }  
         TP: {  
           for (@{$HTMLTransparentElements}) {  
             if ($node->manakai_element_type_match ($_->[0], $_->[1])) {  
               unshift @nodes, @{$node->child_nodes};  
               last TP;  
             }  
           }  
           push @$children, $node;  
         } # TP  
       } elsif ($nt == 3 or $nt == 4) {  
         if ($node->data =~ /[^\x09-\x0D\x20]/) {  
           $onerror->(node => $node, type => 'character not allowed');  
808          }          }
       } elsif ($nt == 5) {  
         unshift @nodes, @{$node->child_nodes};  
809        }        }
810      }      }
811      return ($children);    }
812    },  } # _add_minus_elements
 };  
   
 $Element->{$HTML_NS}->{ul} = {  
   checker => $Element->{$HTML_NS}->{ol}->{checker},  
 };  
813    
814  ## TODO: li  sub _remove_minus_elements ($$) {
815      my $self = shift;
816      my $element_state = shift;
817      for my $nsuri (keys %{$element_state->{minus_elements_original}}) {
818        for my $ln (keys %{$element_state->{minus_elements_original}->{$nsuri}}) {
819          delete $self->{minus_elements}->{$nsuri}->{$ln};
820        }
821      }
822    } # _remove_minus_elements
823    
824  $Element->{$HTML_NS}->{dl} = {  sub _add_plus_elements ($$@) {
825    checker => sub {    my $self = shift;
826      my (undef, $el, $onerror) = @_;    my $element_state = shift;
827      my $children = [];    for my $elements (@_) {
828      my @nodes = (@{$el->child_nodes});      for my $nsuri (keys %$elements) {
829          for my $ln (keys %{$elements->{$nsuri}}) {
830      my $phase = 'before dt';          unless ($self->{plus_elements}->{$nsuri}->{$ln}) {
831      while (@nodes) {            $element_state->{plus_elements_original}->{$nsuri}->{$ln} = 0;
832        my $node = shift @nodes;            $self->{plus_elements}->{$nsuri}->{$ln} = 1;
       my $nt = $node->node_type;  
       if ($nt == 1) {  
         if ($phase eq 'in dds') {  
           if ($node->manakai_element_type_match ($HTML_NS, 'dd')) {  
             #$phase = 'in dds';  
           } elsif ($node->manakai_element_type_match ($HTML_NS, 'dt')) {  
             $phase = 'in dts';  
           } else {  
             $onerror->(node => $node, type => 'element not allowed');  
           }  
         } elsif ($phase eq 'in dts') {  
           if ($node->manakai_element_type_match ($HTML_NS, 'dt')) {  
             #$phase = 'in dts';  
           } elsif ($node->manakai_element_type_match ($HTML_NS, 'dd')) {  
             $phase = 'in dds';  
           } else {  
             $onerror->(node => $node, type => 'element not allowed');  
           }  
         } else { # before dt  
           if ($node->manakai_element_type_match ($HTML_NS, 'dt')) {  
             $phase = 'in dts';  
           } elsif ($node->manakai_element_type_match ($HTML_NS, 'dd')) {  
             $onerror->(node => $node, type => 'element missing before:dt');  
             $phase = 'in dds';  
           } else {  
             $onerror->(node => $node, type => 'element not allowed');  
           }  
         }  
         TP: {  
           for (@{$HTMLTransparentElements}) {  
             if ($node->manakai_element_type_match ($_->[0], $_->[1])) {  
               unshift @nodes, @{$node->child_nodes};  
               last TP;  
             }  
           }  
           push @$children, $node;  
         } # TP  
       } elsif ($nt == 3 or $nt == 4) {  
         if ($node->data =~ /[^\x09-\x0D\x20]/) {  
           $onerror->(node => $node, type => 'character not allowed');  
833          }          }
       } elsif ($nt == 5) {  
         unshift @nodes, @{$node->child_nodes};  
834        }        }
835      }      }
836      if ($phase eq 'in dts') {    }
837        $onerror->(node => $el, type => 'element missing before:dd');  } # _add_plus_elements
     }  
     return ($children);  
   },  
 };  
   
 $Element->{$HTML_NS}->{dt} = {  
   checker => $HTMLStrictlyInlineChecker,  
 };  
   
 ## TODO: dd  
   
 ## TODO: a  
   
 ## TODO: q  
   
 $Element->{$HTML_NS}->{cite} = {  
   checker => $HTMLStrictlyInlineChecker,  
 };  
   
 ## TODO: em  
   
 ## TODO: strong, small, m, dfn  
   
 $Element->{$HTML_NS}->{abbr} = {  
   checker => $HTMLStrictlyInlineChecker,  
 };  
   
 $Element->{$HTML_NS}->{time} = {  
   checker => $HTMLStrictlyInlineChecker,  
 };  
   
 $Element->{$HTML_NS}->{meter} = {  
   checker => $HTMLStrictlyInlineChecker,  
 };  
   
 $Element->{$HTML_NS}->{progress} = {  
   checker => $HTMLStrictlyInlineChecker,  
 };  
   
 ## TODO: code  
   
 $Element->{$HTML_NS}->{var} = {  
   checker => $HTMLStrictlyInlineChecker,  
 };  
   
 ## TODO: samp  
   
 $Element->{$HTML_NS}->{kbd} = {  
   checker => $HTMLStrictlyInlineChecker,  
 };  
   
 $Element->{$HTML_NS}->{sub} = {  
   checker => $HTMLStrictlyInlineChecker,  
 };  
   
 $Element->{$HTML_NS}->{sup} = {  
   checker => $HTMLStrictlyInlineChecker,  
 };  
   
 ## TODO: span  
   
 $Element->{$HTML_NS}->{i} = {  
   checker => $HTMLStrictlyInlineChecker,  
 };  
   
 $Element->{$HTML_NS}->{b} = {  
   checker => $HTMLStrictlyInlineChecker,  
 };  
   
 $Element->{$HTML_NS}->{bdo} = {  
   checker => $HTMLStrictlyInlineChecker,  
 };  
   
 $Element->{$HTML_NS}->{ins} = {  
   checker => $HTMLTransparentChecker,  
 };  
838    
839  $Element->{$HTML_NS}->{del} = {  sub _remove_plus_elements ($$) {
840    checker => sub {    my $self = shift;
841      my ($self, $el, $onerror) = @_;    my $element_state = shift;
842      for my $nsuri (keys %{$element_state->{plus_elements_original}}) {
843      my $parent = $el->manakai_parent_element;      for my $ln (keys %{$element_state->{plus_elements_original}->{$nsuri}}) {
844      if (defined $parent) {        delete $self->{plus_elements}->{$nsuri}->{$ln};
       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, $el, $onerror);  
     } else {  
       return $HTMLBlockOrInlineChecker->($self, $el, $onerror);  
845      }      }
846    },    }
847  };  } # _remove_plus_elements
   
 ## TODO: figure  
   
 $Element->{$HTML_NS}->{img} = {  
   checker => $HTMLEmptyChecker,  
 };  
   
 $Element->{$HTML_NS}->{iframe} = {  
   checker => $HTMLTextChecker,  
 };  
   
 $Element->{$HTML_NS}->{embed} = {  
   checker => $HTMLEmptyChecker,  
 };  
   
 $Element->{$HTML_NS}->{param} = {  
   checker => $HTMLEmptyChecker,  
 };  
   
 ## TODO: object  
   
 ## TODO: video, audio  
   
 $Element->{$HTML_NS}->{source} = {  
   checker => $HTMLEmptyChecker,  
 };  
   
 $Element->{$HTML_NS}->{canvas} = {  
   checker => $HTMLInlineChecker,  
 };  
848    
849  $Element->{$HTML_NS}->{map} = {  sub _attr_status_info ($$$) {
850    checker => $HTMLBlockChecker,    my ($self, $attr, $status_code) = @_;
 };  
851    
852  $Element->{$HTML_NS}->{area} = {    if (not ($status_code & FEATURE_ALLOWED)) {
853    checker => $HTMLEmptyChecker,      $self->{onerror}->(node => $attr,
854  };                         type => 'attribute not defined',
855  ## TODO: only in map                         level => $self->{level}->{must});
856      } elsif ($status_code & FEATURE_DEPRECATED_SHOULD) {
857        $self->{onerror}->(node => $attr,
858                           type => 'deprecated:attr',
859                           level => $self->{level}->{should});
860      } elsif ($status_code & FEATURE_DEPRECATED_INFO) {
861        $self->{onerror}->(node => $attr,
862                           type => 'deprecated:attr',
863                           level => $self->{level}->{info});
864      }
865    
866  $Element->{$HTML_NS}->{table} = {    my $status;
867    checker => sub {    if ($status_code & FEATURE_STATUS_REC) {
868      my (undef, $el, $onerror) = @_;      return;
869      my $children = [];    } elsif ($status_code & FEATURE_STATUS_CR) {
870      my @nodes = (@{$el->child_nodes});      $status = 'cr';
871      } elsif ($status_code & FEATURE_STATUS_LC) {
872      my $phase = 'before caption';      $status = 'lc';
873      my $has_tfoot;    } elsif ($status_code & FEATURE_STATUS_WD) {
874      while (@nodes) {      $status = 'wd';
875        my $node = shift @nodes;    } else {
876        my $nt = $node->node_type;      $status = 'non-standard';
877        if ($nt == 1) {    }
878          if ($phase eq 'in tbodys') {    $self->{onerror}->(node => $attr,
879            if ($node->manakai_element_type_match ($HTML_NS, 'tbody')) {                       type => 'status:'.$status.':attr',
880              #$phase = 'in tbodys';                       level => $self->{level}->{info});
881            } elsif (not $has_tfoot and  } # _attr_status_info
882                     $node->manakai_element_type_match ($HTML_NS, 'tfoot')) {  
883              $phase = 'after tfoot';  sub _add_minuses ($@) {
884              $has_tfoot = 1;    my $self = shift;
885            } else {    my $r = {};
886              $onerror->(node => $node, type => 'element not allowed');    for my $list (@_) {
887            }      for my $ns (keys %$list) {
888          } elsif ($phase eq 'in trs') {        for my $ln (keys %{$list->{$ns}}) {
889            if ($node->manakai_element_type_match ($HTML_NS, 'tr')) {          unless ($self->{minuses}->{$ns}->{$ln}) {
890              #$phase = 'in trs';            $self->{minuses}->{$ns}->{$ln} = 1;
891            } elsif (not $has_tfoot and            $r->{$ns}->{$ln} = 1;
                    $node->manakai_element_type_match ($HTML_NS, 'tfoot')) {  
             $phase = 'after tfoot';  
             $has_tfoot = 1;  
           } else {  
             $onerror->(node => $node, type => 'element not allowed');  
           }  
         } elsif ($phase eq 'after thead') {  
           if ($node->manakai_element_type_match ($HTML_NS, 'tbody')) {  
             $phase = 'in tbodys';  
           } elsif ($node->manakai_element_type_match ($HTML_NS, 'tr')) {  
             $phase = 'in trs';  
           } elsif ($node->manakai_element_type_match ($HTML_NS, 'tfoot')) {  
             $phase = 'in tbodys';  
             $has_tfoot = 1;  
           } else {  
             $onerror->(node => $node, type => 'element not allowed');  
           }  
         } elsif ($phase eq 'in colgroup') {  
           if ($node->manakai_element_type_match ($HTML_NS, 'colgroup')) {  
             $phase = 'in colgroup';  
           } elsif ($node->manakai_element_type_match ($HTML_NS, 'thead')) {  
             $phase = 'after thead';  
           } elsif ($node->manakai_element_type_match ($HTML_NS, 'tbody')) {  
             $phase = 'in tbodys';  
           } elsif ($node->manakai_element_type_match ($HTML_NS, 'tr')) {  
             $phase = 'in trs';  
           } elsif ($node->manakai_element_type_match ($HTML_NS, 'tfoot')) {  
             $phase = 'in tbodys';  
             $has_tfoot = 1;  
           } else {  
             $onerror->(node => $node, type => 'element not allowed');  
           }  
         } elsif ($phase eq 'before caption') {  
           if ($node->manakai_element_type_match ($HTML_NS, 'caption')) {  
             $phase = 'in colgroup';  
           } elsif ($node->manakai_element_type_match ($HTML_NS, 'colgroup')) {  
             $phase = 'in colgroup';  
           } elsif ($node->manakai_element_type_match ($HTML_NS, 'thead')) {  
             $phase = 'after thead';  
           } elsif ($node->manakai_element_type_match ($HTML_NS, 'tbody')) {  
             $phase = 'in tbodys';  
           } elsif ($node->manakai_element_type_match ($HTML_NS, 'tr')) {  
             $phase = 'in trs';  
           } elsif ($node->manakai_element_type_match ($HTML_NS, 'tfoot')) {  
             $phase = 'in tbodys';  
             $has_tfoot = 1;  
           } else {  
             $onerror->(node => $node, type => 'element not allowed');  
           }  
         } else { # after tfoot  
           $onerror->(node => $node, type => 'element not allowed');  
         }  
         TP: {  
           for (@{$HTMLTransparentElements}) {  
             if ($node->manakai_element_type_match ($_->[0], $_->[1])) {  
               unshift @nodes, @{$node->child_nodes};  
               last TP;  
             }  
           }  
           push @$children, $node;  
         } # TP  
       } elsif ($nt == 3 or $nt == 4) {  
         if ($node->data =~ /[^\x09-\x0D\x20]/) {  
           $onerror->(node => $node, type => 'character not allowed');  
892          }          }
       } elsif ($nt == 5) {  
         unshift @nodes, @{$node->child_nodes};  
893        }        }
894      }      }
895      return ($children);    }
896    },    return {type => 'plus', list => $r};
897  };  } # _add_minuses
   
 $Element->{$HTML_NS}->{caption} = {  
   checker => $HTMLSignificantStrictlyInlineChecker,  
 };  
898    
899  $Element->{$HTML_NS}->{colgroup} = {  sub _add_pluses ($@) {
900    checker => sub {    my $self = shift;
901      my (undef, $el, $onerror) = @_;    my $r = {};
902      my $children = [];    for my $list (@_) {
903      my @nodes = (@{$el->child_nodes});      for my $ns (keys %$list) {
904          for my $ln (keys %{$list->{$ns}}) {
905      while (@nodes) {          unless ($self->{pluses}->{$ns}->{$ln}) {
906        my $node = shift @nodes;            $self->{pluses}->{$ns}->{$ln} = 1;
907        my $nt = $node->node_type;            $r->{$ns}->{$ln} = 1;
       if ($nt == 1) {  
         unless ($node->manakai_element_type_match ($HTML_NS, 'col')) {  
           $onerror->(node => $node, type => 'element not allowed');  
         }  
         TP: {  
           for (@{$HTMLTransparentElements}) {  
             if ($node->manakai_element_type_match ($_->[0], $_->[1])) {  
               unshift @nodes, @{$node->child_nodes};  
               last TP;  
             }  
           }  
           push @$children, $node;  
         } # TP  
       } elsif ($nt == 3 or $nt == 4) {  
         if ($node->data =~ /[^\x09-\x0D\x20]/) {  
           $onerror->(node => $node, type => 'character not allowed');  
908          }          }
       } elsif ($nt == 5) {  
         unshift @nodes, @{$node->child_nodes};  
909        }        }
910      }      }
911      return ($children);    }
912    },    return {type => 'minus', list => $r};
913  };  } # _add_pluses
   
 $Element->{$HTML_NS}->{col} = {  
   checker => $HTMLEmptyChecker,  
 };  
914    
915  $Element->{$HTML_NS}->{tbody} = {  sub _remove_minuses ($$) {
916    checker => sub {    my ($self, $todo) = @_;
917      my (undef, $el, $onerror) = @_;    if ($todo->{type} eq 'minus') {
918      my $children = [];      for my $ns (keys %{$todo->{list}}) {
919      my @nodes = (@{$el->child_nodes});        for my $ln (keys %{$todo->{list}->{$ns}}) {
920            delete $self->{pluses}->{$ns}->{$ln} if $todo->{list}->{$ns}->{$ln};
     my $has_tr;  
     while (@nodes) {  
       my $node = shift @nodes;  
       my $nt = $node->node_type;  
       if ($nt == 1) {  
         if ($node->manakai_element_type_match ($HTML_NS, 'tr')) {  
           $has_tr = 1;  
         } else {  
           $onerror->(node => $node, type => 'element not allowed');  
         }  
         TP: {  
           for (@{$HTMLTransparentElements}) {  
             if ($node->manakai_element_type_match ($_->[0], $_->[1])) {  
               unshift @nodes, @{$node->child_nodes};  
               last TP;  
             }  
           }  
           push @$children, $node;  
         } # TP  
       } elsif ($nt == 3 or $nt == 4) {  
         if ($node->data =~ /[^\x09-\x0D\x20]/) {  
           $onerror->(node => $node, type => 'character not allowed');  
         }  
       } elsif ($nt == 5) {  
         unshift @nodes, @{$node->child_nodes};  
921        }        }
922      }      }
923      unless ($has_tr) {    } elsif ($todo->{type} eq 'plus') {
924        $onerror->(node => $el, type => 'element missing in:tr');      for my $ns (keys %{$todo->{list}}) {
925      }        for my $ln (keys %{$todo->{list}->{$ns}}) {
926      return ($children);          delete $self->{minuses}->{$ns}->{$ln} if $todo->{list}->{$ns}->{$ln};
   },  
 };  
   
 $Element->{$HTML_NS}->{thead} = {  
   checker => $Element->{$HTML_NS}->{tbody},  
 };  
   
 $Element->{$HTML_NS}->{tfoot} = {  
   checker => $Element->{$HTML_NS}->{tbody},  
 };  
   
 $Element->{$HTML_NS}->{tr} = {  
   checker => sub {  
     my (undef, $el, $onerror) = @_;  
     my $children = [];  
     my @nodes = (@{$el->child_nodes});  
   
     my $has_td;  
     while (@nodes) {  
       my $node = shift @nodes;  
       my $nt = $node->node_type;  
       if ($nt == 1) {  
         if ($node->manakai_element_type_match ($HTML_NS, 'td') or  
             $node->manakai_element_type_match ($HTML_NS, 'th')) {  
           $has_td = 1;  
         } else {  
           $onerror->(node => $node, type => 'element not allowed');  
         }  
         TP: {  
           for (@{$HTMLTransparentElements}) {  
             if ($node->manakai_element_type_match ($_->[0], $_->[1])) {  
               unshift @nodes, @{$node->child_nodes};  
               last TP;  
             }  
           }  
           push @$children, $node;  
         } # TP  
       } elsif ($nt == 3 or $nt == 4) {  
         if ($node->data =~ /[^\x09-\x0D\x20]/) {  
           $onerror->(node => $node, type => 'character not allowed');  
         }  
       } elsif ($nt == 5) {  
         unshift @nodes, @{$node->child_nodes};  
927        }        }
928      }      }
929      unless ($has_td) {    } else {
930        $onerror->(node => $el, type => 'element missing in:td or th');      die "$0: Unknown +- type: $todo->{type}";
931      }    }
932      return ($children);    1;
933    },  } # _remove_minuses
 };  
   
 $Element->{$HTML_NS}->{td} = {  
   checker => $HTMLBlockOrInlineChecker,  
 };  
   
 $Element->{$HTML_NS}->{th} = {  
   checker => $HTMLBlockOrInlineChecker,  
 };  
   
 ## TODO: forms  
   
 ## TODO: script  
   
 ## TODO: noscript  
   
 $Element->{$HTML_NS}->{'event-source'} = {  
   checker => $HTMLEmptyChecker,  
 };  
934    
935  $Element->{$HTML_NS}->{details} = {  ## NOTE: Priority for "minuses" and "pluses" are currently left
936    checker => sub {  ## undefined and implemented inconsistently; it is not a problem for
937      my (undef, $el, $onerror) = @_;  ## now, since no element belongs to both lists.
938      my $children = [];  
939      my @nodes = (@{$el->child_nodes});  sub _check_get_children ($$$) {
940      my ($self, $node, $parent_todo) = @_;
941      my $has_legend;    my $new_todos = [];
942      my $has_non_legend;    my $sib = [];
943      my $content = 'block-or-inline'; # or 'block' or 'inline'    TP: {
944      my @block_not_inline;      my $node_ns = $node->namespace_uri;
945      while (@nodes) {      $node_ns = '' unless defined $node_ns;
946        my $node = shift @nodes;      my $node_ln = $node->manakai_local_name;
947        my $nt = $node->node_type;      if ($HTMLTransparentElements->{$node_ns}->{$node_ln}) {
948        if ($nt == 1) {        if ($node_ns eq $HTML_NS and $node_ln eq 'noscript') {
949          if (not $has_legend and          if ($parent_todo->{flag}->{in_head}) {
950              $node->manakai_element_type_match ($HTML_NS, 'legend')) {            #
           $has_legend = 1;  
           if ($has_non_legend) {  
             $onerror->(node => $node, type => 'element not allowed');  
           }  
         } elsif ($content eq 'block') {  
           $has_non_legend = 1;  
           CHK: {  
             for (@{$HTMLBlockLevelElements}) {  
               if ($node->manakai_element_type_match ($_->[0], $_->[1])) {  
                 last CHK;  
               }  
             }  
             $onerror->(node => $node, type => 'element not allowed');  
           } # CHK  
         } elsif ($content eq 'inline') {  
           $has_non_legend = 1;  
           CHK: {  
             for (@{$HTMLStrictlyInlineLevelElements},  
                  @{$HTMLStructuredInlineLevelElements}) {  
               if ($node->manakai_element_type_match ($_->[0], $_->[1])) {  
                 last CHK;  
               }  
             }  
             $onerror->(node => $node, type => 'element not allowed');  
           } # CHK  
951          } else {          } else {
952            $has_non_legend = 1;            my $end = $self->_add_minuses ({$HTML_NS, {noscript => 1}});
953            my $is_block;            push @$sib, $end;
           my $is_inline;  
           for (@{$HTMLBlockLevelElements}) {  
             if ($node->manakai_element_type_match ($_->[0], $_->[1])) {  
               $is_block = 1;  
               last;  
             }  
           }  
954                        
955            for (@{$HTMLStrictlyInlineLevelElements},            unshift @$sib, @{$node->child_nodes};
956                 @{$HTMLStructuredInlineLevelElements}) {            push @$new_todos, {type => 'element-attributes', node => $node};
957              if ($node->manakai_element_type_match ($_->[0], $_->[1])) {            last TP;
958                $is_inline = 1;          }
959                last;        } 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 @block_not_inline, $node if $is_block and not $is_inline;          push @$new_todos,
964            unless ($is_block) {              {type => 'code',
965              $content = 'inline';               code => sub {
966              for (@block_not_inline) {                 $parent_todo->{flag}->{has_descendant}->{significant} = 0
967                $onerror->(node => $_, type => 'element not allowed');                     if not $sig_flag;
968              }               }};
969              unless ($is_inline) {          last TP;
970                $onerror->(node => $node, type => 'element not allowed');        } else {
971              }          unshift @$sib, @{$node->child_nodes};
972            }          push @$new_todos, {type => 'element-attributes', node => $node};
973          }          last TP;
         TP: {  
           for (@{$HTMLTransparentElements}) {  
             if ($node->manakai_element_type_match ($_->[0], $_->[1])) {  
               unshift @nodes, @{$node->child_nodes};  
               last TP;  
             }  
           }  
           push @$children, $node;  
         } # TP  
       } elsif ($nt == 3 or $nt == 4) {  
         if ($node->data =~ /[^\x09-\x0D\x20]/) {  
           $has_non_legend = 1;  
           if ($content eq 'block') {  
             $onerror->(node => $node, type => 'character not allowed');  
           } else {  
             $content = 'inline';  
             for (@block_not_inline) {  
               $onerror->(node => $_, type => 'element not allowed');  
             }  
           }  
         }  
       } elsif ($nt == 5) {  
         unshift @nodes, @{$node->child_nodes};  
974        }        }
975      }      }
976      unless ($has_legend) {      if ($node_ns eq $HTML_NS and ($node_ln eq 'video' or $node_ln eq 'audio')) {
977        $onerror->(node => $el, type => 'element missing in:legend');        if ($node->has_attribute_ns (undef, 'src')) {
978      }          unshift @$sib, @{$node->child_nodes};
979      return ($children);          push @$new_todos, {type => 'element-attributes', node => $node};
980    },          last TP;
981  };        } else {
982            my @cn = @{$node->child_nodes};
983  $Element->{$HTML_NS}->{datagrid} = {          CN: while (@cn) {
984    checker => $HTMLBlockChecker,            my $cn = shift @cn;
985  };            my $cnt = $cn->node_type;
986              if ($cnt == 1) {
987  $Element->{$HTML_NS}->{command} = {              my $cn_nsuri = $cn->namespace_uri;
988    checker => $HTMLEmptyChecker,              $cn_nsuri = '' unless defined $cn_nsuri;
989  };              if ($cn_nsuri eq $HTML_NS and $cn->manakai_local_name eq 'source') {
990                  #
991  $Element->{$HTML_NS}->{menu} = {              } else {
992    checker => sub {                last CN;
     my (undef, $el, $onerror) = @_;  
     my $children = [];  
     my @nodes = (@{$el->child_nodes});  
       
     my $content = 'li or inline';  
     while (@nodes) {  
       my $node = shift @nodes;  
       my $nt = $node->node_type;  
       if ($nt == 1) {  
         if ($node->manakai_element_type_match ($HTML_NS, 'li')) {  
           if ($content eq 'inline') {  
             $onerror->(node => $node, type => 'element not allowed');  
           } elsif ($content eq 'li or inline') {  
             $content = 'li';  
           }  
         } else {  
           CHK: {  
             for (@{$HTMLStrictlyInlineLevelElements},  
                  @{$HTMLStructuredInlineLevelElements}) {  
               if ($node->manakai_element_type_match ($_->[0], $_->[1])) {  
                 $content = 'inline';  
                 last CHK;  
               }  
993              }              }
994              $onerror->(node => $node, type => 'element not allowed');            } elsif ($cnt == 3 or $cnt == 4) {
995            } # CHK              if ($cn->data =~ /[^\x09\x0A\x0C\x0D\x20]/) {
996          }                last CN;
         TP: {  
           for (@{$HTMLTransparentElements}) {  
             if ($node->manakai_element_type_match ($_->[0], $_->[1])) {  
               unshift @nodes, @{$node->child_nodes};  
               last TP;  
997              }              }
998            }            }
999            push @$children, $node;          } # CN
1000          } # TP          unshift @$sib, @cn;
1001        } elsif ($nt == 3 or $nt == 4) {        }
1002          if ($node->data =~ /[^\x09-\x0D\x20]/) {      } elsif ($node_ns eq $HTML_NS and $node_ln eq 'object') {
1003            if ($content eq 'li') {        my @cn = @{$node->child_nodes};
1004              $onerror->(node => $node, type => 'character not allowed');        CN: while (@cn) {
1005            } elsif ($content eq 'li or inline') {          my $cn = shift @cn;
1006              $content = 'inline';          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        } elsif ($nt == 5) {        } # CN
1021          unshift @nodes, @{$node->child_nodes};        unshift @$sib, @cn;
       }  
1022      }      }
1023      return ($children);      push @$new_todos, {type => 'element', node => $node};
1024    },    } # TP
1025  };    
1026      for my $new_todo (@$new_todos) {
1027  ## TODO: legend      $new_todo->{flag} = {%{$parent_todo->{flag} or {}}};
1028      }
1029  $Element->{$HTML_NS}->{div} = {    
1030    checker => $HTMLStyledBlockOrInlineChecker,    return ($sib, $new_todos);
1031  };  } # _check_get_children
   
 $Element->{$HTML_NS}->{font} = {  
   checker => $HTMLTransparentChecker,  
 };  
1032    
1033  my $Attr = {  =head1 LICENSE
1034    
1035  };  Copyright 2007-2008 Wakaba <[email protected]>
1036    
1037  sub check_element ($$$) {  This library is free software; you can redistribute it
1038    my ($self, $el, $onerror) = @_;  and/or modify it under the same terms as Perl itself.
1039    
1040    my @nodes = ($el);  =cut
   while (@nodes) {  
     my $node = shift @nodes;  
     my $nsuri = $node->namespace_uri;  
     $nsuri = '' unless defined $nsuri;  
     my $ln = $node->manakai_local_name;  
     my $eldef = $Element->{$nsuri}->{$ln} ||  
       $Element->{$nsuri}->{''} ||  
       $ElementDefault;  
     my ($children) = $eldef->{checker}->($self, $node, $onerror);  
     push @nodes, @$children;  
   }  
 } # check_element  
1041    
1042  1;  1;
1043  # $Date$  # $Date$
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.97
[email protected]
 ViewVC Help
Powered by ViewVC 1.1.24