/[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.32 by wakaba, Mon Jun 25 12:39:11 2007 UTC revision 1.33 by wakaba, Sat Jun 30 13:12:32 2007 UTC
# Line 18  my $AttrChecker = { Line 18  my $AttrChecker = {
18          #          #
19        } else {        } else {
20          ## NOTE: An XML "error"          ## NOTE: An XML "error"
21          $self->{onerror}->(node => $attr,          $self->{onerror}->(node => $attr, level => 'error',
22                             type => 'XML error:invalid xml:space value');                             type => 'invalid attribute value');
23        }        }
24      },      },
25      lang => sub {      lang => sub {
# Line 34  my $AttrChecker = { Line 34  my $AttrChecker = {
34        my $value = $attr->value;        my $value = $attr->value;
35        if ($value =~ /[^\x{0000}-\x{10FFFF}]/) { ## ISSUE: Should we disallow noncharacters?        if ($value =~ /[^\x{0000}-\x{10FFFF}]/) { ## ISSUE: Should we disallow noncharacters?
36          $self->{onerror}->(node => $attr,          $self->{onerror}->(node => $attr,
37                             type => 'syntax error');                             type => 'invalid attribute value');
38        }        }
39        ## NOTE: Conformance to URI standard is not checked since there is        ## NOTE: Conformance to URI standard is not checked since there is
40        ## no author requirement on conformance in the XML Base specification.        ## no author requirement on conformance in the XML Base specification.
# Line 47  my $AttrChecker = { Line 47  my $AttrChecker = {
47        $value =~ s/\x20$//;        $value =~ s/\x20$//;
48        ## TODO: NCName in XML 1.0 or 1.1        ## TODO: NCName in XML 1.0 or 1.1
49        ## TODO: declared type is ID?        ## TODO: declared type is ID?
50        if ($self->{id}->{$value}) {        if ($self->{id}->{$value}) { ## NOTE: An xml:id error
51          $self->{onerror}->(node => $attr, type => 'xml:id error:duplicate ID');          $self->{onerror}->(node => $attr, level => 'error',
52                               type => 'duplicate ID');
53        } else {        } else {
54          $self->{id}->{$value} = 1;          $self->{id}->{$value} = 1;
55        }        }
# Line 61  my $AttrChecker = { Line 62  my $AttrChecker = {
62        my $value = $attr->value;        my $value = $attr->value;
63        if ($value eq $XML_NS and $ln ne 'xml') {        if ($value eq $XML_NS and $ln ne 'xml') {
64          $self->{onerror}          $self->{onerror}
65            ->(node => $attr,            ->(node => $attr, level => 'NC',
66               type => 'NC:Reserved Prefixes and Namespace Names:=xml');               type => 'Reserved Prefixes and Namespace Names:=xml');
67        } elsif ($value eq $XMLNS_NS) {        } elsif ($value eq $XMLNS_NS) {
68          $self->{onerror}          $self->{onerror}
69            ->(node => $attr,            ->(node => $attr, level => 'NC',
70               type => 'NC:Reserved Prefixes and Namespace Names:=xmlns');               type => 'Reserved Prefixes and Namespace Names:=xmlns');
71        }        }
72        if ($ln eq 'xml' and $value ne $XML_NS) {        if ($ln eq 'xml' and $value ne $XML_NS) {
73          $self->{onerror}          $self->{onerror}
74            ->(node => $attr,            ->(node => $attr, level => 'NC',
75               type => 'NC:Reserved Prefixes and Namespace Names:xmlns:xml=');               type => 'Reserved Prefixes and Namespace Names:xmlns:xml=');
76        } elsif ($ln eq 'xmlns') {        } elsif ($ln eq 'xmlns') {
77          $self->{onerror}          $self->{onerror}
78            ->(node => $attr,            ->(node => $attr, level => 'NC',
79               type => 'NC:Reserved Prefixes and Namespace Names:xmlns:xmlns=');               type => 'Reserved Prefixes and Namespace Names:xmlns:xmlns=');
80        }        }
81        ## TODO: If XML 1.0 and empty        ## TODO: If XML 1.0 and empty
82      },      },
# Line 87  my $AttrChecker = { Line 88  my $AttrChecker = {
88        my $value = $attr->value;        my $value = $attr->value;
89        if ($value eq $XML_NS) {        if ($value eq $XML_NS) {
90          $self->{onerror}          $self->{onerror}
91            ->(node => $attr,            ->(node => $attr, level => 'NC',
92               type => 'NC:Reserved Prefixes and Namespace Names:=xml');               type => 'Reserved Prefixes and Namespace Names:=xml');
93        } elsif ($value eq $XMLNS_NS) {        } elsif ($value eq $XMLNS_NS) {
94          $self->{onerror}          $self->{onerror}
95            ->(node => $attr,            ->(node => $attr, level => 'NC',
96               type => 'NC:Reserved Prefixes and Namespace Names:=xmlns');               type => 'Reserved Prefixes and Namespace Names:=xmlns');
97        }        }
98      },      },
99    },    },
# Line 133  my $AnyChecker = sub { Line 134  my $AnyChecker = sub {
134  my $ElementDefault = {  my $ElementDefault = {
135    checker => sub {    checker => sub {
136      my ($self, $todo) = @_;      my ($self, $todo) = @_;
137      $self->{onerror}->(node => $todo->{node}, type => 'element not supported');      $self->{onerror}->(node => $todo->{node}, level => 'unsupported',
138                           type => 'element');
139      return $AnyChecker->($self, $todo);      return $AnyChecker->($self, $todo);
140    },    },
141    attrs_checker => sub {    attrs_checker => sub {
# Line 147  my $ElementDefault = { Line 149  my $ElementDefault = {
149        if ($checker) {        if ($checker) {
150          $checker->($self, $attr);          $checker->($self, $attr);
151        } else {        } else {
152          $self->{onerror}->(node => $attr, type => 'attribute not supported');          $self->{onerror}->(node => $attr, level => 'unsupported',
153                               type => 'attribute');
154        }        }
155      }      }
156    },    },
# Line 639  my $GetHTMLEnumeratedAttrChecker = sub { Line 642  my $GetHTMLEnumeratedAttrChecker = sub {
642      if ($states->{$value} > 0) {      if ($states->{$value} > 0) {
643        #        #
644      } elsif ($states->{$value}) {      } elsif ($states->{$value}) {
645        $self->{onerror}->(node => $attr,        $self->{onerror}->(node => $attr, type => 'enumerated:non-conforming');
                          type => 'non-conforming enumerated attribute value');  
646      } else {      } else {
647        $self->{onerror}->(node => $attr,        $self->{onerror}->(node => $attr, type => 'enumerated:invalid');
                          type => 'invalid enumerated attribute value');  
648      }      }
649    };    };
650  }; # $GetHTMLEnumeratedAttrChecker  }; # $GetHTMLEnumeratedAttrChecker
# Line 654  my $GetHTMLBooleanAttrChecker = sub { Line 655  my $GetHTMLBooleanAttrChecker = sub {
655      my ($self, $attr) = @_;      my ($self, $attr) = @_;
656      my $value = $attr->value;      my $value = $attr->value;
657      unless ($value eq $local_name or $value eq '') {      unless ($value eq $local_name or $value eq '') {
658        $self->{onerror}->(node => $attr,        $self->{onerror}->(node => $attr, type => 'boolean:invalid');
                          type => 'invalid boolean attribute value');  
659      }      }
660    };    };
661  }; # $GetHTMLBooleanAttrChecker  }; # $GetHTMLBooleanAttrChecker
# Line 701  my $HTMLLinkTypesAttrChecker = sub { Line 701  my $HTMLLinkTypesAttrChecker = sub {
701            #            #
702          } else {          } else {
703            $self->{onerror}->(node => $attr,            $self->{onerror}->(node => $attr,
704                               type => 'link type bad context:'.$word);                               type => 'link type:bad context:'.$word);
705          }          }
706        } elsif ($def->{status} eq 'proposal') {        } elsif ($def->{status} eq 'proposal') {
707          $self->{onerror}->(node => $attr,          $self->{onerror}->(node => $attr, level => 's',
708                             type => 'proposed link type:'.$word);                             type => 'link type:proposed:'.$word);
709        } else { # rejected or synonym        } else { # rejected or synonym
710          $self->{onerror}->(node => $attr,          $self->{onerror}->(node => $attr,
711                             type => 'non-conforming link type:'.$word);                             type => 'link type:non-conforming:'.$word);
712        }        }
713        if ($def->{unique}) {        if ($def->{unique}) {
714          unless ($self->{has_link_type}->{$word}) {          unless ($self->{has_link_type}->{$word}) {
715            $self->{has_link_type}->{$word} = 1;            $self->{has_link_type}->{$word} = 1;
716          } else {          } else {
717            $self->{onerror}->(node => $attr,            $self->{onerror}->(node => $attr,
718                               type => 'link with type not unique:'.$word);                               type => 'link type:duplicate:'.$word);
719          }          }
720        }        }
721      } else {      } else {
722        $self->{onerror}->(node => $attr,        $self->{onerror}->(node => $attr, level => 'unsupported',
723                           type => 'link type not supported:'.$word);                           type => 'link type:'.$word);
724      }      }
725    }    }
726    ## TODO: The Pingback 1.0 specification, which is referenced by HTML5,    ## TODO: The Pingback 1.0 specification, which is referenced by HTML5,
# Line 742  my $HTMLURIAttrChecker = sub { Line 742  my $HTMLURIAttrChecker = sub {
742    my $value = $attr->value;    my $value = $attr->value;
743    Whatpm::URIChecker->check_iri_reference ($value, sub {    Whatpm::URIChecker->check_iri_reference ($value, sub {
744      my %opt = @_;      my %opt = @_;
745      $self->{onerror}->(node => $attr,      $self->{onerror}->(node => $attr, level => $opt{level},
746                         type => 'URI:'.$opt{level}.':'.                         type => 'URI:'.
747                         (defined $opt{position} ? $opt{position} : '').':'.                         (defined $opt{position} ? $opt{position} : '').':'.
748                         $opt{type});                         $opt{type});
749    });    });
# Line 756  my $HTMLSpaceURIsAttrChecker = sub { Line 756  my $HTMLSpaceURIsAttrChecker = sub {
756    for my $value (split /[\x09-\x0D\x20]+/, $attr->value) {    for my $value (split /[\x09-\x0D\x20]+/, $attr->value) {
757      Whatpm::URIChecker->check_iri_reference ($value, sub {      Whatpm::URIChecker->check_iri_reference ($value, sub {
758        my %opt = @_;        my %opt = @_;
759        $self->{onerror}->(node => $attr,        $self->{onerror}->(node => $attr, level => $opt{level},
760                           type => 'URI['.$i.']:'.$opt{level}.':'.                           type => 'URIs:'.$i.':'.
761                           (defined $opt{position} ? $opt{position} : '').':'.                           (defined $opt{position} ? $opt{position} : '').':'.
762                           $opt{type});                           $opt{type});
763      });      });
# Line 797  my $HTMLDatetimeAttrChecker = sub { Line 797  my $HTMLDatetimeAttrChecker = sub {
797          if $zm > 59;          if $zm > 59;
798      ## ISSUE: Maybe timezone -00:00 should have same semantics as in RFC 3339.      ## ISSUE: Maybe timezone -00:00 should have same semantics as in RFC 3339.
799    } else {    } else {
800      $self->{onerror}->(node => $attr, type => 'datetime syntax error');      $self->{onerror}->(node => $attr, type => 'datetime:syntax error');
801    }    }
802  }; # $HTMLDatetimeAttrChecker  }; # $HTMLDatetimeAttrChecker
803    
# Line 805  my $HTMLIntegerAttrChecker = sub { Line 805  my $HTMLIntegerAttrChecker = sub {
805    my ($self, $attr) = @_;    my ($self, $attr) = @_;
806    my $value = $attr->value;    my $value = $attr->value;
807    unless ($value =~ /\A-?[0-9]+\z/) {    unless ($value =~ /\A-?[0-9]+\z/) {
808      $self->{onerror}->(node => $attr, type => 'integer syntax error');      $self->{onerror}->(node => $attr, type => 'integer:syntax error');
809    }    }
810  }; # $HTMLIntegerAttrChecker  }; # $HTMLIntegerAttrChecker
811    
# Line 816  my $GetHTMLNonNegativeIntegerAttrChecker Line 816  my $GetHTMLNonNegativeIntegerAttrChecker
816      my $value = $attr->value;      my $value = $attr->value;
817      if ($value =~ /\A[0-9]+\z/) {      if ($value =~ /\A[0-9]+\z/) {
818        unless ($range_check->($value + 0)) {        unless ($range_check->($value + 0)) {
819          $self->{onerror}->(node => $attr, type => 'out of range');          $self->{onerror}->(node => $attr, type => 'nninteger:out of range');
820        }        }
821      } else {      } else {
822        $self->{onerror}->(node => $attr,        $self->{onerror}->(node => $attr,
823                           type => 'non-negative integer syntax error');                           type => 'nninteger:syntax error');
824      }      }
825    };    };
826  }; # $GetHTMLNonNegativeIntegerAttrChecker  }; # $GetHTMLNonNegativeIntegerAttrChecker
# Line 832  my $GetHTMLFloatingPointNumberAttrChecke Line 832  my $GetHTMLFloatingPointNumberAttrChecke
832      my $value = $attr->value;      my $value = $attr->value;
833      if ($value =~ /\A-?[0-9.]+\z/ and $value =~ /[0-9]/) {      if ($value =~ /\A-?[0-9.]+\z/ and $value =~ /[0-9]/) {
834        unless ($range_check->($value + 0)) {        unless ($range_check->($value + 0)) {
835          $self->{onerror}->(node => $attr, type => 'out of range');          $self->{onerror}->(node => $attr, type => 'float:out of range');
836        }        }
837      } else {      } else {
838        $self->{onerror}->(node => $attr,        $self->{onerror}->(node => $attr,
839                           type => 'floating point number syntax error');                           type => 'float:syntax error');
840      }      }
841    };    };
842  }; # $GetHTMLFloatingPointNumberAttrChecker  }; # $GetHTMLFloatingPointNumberAttrChecker
# Line 870  my $HTMLIMTAttrChecker = sub { Line 870  my $HTMLIMTAttrChecker = sub {
870      require Whatpm::IMTChecker;      require Whatpm::IMTChecker;
871      Whatpm::IMTChecker->check_imt (sub {      Whatpm::IMTChecker->check_imt (sub {
872        my %opt = @_;        my %opt = @_;
873        $self->{onerror}->(node => $attr,        $self->{onerror}->(node => $attr, level => $opt{level},
874                           type => 'IMT:'.$opt{level}.':'.$opt{type});                           type => 'IMT:'.$opt{type});
875      }, @type);      }, @type);
876    } else {    } else {
877      $self->{onerror}->(node => $attr, type => 'IMT syntax error');      $self->{onerror}->(node => $attr, type => 'IMT:syntax error');
878    }    }
879  }; # $HTMLIMTAttrChecker  }; # $HTMLIMTAttrChecker
880    
881  my $HTMLLanguageTagAttrChecker = sub {  my $HTMLLanguageTagAttrChecker = sub {
882    my ($self, $attr) = @_;    my ($self, $attr) = @_;
883    if ($attr->value eq '') {    if ($attr->value eq '') {
884      $self->{onerror}->(node => $attr, type => 'language tag syntax error');      $self->{onerror}->(node => $attr, type => 'language tag:syntax error');
885    }    }
886    ## TODO: RFC 3066 test    ## TODO: RFC 3066 test
887    ## ISSUE: RFC 4646 (3066bis)?    ## ISSUE: RFC 4646 (3066bis)?
# Line 908  my $HTMLUsemapAttrChecker = sub { Line 908  my $HTMLUsemapAttrChecker = sub {
908      ## ISSUE: Is |usemap="#"| conformant? (c.f. |id=""| is non-conformant.)      ## ISSUE: Is |usemap="#"| conformant? (c.f. |id=""| is non-conformant.)
909      push @{$self->{usemap}}, [$value => $attr];      push @{$self->{usemap}}, [$value => $attr];
910    } else {    } else {
911      $self->{onerror}->(node => $attr, type => 'hashed idref syntax error');      $self->{onerror}->(node => $attr, type => '#idref:syntax error');
912    }    }
913    ## NOTE: Space characters in hashed ID references are conforming.    ## NOTE: Space characters in hashed ID references are conforming.
914    ## ISSUE: UA algorithm for matching is case-insensitive; IDs only different in cases should be reported    ## ISSUE: UA algorithm for matching is case-insensitive; IDs only different in cases should be reported
# Line 946  my $HTMLAttrChecker = { Line 946  my $HTMLAttrChecker = {
946        }        }
947      } else {      } else {
948        ## NOTE: MUST contain at least one character        ## NOTE: MUST contain at least one character
949        $self->{onerror}->(node => $attr, type => 'attribute value is empty');        $self->{onerror}->(node => $attr, type => 'empty attribute value');
950      }      }
951    },    },
952    title => sub {}, ## NOTE: No conformance creteria    title => sub {}, ## NOTE: No conformance creteria
# Line 999  my $GetHTMLAttrsChecker = sub { Line 999  my $GetHTMLAttrsChecker = sub {
999        if ($checker) {        if ($checker) {
1000          $checker->($self, $attr, $todo);          $checker->($self, $attr, $todo);
1001        } else {        } else {
1002          $self->{onerror}->(node => $attr, type => 'attribute not supported');          $self->{onerror}->(node => $attr, level => 'unsupported',
1003                               type => 'attribute');
1004          ## ISSUE: No comformance createria for unknown attributes in the spec          ## ISSUE: No comformance createria for unknown attributes in the spec
1005        }        }
1006      }      }
# Line 1018  $Element->{$HTML_NS}->{html} = { Line 1019  $Element->{$HTML_NS}->{html} = {
1019        my ($self, $attr) = @_;        my ($self, $attr) = @_;
1020        my $value = $attr->value;        my $value = $attr->value;
1021        unless ($value eq $HTML_NS) {        unless ($value eq $HTML_NS) {
1022          $self->{onerror}->(node => $attr, type => 'syntax error');          $self->{onerror}->(node => $attr, type => 'invalid attribute value');
1023          ## TODO: only in HTML documents          ## TODO: only in HTML documents
1024        }        }
1025      },      },
# Line 1234  $Element->{$HTML_NS}->{meta} = { Line 1235  $Element->{$HTML_NS}->{meta} = {
1235        if ($checker) {        if ($checker) {
1236          $checker->($self, $attr) if ref $checker;          $checker->($self, $attr) if ref $checker;
1237        } else {        } else {
1238          $self->{onerror}->(node => $attr, type => 'attribute not supported');          $self->{onerror}->(node => $attr, level => 'unsupported',
1239                               type => 'attribute');
1240          ## ISSUE: No comformance createria for unknown attributes in the spec          ## ISSUE: No comformance createria for unknown attributes in the spec
1241        }        }
1242      }      }
# Line 1295  $Element->{$HTML_NS}->{meta} = { Line 1297  $Element->{$HTML_NS}->{meta} = {
1297          #          #
1298        } else {        } else {
1299          $self->{onerror}->(node => $http_equiv_attr,          $self->{onerror}->(node => $http_equiv_attr,
1300                             type => 'invalid enumerated attribute value');                             type => 'enumerated:invalid');
1301        }        }
1302      }      }
1303    
# Line 1639  $Element->{$HTML_NS}->{li} = { Line 1641  $Element->{$HTML_NS}->{li} = {
1641          $parent_ns = '' unless defined $parent_ns;          $parent_ns = '' unless defined $parent_ns;
1642          my $parent_ln = $parent->manakai_local_name;          my $parent_ln = $parent->manakai_local_name;
1643          unless ($parent_ns eq $HTML_NS and $parent_ln eq 'ol') {          unless ($parent_ns eq $HTML_NS and $parent_ln eq 'ol') {
1644            $self->{onerror}->(node => $attr, type => 'attribute not supported');            $self->{onerror}->(node => $attr, level => 'unsupported',
1645                                 type => 'attribute');
1646          }          }
1647        }        }
1648        $HTMLIntegerAttrChecker->($self, $attr);        $HTMLIntegerAttrChecker->($self, $attr);
# Line 1765  $Element->{$HTML_NS}->{a} = { Line 1768  $Element->{$HTML_NS}->{a} = {
1768        if ($checker) {        if ($checker) {
1769          $checker->($self, $attr) if ref $checker;          $checker->($self, $attr) if ref $checker;
1770        } else {        } else {
1771          $self->{onerror}->(node => $attr, type => 'attribute not supported');          $self->{onerror}->(node => $attr, level => 'unsupported',
1772                               type => 'attribute');
1773          ## ISSUE: No comformance createria for unknown attributes in the spec          ## ISSUE: No comformance createria for unknown attributes in the spec
1774        }        }
1775      }      }
# Line 2070  $Element->{$HTML_NS}->{embed} = { Line 2074  $Element->{$HTML_NS}->{embed} = {
2074        if ($checker) {        if ($checker) {
2075          $checker->($self, $attr);          $checker->($self, $attr);
2076        } else {        } else {
2077          $self->{onerror}->(node => $attr, type => 'attribute not supported');          $self->{onerror}->(node => $attr, level => 'unsupported',
2078                               type => 'attribute');
2079          ## ISSUE: No comformance createria for global attributes in the spec          ## ISSUE: No comformance createria for global attributes in the spec
2080        }        }
2081      }      }
# Line 2186  $Element->{$HTML_NS}->{map} = { Line 2191  $Element->{$HTML_NS}->{map} = {
2191          }          }
2192        } else {        } else {
2193          ## NOTE: MUST contain at least one character          ## NOTE: MUST contain at least one character
2194          $self->{onerror}->(node => $attr, type => 'attribute value is empty');          $self->{onerror}->(node => $attr, type => 'empty attribute value');
2195        }        }
2196        if ($value =~ /[\x09-\x0D\x20]/) {        if ($value =~ /[\x09-\x0D\x20]/) {
2197          $self->{onerror}->(node => $attr, type => 'space in ID');          $self->{onerror}->(node => $attr, type => 'space in ID');
# Line 2224  $Element->{$HTML_NS}->{area} = { Line 2229  $Element->{$HTML_NS}->{area} = {
2229                           $coords = [split /,/, $value];                           $coords = [split /,/, $value];
2230                         } else {                         } else {
2231                           $self->{onerror}->(node => $attr,                           $self->{onerror}->(node => $attr,
2232                                              type => 'syntax error');                                              type => 'coords:syntax error');
2233                         }                         }
2234                       },                       },
2235                       target => $HTMLTargetAttrChecker,                       target => $HTMLTargetAttrChecker,
# Line 2246  $Element->{$HTML_NS}->{area} = { Line 2251  $Element->{$HTML_NS}->{area} = {
2251        if ($checker) {        if ($checker) {
2252          $checker->($self, $attr) if ref $checker;          $checker->($self, $attr) if ref $checker;
2253        } else {        } else {
2254          $self->{onerror}->(node => $attr, type => 'attribute not supported');          $self->{onerror}->(node => $attr, level => 'unsupported',
2255                               type => 'attribute');
2256          ## ISSUE: No comformance createria for unknown attributes in the spec          ## ISSUE: No comformance createria for unknown attributes in the spec
2257        }        }
2258      }      }
# Line 2282  $Element->{$HTML_NS}->{area} = { Line 2288  $Element->{$HTML_NS}->{area} = {
2288            if (@$coords == 3) {            if (@$coords == 3) {
2289              if ($coords->[2] < 0) {              if ($coords->[2] < 0) {
2290                $self->{onerror}->(node => $attr{coords},                $self->{onerror}->(node => $attr{coords},
2291                                   type => 'out of range:2');                                   type => 'coords:out of range:2');
2292              }              }
2293            } else {            } else {
2294              $self->{onerror}->(node => $attr{coords},              $self->{onerror}->(node => $attr{coords},
2295                                 type => 'list item number:3:'.@$coords);                                 type => 'coords:number:3:'.@$coords);
2296            }            }
2297          } else {          } else {
2298            ## NOTE: A syntax error has been reported.            ## NOTE: A syntax error has been reported.
# Line 2306  $Element->{$HTML_NS}->{area} = { Line 2312  $Element->{$HTML_NS}->{area} = {
2312            if (@$coords >= 6) {            if (@$coords >= 6) {
2313              unless (@$coords % 2 == 0) {              unless (@$coords % 2 == 0) {
2314                $self->{onerror}->(node => $attr{coords},                $self->{onerror}->(node => $attr{coords},
2315                                   type => 'list item number:even:'.@$coords);                                   type => 'coords:number:even:'.@$coords);
2316              }              }
2317            } else {            } else {
2318              $self->{onerror}->(node => $attr{coords},              $self->{onerror}->(node => $attr{coords},
2319                                 type => 'list item number:>=6:'.@$coords);                                 type => 'coords:number:>=6:'.@$coords);
2320            }            }
2321          } else {          } else {
2322            ## NOTE: A syntax error has been reported.            ## NOTE: A syntax error has been reported.
# Line 2325  $Element->{$HTML_NS}->{area} = { Line 2331  $Element->{$HTML_NS}->{area} = {
2331            if (@$coords == 4) {            if (@$coords == 4) {
2332              unless ($coords->[0] < $coords->[2]) {              unless ($coords->[0] < $coords->[2]) {
2333                $self->{onerror}->(node => $attr{coords},                $self->{onerror}->(node => $attr{coords},
2334                                   type => 'out of range:0');                                   type => 'coords:out of range:0');
2335              }              }
2336              unless ($coords->[1] < $coords->[3]) {              unless ($coords->[1] < $coords->[3]) {
2337                $self->{onerror}->(node => $attr{coords},                $self->{onerror}->(node => $attr{coords},
2338                                   type => 'out of range:1');                                   type => 'coords:out of range:1');
2339              }              }
2340            } else {            } else {
2341              $self->{onerror}->(node => $attr{coords},              $self->{onerror}->(node => $attr{coords},
2342                                 type => 'list item number:4:'.@$coords);                                 type => 'coords:number:4:'.@$coords);
2343            }            }
2344          } else {          } else {
2345            ## NOTE: A syntax error has been reported.            ## NOTE: A syntax error has been reported.
# Line 2452  $Element->{$HTML_NS}->{table} = { Line 2458  $Element->{$HTML_NS}->{table} = {
2458        my %opt = @_;        my %opt = @_;
2459        $self->{onerror}->(type => 'table:'.$opt{type}, node => $opt{node});        $self->{onerror}->(type => 'table:'.$opt{type}, node => $opt{node});
2460      });      });
2461        push @{$self->{return}->{table}}, $todo->{node};
2462    
2463      return ($new_todos);      return ($new_todos);
2464    },    },
# Line 2786  $Element->{$HTML_NS}->{menu} = { Line 2793  $Element->{$HTML_NS}->{menu} = {
2793          }          }
2794        } else {        } else {
2795          ## NOTE: MUST contain at least one character          ## NOTE: MUST contain at least one character
2796          $self->{onerror}->(node => $attr, type => 'attribute value is empty');          $self->{onerror}->(node => $attr, type => 'empty attribute value');
2797        }        }
2798        if ($value =~ /[\x09-\x0D\x20]/) {        if ($value =~ /[\x09-\x0D\x20]/) {
2799          $self->{onerror}->(node => $attr, type => 'space in ID');          $self->{onerror}->(node => $attr, type => 'space in ID');
# Line 2916  sub check_document ($$$) { Line 2923  sub check_document ($$$) {
2923    ## TODO: Check for other items other than document element    ## TODO: Check for other items other than document element
2924    ## (second (errorous) element, text nodes, PI nodes, doctype nodes)    ## (second (errorous) element, text nodes, PI nodes, doctype nodes)
2925    
2926    $self->check_element ($docel, $onerror);    return $self->check_element ($docel, $onerror);
2927  } # check_document  } # check_document
2928    
2929  sub check_element ($$$) {  sub check_element ($$$) {
# Line 2932  sub check_element ($$$) { Line 2939  sub check_element ($$$) {
2939    $self->{map} = {};    $self->{map} = {};
2940    $self->{menu} = {};    $self->{menu} = {};
2941    $self->{has_link_type} = {};    $self->{has_link_type} = {};
2942      $self->{return} = {
2943        table => [],
2944      };
2945    
2946    my @todo = ({type => 'element', node => $el});    my @todo = ({type => 'element', node => $el});
2947    while (@todo) {    while (@todo) {
# Line 2940  sub check_element ($$$) { Line 2950  sub check_element ($$$) {
2950        my $prefix = $todo->{node}->prefix;        my $prefix = $todo->{node}->prefix;
2951        if (defined $prefix and $prefix eq 'xmlns') {        if (defined $prefix and $prefix eq 'xmlns') {
2952          $self->{onerror}          $self->{onerror}
2953            ->(node => $todo->{node},            ->(node => $todo->{node}, level => 'NC',
2954               type => 'NC:Reserved Prefixes and Namespace Names:<xmlns:>');               type => 'Reserved Prefixes and Namespace Names:<xmlns:>');
2955        }        }
2956        my $nsuri = $todo->{node}->namespace_uri;        my $nsuri = $todo->{node}->namespace_uri;
2957        $nsuri = '' unless defined $nsuri;        $nsuri = '' unless defined $nsuri;
# Line 2956  sub check_element ($$$) { Line 2966  sub check_element ($$$) {
2966        my $prefix = $todo->{node}->prefix;        my $prefix = $todo->{node}->prefix;
2967        if (defined $prefix and $prefix eq 'xmlns') {        if (defined $prefix and $prefix eq 'xmlns') {
2968          $self->{onerror}          $self->{onerror}
2969            ->(node => $todo->{node},            ->(node => $todo->{node}, level => 'NC',
2970               type => 'NC:Reserved Prefixes and Namespace Names:<xmlns:>');               type => 'Reserved Prefixes and Namespace Names:<xmlns:>');
2971        }        }
2972        my $nsuri = $todo->{node}->namespace_uri;        my $nsuri = $todo->{node}->namespace_uri;
2973        $nsuri = '' unless defined $nsuri;        $nsuri = '' unless defined $nsuri;
# Line 2992  sub check_element ($$$) { Line 3002  sub check_element ($$$) {
3002    delete $self->{id};    delete $self->{id};
3003    delete $self->{usemap};    delete $self->{usemap};
3004    delete $self->{map};    delete $self->{map};
3005      return $self->{return};
3006  } # check_element  } # check_element
3007    
3008  sub _add_minuses ($@) {  sub _add_minuses ($@) {
Legend:
Removed from v.1.32  
changed lines
  Added in v.1.33
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24