/[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.83 by wakaba, Fri Aug 15 12:46:44 2008 UTC revision 1.97 by wakaba, Sun Sep 21 09:45:02 2008 UTC
# Line 72  our $AttrChecker = { Line 72  our $AttrChecker = {
72          require Whatpm::LangTag;          require Whatpm::LangTag;
73          Whatpm::LangTag->check_rfc3066_language_tag ($value, sub {          Whatpm::LangTag->check_rfc3066_language_tag ($value, sub {
74            $self->{onerror}->(@_, node => $attr);            $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        ## NOTE: Is an RFC 3066-valid (but RFC 4647-invalid) language tag        ## NOTE: Is an RFC 3066-valid (but RFC 4646-invalid) language tag
83        ## allowed today?        ## allowed today?
84    
85        ## TODO: test data        ## TODO: test data
86    
87          my $nsuri = $attr->owner_element->namespace_uri;
88          if (defined $nsuri and $nsuri eq $HTML_NS) {
89            my $lang_attr = $attr->owner_element->get_attribute_node_ns
90                (undef, 'lang');
91            if ($lang_attr) {
92              my $lang_attr_value = $lang_attr->value;
93              $lang_attr_value =~ tr/A-Z/a-z/; ## ASCII case-insensitive
94              my $value = $value;
95              $value =~ tr/A-Z/a-z/; ## ASCII case-insensitive
96              if ($lang_attr_value ne $value) {
97                ## NOTE: HTML5 Section "The |lang| and |xml:lang| attributes"
98                $self->{onerror}->(node => $attr,
99                                   type => 'xml:lang ne lang',
100                                   level => $self->{level}->{must});
101              }
102            }
103          }
104    
105        if ($attr->owner_document->manakai_is_html) { # MUST NOT        if ($attr->owner_document->manakai_is_html) { # MUST NOT
106          $self->{onerror}->(node => $attr, type => 'in HTML:xml:lang',          $self->{onerror}->(node => $attr, type => 'in HTML:xml:lang',
107                             level => $self->{level}->{must});                             level => $self->{level}->{must});
# Line 179  our $AttrChecker = { Line 197  our $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    
# Line 205  our %AnyChecker = ( Line 225  our %AnyChecker = (
225      my ($self, $item, $element_state) = @_;      my ($self, $item, $element_state) = @_;
226      for my $attr (@{$item->{node}->attributes}) {      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                
       load_ns_module ($attr_ns);  
   
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}        my $status = $AttrStatus->{$attr_ns}->{$attr_ln}
# Line 280  our $HTMLEmbeddedContent = { Line 302  our $HTMLEmbeddedContent = {
302    ## embedded content.    ## 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    }; # $IsInHTMLInteractiveContent
324    
325  my $HTMLTransparentElements = {  my $HTMLTransparentElements = {
326    $HTML_NS => {qw/ins 1 del 1 font 1 noscript 1 canvas 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  };  };
# Line 304  $Element->{q<http://www.w3.org/1999/02/2 Line 346  $Element->{q<http://www.w3.org/1999/02/2
346      my $rdf = Whatpm::RDFXML->new;      my $rdf = Whatpm::RDFXML->new;
347      ## TODO: Should we make bnodeid unique in a document?      ## TODO: Should we make bnodeid unique in a document?
348      $rdf->{onerror} = $self->{onerror};      $rdf->{onerror} = $self->{onerror};
349        $rdf->{level} = $self->{level};
350      $rdf->{ontriple} = sub {      $rdf->{ontriple} = sub {
351        my %opt = @_;        my %opt = @_;
352        push @$triple,        push @$triple,
# Line 340  my $default_error_level = { Line 383  my $default_error_level = {
383    should => 's',    should => 's',
384    warn => 'w',    warn => 'w',
385    good => 'w',    good => 'w',
386      undefined => 'w',
387    info => 'i',    info => 'i',
388    
389    uncertain => 'u',    uncertain => 'u',
390    
391    fact => 'm',    html4_fact => 'm',
392      html5_no_may => 'm',
393    
394    xml_error => 'm', ## TODO: correct?    xml_error => 'm', ## TODO: correct?
395      xml_id_error => 'm', ## TODO: ?
396    nc => 'm', ## XML Namespace Constraints ## TODO: correct?    nc => 'm', ## XML Namespace Constraints ## TODO: correct?
397    
398      ## |Whatpm::URIChecker|
399      uri_syntax => 'm',
400      uri_fact => 'm',
401      uri_lc_must => 'm',
402      uri_lc_should => 'w',
403    
404      ## |Whatpm::IMTChecker|
405      mime_must => 'm', # lowercase "must"
406      mime_fact => 'm',
407      mime_strongly_discouraged => 'w',
408      mime_discouraged => 'w',
409    
410      ## |Whatpm::LangTag|
411      langtag_fact => 'm',
412    
413      ## |Whatpm::RDFXML|
414      rdf_fact => 'm',
415      rdf_grammer => 'm',
416      rdf_lc_must => 'm',
417    
418      ## |Message::Charset::Info| and |Whatpm::Charset::DecodeHandle|
419      charset_variant => 'm',
420        ## An error caused by use of a variant charset that is not conforming
421        ## to the original charset (e.g. use of 0x80 in an ISO-8859-1 document
422        ## which is interpreted as a Windows-1252 document instead).
423      charset_fact => 'm',
424      iso_shall => 'm',
425  };  };
426    
427  sub check_document ($$$;$) {  sub check_document ($$$;$) {
# Line 375  sub check_document ($$$;$) { Line 451  sub check_document ($$$;$) {
451    ## ISSUE: Unexpanded entity references and HTML5 conformance    ## ISSUE: Unexpanded entity references and HTML5 conformance
452        
453    my $docel_nsuri = $docel->namespace_uri;    my $docel_nsuri = $docel->namespace_uri;
454    $docel_nsuri = '' unless defined $docel_nsuri;    if (defined $docel_nsuri) {
455    load_ns_module ($docel_nsuri);      load_ns_module ($docel_nsuri);
456      } else {
457        $docel_nsuri = '';
458      }
459    my $docel_def = $Element->{$docel_nsuri}->{$docel->manakai_local_name} ||    my $docel_def = $Element->{$docel_nsuri}->{$docel->manakai_local_name} ||
460      $Element->{$docel_nsuri}->{''} ||      $Element->{$docel_nsuri}->{''} ||
461      $ElementDefault;      $ElementDefault;
# Line 409  sub check_document ($$$;$) { Line 488  sub check_document ($$$;$) {
488        if (not $doc->manakai_has_bom and        if (not $doc->manakai_has_bom and
489            not defined $doc->manakai_charset) {            not defined $doc->manakai_charset) {
490          unless ($charset->{is_html_ascii_superset}) {          unless ($charset->{is_html_ascii_superset}) {
491            $onerror->(node => $doc, level => $self->{level}->{must},            $onerror->(node => $doc,
492                         level => $self->{level}->{must},
493                       type => 'non ascii superset',                       type => 'non ascii superset',
494                       text => $charset_name);                       text => $charset_name);
495          }          }
496                    
497          if (not $self->{has_charset} and ## TODO: This does not work now.          if (not $self->{has_charset} and ## TODO: This does not work now.
498              not $charset->{iana_names}->{'us-ascii'}) {              not $charset->{iana_names}->{'us-ascii'}) {
499            $onerror->(node => $doc, level => $self->{level}->{must},            $onerror->(node => $doc,
500                         level => $self->{level}->{must},
501                       type => 'no character encoding declaration',                       type => 'no character encoding declaration',
502                       text => $charset_name);                       text => $charset_name);
503          }          }
# Line 427  sub check_document ($$$;$) { Line 508  sub check_document ($$$;$) {
508        } elsif ($charset->{iana_names}->{'jis_x0212-1990'} or        } elsif ($charset->{iana_names}->{'jis_x0212-1990'} or
509                 $charset->{iana_names}->{'x-jis0208'} or                 $charset->{iana_names}->{'x-jis0208'} or
510                 $charset->{iana_names}->{'utf-32'} or ## ISSUE: UTF-32BE? UTF-32LE?                 $charset->{iana_names}->{'utf-32'} or ## ISSUE: UTF-32BE? UTF-32LE?
511                 $charset->{is_ebcdic_based}) {                 ($charset->{category} & Message::Charset::Info::CHARSET_CATEGORY_EBCDIC ())) {
512          $onerror->(node => $doc,          $onerror->(node => $doc,
513                     type => 'bad character encoding',                     type => 'bad character encoding',
514                     text => $charset_name,                     text => $charset_name,
# Line 477  sub check_element ($$$;$) { Line 558  sub check_element ($$$;$) {
558    $self->{plus_elements} = {};    $self->{plus_elements} = {};
559    $self->{minus_elements} = {};    $self->{minus_elements} = {};
560    $self->{id} = {};    $self->{id} = {};
561      $self->{form} = {};
562    $self->{term} = {};    $self->{term} = {};
563    $self->{usemap} = [];    $self->{usemap} = [];
564    $self->{ref} = []; # datetemplate data references    $self->{ref} = []; # datetemplate data references
# Line 510  next unless $code;## TODO: temp. Line 592  next unless $code;## TODO: temp.
592        $code->(@$item);        $code->(@$item);
593      } elsif ($item->{type} eq 'element') {      } elsif ($item->{type} eq 'element') {
594        my $el_nsuri = $item->{node}->namespace_uri;        my $el_nsuri = $item->{node}->namespace_uri;
595        $el_nsuri = '' unless defined $el_nsuri;        if (defined $el_nsuri) {
596            load_ns_module ($el_nsuri);
597          } else {
598            $el_nsuri = '';
599          }
600        my $el_ln = $item->{node}->manakai_local_name;        my $el_ln = $item->{node}->manakai_local_name;
601          
       load_ns_module ($el_nsuri);  
   
602        my $element_state = {};        my $element_state = {};
603        my $eldef = $Element->{$el_nsuri}->{$el_ln} ||        my $eldef = $Element->{$el_nsuri}->{$el_ln} ||
604            $Element->{$el_nsuri}->{''} ||            $Element->{$el_nsuri}->{''} ||
# Line 614  next unless $code;## TODO: temp. Line 698  next unless $code;## TODO: temp.
698            }            }
699          } elsif ($child_nt == 3 or # TEXT_NODE          } elsif ($child_nt == 3 or # TEXT_NODE
700                   $child_nt == 4) { # CDATA_SECTION_NODE                   $child_nt == 4) { # CDATA_SECTION_NODE
701            my $has_significant = ($child->data =~ /[^\x09-\x0D\x20]/);            my $has_significant = ($child->data =~ /[^\x09\x0A\x0C\x0D\x20]/);
702            push @new_item, [$content_def->{check_child_text},            push @new_item, [$content_def->{check_child_text},
703                             $self, $item, $child, $has_significant,                             $self, $item, $child, $has_significant,
704                             $content_state, $element_state];                             $content_state, $element_state];
# Line 704  next unless $code;## TODO: temp. Line 788  next unless $code;## TODO: temp.
788    delete $self->{minus_elements};    delete $self->{minus_elements};
789    delete $self->{onerror};    delete $self->{onerror};
790    delete $self->{id};    delete $self->{id};
791      delete $self->{form};
792    delete $self->{usemap};    delete $self->{usemap};
793    delete $self->{ref};    delete $self->{ref};
794    delete $self->{template};    delete $self->{template};
# Line 907  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            }            }
# Line 928  sub _check_get_children ($$$) { Line 1013  sub _check_get_children ($$$) {
1013              last CN;              last CN;
1014            }            }
1015          } elsif ($cnt == 3 or $cnt == 4) {          } elsif ($cnt == 3 or $cnt == 4) {
1016            if ($cn->data =~ /[^\x09-\x0D\x20]/) {            if ($cn->data =~ /[^\x09\x0A\x0C\x0D\x20]/) {
1017              last CN;              last CN;
1018            }            }
1019          }          }
Legend:
Removed from v.1.83  
changed lines
  Added in v.1.97
[email protected]
 ViewVC Help
Powered by ViewVC 1.1.24