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

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

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

revision 1.3 by wakaba, Fri Aug 17 05:55:44 2007 UTC revision 1.4 by wakaba, Fri Aug 17 11:53:52 2007 UTC
# Line 505  my $GetHTMLBooleanAttrChecker = sub { Line 505  my $GetHTMLBooleanAttrChecker = sub {
505  ## |rel| attribute (unordered set of space separated tokens,  ## |rel| attribute (unordered set of space separated tokens,
506  ## whose allowed values are defined by the section on link types)  ## whose allowed values are defined by the section on link types)
507  my $HTMLLinkTypesAttrChecker = sub {  my $HTMLLinkTypesAttrChecker = sub {
508    my ($a_or_area, $self, $attr) = @_;    my ($a_or_area, $todo, $self, $attr) = @_;
509    my %word;    my %word;
510    for my $word (grep {length $_} split /[\x09-\x0D\x20]/, $attr->value) {    for my $word (grep {length $_} split /[\x09-\x0D\x20]/, $attr->value) {
511      unless ($word{$word}) {      unless ($word{$word}) {
# Line 540  my $HTMLLinkTypesAttrChecker = sub { Line 540  my $HTMLLinkTypesAttrChecker = sub {
540          $self->{onerror}->(node => $attr,          $self->{onerror}->(node => $attr,
541                             type => 'link type:non-conforming:'.$word);                             type => 'link type:non-conforming:'.$word);
542        }        }
543          if (defined $def->{effect}->[$a_or_area]) {
544            if ($word eq 'alternate') {
545              #
546            } elsif ($def->{effect}->[$a_or_area] eq 'hyperlink') {
547              $todo->{has_hyperlink_link_type} = 1;
548            }
549          }
550        if ($def->{unique}) {        if ($def->{unique}) {
551          unless ($self->{has_link_type}->{$word}) {          unless ($self->{has_link_type}->{$word}) {
552            $self->{has_link_type}->{$word} = 1;            $self->{has_link_type}->{$word} = 1;
# Line 553  my $HTMLLinkTypesAttrChecker = sub { Line 560  my $HTMLLinkTypesAttrChecker = sub {
560                           type => 'link type:'.$word);                           type => 'link type:'.$word);
561      }      }
562    }    }
563      $todo->{has_hyperlink_link_type} = 1
564          if $word{alternate} and not $word{stylesheet};
565    ## TODO: The Pingback 1.0 specification, which is referenced by HTML5,    ## TODO: The Pingback 1.0 specification, which is referenced by HTML5,
566    ## says that using both X-Pingback: header field and HTML    ## says that using both X-Pingback: header field and HTML
567    ## <link rel=pingback> is deprecated and if both appears they    ## <link rel=pingback> is deprecated and if both appears they
# Line 576  my $HTMLURIAttrChecker = sub { Line 585  my $HTMLURIAttrChecker = sub {
585                         type => 'URI::'.$opt{type}.                         type => 'URI::'.$opt{type}.
586                         (defined $opt{position} ? ':'.$opt{position} : ''));                         (defined $opt{position} ? ':'.$opt{position} : ''));
587    });    });
588      $self->{has_uri_attr} = 1;
589  }; # $HTMLURIAttrChecker  }; # $HTMLURIAttrChecker
590    
591  ## A space separated list of one or more URIs (or IRIs)  ## A space separated list of one or more URIs (or IRIs)
# Line 597  my $HTMLSpaceURIsAttrChecker = sub { Line 607  my $HTMLSpaceURIsAttrChecker = sub {
607    ## ISSUE: A sequence of white space characters are conformant?    ## ISSUE: A sequence of white space characters are conformant?
608    ## ISSUE: A zero-length string is conformant? (It does contain a relative reference, i.e. same as base URI.)    ## ISSUE: A zero-length string is conformant? (It does contain a relative reference, i.e. same as base URI.)
609    ## NOTE: Duplication seems not an error.    ## NOTE: Duplication seems not an error.
610      $self->{has_uri_attr} = 1;
611  }; # $HTMLSpaceURIsAttrChecker  }; # $HTMLSpaceURIsAttrChecker
612    
613  my $HTMLDatetimeAttrChecker = sub {  my $HTMLDatetimeAttrChecker = sub {
# Line 1028  $Element->{$HTML_NS}->{title} = { Line 1039  $Element->{$HTML_NS}->{title} = {
1039    checker => $HTMLTextChecker,    checker => $HTMLTextChecker,
1040  };  };
1041    
 ## TODO: |base| with |href| MUST come before elements with URI attributes.  
 ## For example: <title xml:base=""/><base href=""/> is non-conformant.  
 ## TODO: |base| with |target| MUST come before any hyperlink.  
1042  $Element->{$HTML_NS}->{base} = {  $Element->{$HTML_NS}->{base} = {
1043    attrs_checker => $GetHTMLAttrsChecker->({    attrs_checker => sub {
1044      href => $HTMLURIAttrChecker,      my ($self, $todo) = @_;
1045      target => $HTMLTargetAttrChecker,  
1046    }),      if ($self->{has_uri_attr} and
1047            $todo->{node}->has_attribute_ns (undef, 'href')) {
1048          ## ISSUE: Are these examples conforming?
1049          ## <head profile="a b c"><base href> (except for |profile|'s
1050          ## non-conformance)
1051          ## <title xml:base="relative"/><base href/> (maybe it should be)
1052          ## <unknown xmlns="relative"/><base href/> (assuming that
1053          ## |{relative}:unknown| is allowed before XHTML |base| (unlikely, though))
1054          ## <?xml-stylesheet href="relative"?>...<base href=""/>
1055          ## NOTE: These are non-conformant anyway because of |head|'s content model:
1056          ## <style>@import 'relative';</style><base href>
1057          ## <script>location.href = 'relative';</script><base href>
1058          $self->{onerror}->(node => $todo->{node},
1059                             type => 'basehref after URI attribute');
1060        }
1061        if ($self->{has_hyperlink_element} and
1062            $todo->{node}->has_attribute_ns (undef, 'target')) {
1063          ## ISSUE: Are these examples conforming?
1064          ## <head><title xlink:href=""/><base target="name"/></head>
1065          ## <xbl:xbl>...<svg:a href=""/>...</xbl:xbl><base target="name"/>
1066          ## (assuming that |xbl:xbl| is allowed before |base|)
1067          ## NOTE: These are non-conformant anyway because of |head|'s content model:
1068          ## <link href=""/><base target="name"/>
1069          ## <link rel=unknown href=""><base target=name>
1070          $self->{onerror}->(node => $todo->{node},
1071                             type => 'basetarget after hyperlink');
1072        }
1073    
1074        return $GetHTMLAttrsChecker->({
1075          href => $HTMLURIAttrChecker,
1076          target => $HTMLTargetAttrChecker,
1077        })->($self, $todo);
1078      },
1079    checker => $HTMLEmptyChecker,    checker => $HTMLEmptyChecker,
1080  };  };
1081    
# Line 1044  $Element->{$HTML_NS}->{link} = { Line 1084  $Element->{$HTML_NS}->{link} = {
1084      my ($self, $todo) = @_;      my ($self, $todo) = @_;
1085      $GetHTMLAttrsChecker->({      $GetHTMLAttrsChecker->({
1086        href => $HTMLURIAttrChecker,        href => $HTMLURIAttrChecker,
1087        rel => sub { $HTMLLinkTypesAttrChecker->(0, @_) },        rel => sub { $HTMLLinkTypesAttrChecker->(0, $todo, @_) },
1088        media => $HTMLMQAttrChecker,        media => $HTMLMQAttrChecker,
1089        hreflang => $HTMLLanguageTagAttrChecker,        hreflang => $HTMLLanguageTagAttrChecker,
1090        type => $HTMLIMTAttrChecker,        type => $HTMLIMTAttrChecker,
1091        ## NOTE: Though |title| has special semantics,        ## NOTE: Though |title| has special semantics,
1092        ## syntactically same as the |title| as global attribute.        ## syntactically same as the |title| as global attribute.
1093      })->($self, $todo);      })->($self, $todo);
1094      unless ($todo->{node}->has_attribute_ns (undef, 'href')) {      if ($todo->{node}->has_attribute_ns (undef, 'href')) {
1095          $self->{has_hyperlink_element} = 1 if $todo->{has_hyperlink_link_type};
1096        } else {
1097        $self->{onerror}->(node => $todo->{node},        $self->{onerror}->(node => $todo->{node},
1098                           type => 'attribute missing:href');                           type => 'attribute missing:href');
1099      }      }
# Line 1629  $Element->{$HTML_NS}->{a} = { Line 1671  $Element->{$HTML_NS}->{a} = {
1671                       target => $HTMLTargetAttrChecker,                       target => $HTMLTargetAttrChecker,
1672                       href => $HTMLURIAttrChecker,                       href => $HTMLURIAttrChecker,
1673                       ping => $HTMLSpaceURIsAttrChecker,                       ping => $HTMLSpaceURIsAttrChecker,
1674                       rel => sub { $HTMLLinkTypesAttrChecker->(1, @_) },                       rel => sub { $HTMLLinkTypesAttrChecker->(1, $todo, @_) },
1675                       media => $HTMLMQAttrChecker,                       media => $HTMLMQAttrChecker,
1676                       hreflang => $HTMLLanguageTagAttrChecker,                       hreflang => $HTMLLanguageTagAttrChecker,
1677                       type => $HTMLIMTAttrChecker,                       type => $HTMLIMTAttrChecker,
# Line 1651  $Element->{$HTML_NS}->{a} = { Line 1693  $Element->{$HTML_NS}->{a} = {
1693        }        }
1694      }      }
1695    
1696      unless (defined $attr{href}) {      if (defined $attr{href}) {
1697          $self->{has_hyperlink_element} = 1;
1698        } else {
1699        for (qw/target ping rel media hreflang type/) {        for (qw/target ping rel media hreflang type/) {
1700          if (defined $attr{$_}) {          if (defined $attr{$_}) {
1701            $self->{onerror}->(node => $attr{$_},            $self->{onerror}->(node => $attr{$_},
# Line 2019  $Element->{$HTML_NS}->{del} = { Line 2063  $Element->{$HTML_NS}->{del} = {
2063    
2064  ## TODO: figure  ## TODO: figure
2065    
2066    ## TODO: |alt|
2067  $Element->{$HTML_NS}->{img} = {  $Element->{$HTML_NS}->{img} = {
2068    attrs_checker => sub {    attrs_checker => sub {
2069      my ($self, $todo) = @_;      my ($self, $todo) = @_;
# Line 2184  $Element->{$HTML_NS}->{canvas} = { Line 2229  $Element->{$HTML_NS}->{canvas} = {
2229  };  };
2230    
2231  $Element->{$HTML_NS}->{map} = {  $Element->{$HTML_NS}->{map} = {
2232    attrs_checker => $GetHTMLAttrsChecker->({    attrs_checker => sub {
2233      id => sub {      my ($self, $todo) = @_;
2234        ## NOTE: same as global |id=""|, with |$self->{map}| registeration      my $has_id;
2235        my ($self, $attr) = @_;      $GetHTMLAttrsChecker->({
2236        my $value = $attr->value;        id => sub {
2237        if (length $value > 0) {          ## NOTE: same as global |id=""|, with |$self->{map}| registeration
2238          if ($self->{id}->{$value}) {          my ($self, $attr) = @_;
2239            $self->{onerror}->(node => $attr, type => 'duplicate ID');          my $value = $attr->value;
2240            push @{$self->{id}->{$value}}, $attr;          if (length $value > 0) {
2241              if ($self->{id}->{$value}) {
2242                $self->{onerror}->(node => $attr, type => 'duplicate ID');
2243                push @{$self->{id}->{$value}}, $attr;
2244              } else {
2245                $self->{id}->{$value} = [$attr];
2246              }
2247          } else {          } else {
2248            $self->{id}->{$value} = [$attr];            ## NOTE: MUST contain at least one character
2249              $self->{onerror}->(node => $attr, type => 'empty attribute value');
2250          }          }
2251        } else {          if ($value =~ /[\x09-\x0D\x20]/) {
2252          ## NOTE: MUST contain at least one character            $self->{onerror}->(node => $attr, type => 'space in ID');
2253          $self->{onerror}->(node => $attr, type => 'empty attribute value');          }
2254        }          $self->{map}->{$value} ||= $attr;
2255        if ($value =~ /[\x09-\x0D\x20]/) {          $has_id = 1;
2256          $self->{onerror}->(node => $attr, type => 'space in ID');        },
2257        }      })->($self, $todo);
2258        $self->{map}->{$value} ||= $attr;      $self->{onerror}->(node => $todo->{node}, type => 'attribute missing:id')
2259      },          unless $has_id;
2260    }),    },
2261    checker => $HTMLBlockChecker,    checker => $HTMLBlockChecker,
   ## TODO: |id| is required.  
2262  };  };
2263    
2264  $Element->{$HTML_NS}->{area} = {  $Element->{$HTML_NS}->{area} = {
# Line 2243  $Element->{$HTML_NS}->{area} = { Line 2294  $Element->{$HTML_NS}->{area} = {
2294                       target => $HTMLTargetAttrChecker,                       target => $HTMLTargetAttrChecker,
2295                       href => $HTMLURIAttrChecker,                       href => $HTMLURIAttrChecker,
2296                       ping => $HTMLSpaceURIsAttrChecker,                       ping => $HTMLSpaceURIsAttrChecker,
2297                       rel => sub { $HTMLLinkTypesAttrChecker->(1, @_) },                       rel => sub { $HTMLLinkTypesAttrChecker->(1, $todo, @_) },
2298                       media => $HTMLMQAttrChecker,                       media => $HTMLMQAttrChecker,
2299                       hreflang => $HTMLLanguageTagAttrChecker,                       hreflang => $HTMLLanguageTagAttrChecker,
2300                       type => $HTMLIMTAttrChecker,                       type => $HTMLIMTAttrChecker,
# Line 2266  $Element->{$HTML_NS}->{area} = { Line 2317  $Element->{$HTML_NS}->{area} = {
2317      }      }
2318    
2319      if (defined $attr{href}) {      if (defined $attr{href}) {
2320          $self->{has_hyperlink_element} = 1;
2321        unless (defined $attr{alt}) {        unless (defined $attr{alt}) {
2322          $self->{onerror}->(node => $todo->{node},          $self->{onerror}->(node => $todo->{node},
2323                             type => 'attribute missing:alt');                             type => 'attribute missing:alt');
Legend:
Removed from v.1.3  
changed lines
  Added in v.1.4
[email protected]
 ViewVC Help
Powered by ViewVC 1.1.24