/[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.29 by wakaba, Sun Jun 24 05:12:11 2007 UTC revision 1.30 by wakaba, Sun Jun 24 14:24:21 2007 UTC
# Line 232  my $HTMLEmptyChecker = sub { Line 232  my $HTMLEmptyChecker = sub {
232      if ($nt == 1) {      if ($nt == 1) {
233        ## NOTE: |minuses| list is not checked since redundant        ## NOTE: |minuses| list is not checked since redundant
234        $self->{onerror}->(node => $node, type => 'element not allowed');        $self->{onerror}->(node => $node, type => 'element not allowed');
235        my ($sib, $ch) = $self->_check_get_children ($node);        my ($sib, $ch) = $self->_check_get_children ($node, $todo);
236        unshift @nodes, @$sib;        unshift @nodes, @$sib;
237        push @$new_todos, @$ch;        push @$new_todos, @$ch;
238      } elsif ($nt == 3 or $nt == 4) {      } elsif ($nt == 3 or $nt == 4) {
# Line 261  my $HTMLTextChecker = sub { Line 261  my $HTMLTextChecker = sub {
261      if ($nt == 1) {      if ($nt == 1) {
262        ## NOTE: |minuses| list is not checked since redundant        ## NOTE: |minuses| list is not checked since redundant
263        $self->{onerror}->(node => $node, type => 'element not allowed');        $self->{onerror}->(node => $node, type => 'element not allowed');
264        my ($sib, $ch) = $self->_check_get_children ($node);        my ($sib, $ch) = $self->_check_get_children ($node, $todo);
265        unshift @nodes, @$sib;        unshift @nodes, @$sib;
266        push @$new_todos, @$ch;        push @$new_todos, @$ch;
267      } elsif ($nt == 5) {      } elsif ($nt == 5) {
# Line 301  my $HTMLStylableBlockChecker = sub { Line 301  my $HTMLStylableBlockChecker = sub {
301        }        }
302        $self->{onerror}->(node => $node, type => 'element not allowed')        $self->{onerror}->(node => $node, type => 'element not allowed')
303          if $not_allowed;          if $not_allowed;
304        my ($sib, $ch) = $self->_check_get_children ($node);        my ($sib, $ch) = $self->_check_get_children ($node, $todo);
305        unshift @nodes, @$sib;        unshift @nodes, @$sib;
306        push @$new_todos, @$ch;        push @$new_todos, @$ch;
307      } elsif ($nt == 3 or $nt == 4) {      } elsif ($nt == 3 or $nt == 4) {
# Line 336  my $HTMLBlockChecker = sub { Line 336  my $HTMLBlockChecker = sub {
336          unless $HTMLBlockLevelElements->{$node_ns}->{$node_ln};          unless $HTMLBlockLevelElements->{$node_ns}->{$node_ln};
337        $self->{onerror}->(node => $node, type => 'element not allowed')        $self->{onerror}->(node => $node, type => 'element not allowed')
338          if $not_allowed;          if $not_allowed;
339        my ($sib, $ch) = $self->_check_get_children ($node);        my ($sib, $ch) = $self->_check_get_children ($node, $todo);
340        unshift @nodes, @$sib;        unshift @nodes, @$sib;
341        push @$new_todos, @$ch;        push @$new_todos, @$ch;
342      } elsif ($nt == 3 or $nt == 4) {      } elsif ($nt == 3 or $nt == 4) {
# Line 372  my $HTMLInlineChecker = sub { Line 372  my $HTMLInlineChecker = sub {
372            $HTMLStructuredInlineLevelElements->{$node_ns}->{$node_ln};            $HTMLStructuredInlineLevelElements->{$node_ns}->{$node_ln};
373        $self->{onerror}->(node => $node, type => 'element not allowed')        $self->{onerror}->(node => $node, type => 'element not allowed')
374          if $not_allowed;          if $not_allowed;
375        my ($sib, $ch) = $self->_check_get_children ($node);        my ($sib, $ch) = $self->_check_get_children ($node, $todo);
376        unshift @nodes, @$sib;        unshift @nodes, @$sib;
377        push @$new_todos, @$ch;        push @$new_todos, @$ch;
378      } elsif ($nt == 5) {      } elsif ($nt == 5) {
# Line 410  my $HTMLStrictlyInlineChecker = sub { Line 410  my $HTMLStrictlyInlineChecker = sub {
410          unless $HTMLStrictlyInlineLevelElements->{$node_ns}->{$node_ln};          unless $HTMLStrictlyInlineLevelElements->{$node_ns}->{$node_ln};
411        $self->{onerror}->(node => $node, type => 'element not allowed')        $self->{onerror}->(node => $node, type => 'element not allowed')
412          if $not_allowed;          if $not_allowed;
413        my ($sib, $ch) = $self->_check_get_children ($node);        my ($sib, $ch) = $self->_check_get_children ($node, $todo);
414        unshift @nodes, @$sib;        unshift @nodes, @$sib;
415        push @$new_todos, @$ch;        push @$new_todos, @$ch;
416      } elsif ($nt == 5) {      } elsif ($nt == 5) {
# Line 455  my $HTMLInlineOrStrictlyInlineChecker = Line 455  my $HTMLInlineOrStrictlyInlineChecker =
455        }        }
456        $self->{onerror}->(node => $node, type => 'element not allowed')        $self->{onerror}->(node => $node, type => 'element not allowed')
457          if $not_allowed;          if $not_allowed;
458        my ($sib, $ch) = $self->_check_get_children ($node);        my ($sib, $ch) = $self->_check_get_children ($node, $todo);
459        unshift @nodes, @$sib;        unshift @nodes, @$sib;
460        push @$new_todos, @$ch;        push @$new_todos, @$ch;
461      } elsif ($nt == 5) {      } elsif ($nt == 5) {
# Line 517  my $HTMLBlockOrInlineChecker = sub { Line 517  my $HTMLBlockOrInlineChecker = sub {
517        }        }
518        $self->{onerror}->(node => $node, type => 'element not allowed')        $self->{onerror}->(node => $node, type => 'element not allowed')
519          if $not_allowed;          if $not_allowed;
520        my ($sib, $ch) = $self->_check_get_children ($node);        my ($sib, $ch) = $self->_check_get_children ($node, $todo);
521        unshift @nodes, @$sib;        unshift @nodes, @$sib;
522        push @$new_todos, @$ch;        push @$new_todos, @$ch;
523      } elsif ($nt == 3 or $nt == 4) {      } elsif ($nt == 3 or $nt == 4) {
# Line 600  my $GetHTMLZeroOrMoreThenBlockOrInlineCh Line 600  my $GetHTMLZeroOrMoreThenBlockOrInlineCh
600          }          }
601          $self->{onerror}->(node => $node, type => 'element not allowed')          $self->{onerror}->(node => $node, type => 'element not allowed')
602            if $not_allowed;            if $not_allowed;
603          my ($sib, $ch) = $self->_check_get_children ($node);          my ($sib, $ch) = $self->_check_get_children ($node, $todo);
604          unshift @nodes, @$sib;          unshift @nodes, @$sib;
605          push @$new_todos, @$ch;          push @$new_todos, @$ch;
606        } elsif ($nt == 3 or $nt == 4) {        } elsif ($nt == 3 or $nt == 4) {
# Line 752  my $HTMLURIAttrChecker = sub { Line 752  my $HTMLURIAttrChecker = sub {
752  ## A space separated list of one or more URIs (or IRIs)  ## A space separated list of one or more URIs (or IRIs)
753  my $HTMLSpaceURIsAttrChecker = sub {  my $HTMLSpaceURIsAttrChecker = sub {
754    my ($self, $attr) = @_;    my ($self, $attr) = @_;
755    ## TODO: URI or IRI check    my $i = 0;
756      for my $value (split /[\x09-\x0D\x20]+/, $attr->value) {
757        Whatpm::URIChecker->check_iri_reference ($value, sub {
758          my %opt = @_;
759          $self->{onerror}->(node => $attr,
760                             type => 'URI['.$i.']:'.$opt{level}.':'.
761                             (defined $opt{position} ? $opt{position} : '').':'.
762                             $opt{type});
763        });
764        $i++;
765      }
766    ## ISSUE: Relative references?    ## ISSUE: Relative references?
767    ## ISSUE: Leading or trailing white spaces are conformant?    ## ISSUE: Leading or trailing white spaces are conformant?
768    ## ISSUE: A sequence of white space characters are conformant?    ## ISSUE: A sequence of white space characters are conformant?
# Line 760  my $HTMLSpaceURIsAttrChecker = sub { Line 770  my $HTMLSpaceURIsAttrChecker = sub {
770    ## NOTE: Duplication seems not an error.    ## NOTE: Duplication seems not an error.
771  }; # $HTMLSpaceURIsAttrChecker  }; # $HTMLSpaceURIsAttrChecker
772    
773    my $HTMLDatetimeAttrChecker = sub {
774      my ($self, $attr) = @_;
775      my $value = $attr->value;
776      ## ISSUE: "space", not "space character" (in parsing algorihtm, "space character")
777      if ($value =~ /\A([0-9]{4})-([0-9]{2})-([0-9]{2})(?>[\x09-\x0D\x20]+(?>T[\x09-\x0D\x20]*)?|T[\x09-\x0D\x20]*)([0-9]{2}):([0-9]{2})(?>:([0-9]{2}))?(?>\.([0-9]+))?[\x09-\x0D\x20]*(?>Z|[+-]([0-9]{2}):([0-9]{2}))\z/) {
778        my ($y, $M, $d, $h, $m, $s, $f, $zh, $zm)
779            = ($1, $2, $3, $4, $5, $6, $7, $8, $9);
780        if (0 < $M and $M < 13) { ## ISSUE: This is not explicitly specified (though in parsing algorithm)
781          $self->{onerror}->(node => $attr, type => 'datetime:bad day')
782              if $d < 1 or
783                  $d > [0, 31, 29, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31]->[$M];
784          $self->{onerror}->(node => $attr, type => 'datetime:bad day')
785              if $M == 2 and $d == 29 and
786                  not ($y % 400 == 0 or ($y % 4 == 0 and $y % 100 != 0));
787        } else {
788          $self->{onerror}->(node => $attr, type => 'datetime:bad month');
789        }
790        $self->{onerror}->(node => $attr, type => 'datetime:bad hour') if $h > 23;
791        $self->{onerror}->(node => $attr, type => 'datetime:bad minute') if $m > 59;
792        $self->{onerror}->(node => $attr, type => 'datetime:bad second')
793            if defined $s and $s > 59;
794        $self->{onerror}->(node => $attr, type => 'datetime:bad timezone hour')
795            if $zh > 23;
796        $self->{onerror}->(node => $attr, type => 'datetime:bad timezone minute')
797            if $zm > 59;
798        ## ISSUE: Maybe timezone -00:00 should have same semantics as in RFC 3339.
799      } else {
800        $self->{onerror}->(node => $attr, type => 'datetime syntax error');
801      }
802    }; # $HTMLDatetimeAttrChecker
803    
804  my $HTMLIntegerAttrChecker = sub {  my $HTMLIntegerAttrChecker = sub {
805    my ($self, $attr) = @_;    my ($self, $attr) = @_;
806    my $value = $attr->value;    my $value = $attr->value;
# Line 917  my $HTMLAttrChecker = { Line 958  my $HTMLAttrChecker = {
958    dir => $GetHTMLEnumeratedAttrChecker->({ltr => 1, rtl => 1}),    dir => $GetHTMLEnumeratedAttrChecker->({ltr => 1, rtl => 1}),
959    class => $HTMLUnorderedSetOfSpaceSeparatedTokensAttrChecker,    class => $HTMLUnorderedSetOfSpaceSeparatedTokensAttrChecker,
960    irrelevant => $GetHTMLBooleanAttrChecker->('irrelevant'),    irrelevant => $GetHTMLBooleanAttrChecker->('irrelevant'),
961    ## TODO: tabindex    tabindex => $HTMLIntegerAttrChecker,
962  };  };
963    
964  for (qw/  for (qw/
# Line 1013  $Element->{$HTML_NS}->{html} = { Line 1054  $Element->{$HTML_NS}->{html} = {
1054          }          }
1055          $self->{onerror}->(node => $node, type => 'element not allowed')          $self->{onerror}->(node => $node, type => 'element not allowed')
1056            if $not_allowed;            if $not_allowed;
1057          my ($sib, $ch) = $self->_check_get_children ($node);          my ($sib, $ch) = $self->_check_get_children ($node, $todo);
1058          unshift @nodes, @$sib;          unshift @nodes, @$sib;
1059          push @$new_todos, @$ch;          push @$new_todos, @$ch;
1060        } elsif ($nt == 3 or $nt == 4) {        } elsif ($nt == 3 or $nt == 4) {
# Line 1092  $Element->{$HTML_NS}->{head} = { Line 1133  $Element->{$HTML_NS}->{head} = {
1133          }          }
1134          $self->{onerror}->(node => $node, type => 'element not allowed')          $self->{onerror}->(node => $node, type => 'element not allowed')
1135            if $not_allowed;            if $not_allowed;
1136          my ($sib, $ch) = $self->_check_get_children ($node);          my ($sib, $ch) = $self->_check_get_children ($node, $todo);
1137          unshift @nodes, @$sib;          unshift @nodes, @$sib;
1138          push @$new_todos, @$ch;          push @$new_todos, @$ch;
1139        } elsif ($nt == 3 or $nt == 4) {        } elsif ($nt == 3 or $nt == 4) {
# Line 1300  $Element->{$HTML_NS}->{aside} = { Line 1341  $Element->{$HTML_NS}->{aside} = {
1341    
1342  $Element->{$HTML_NS}->{h1} = {  $Element->{$HTML_NS}->{h1} = {
1343    attrs_checker => $GetHTMLAttrsChecker->({}),    attrs_checker => $GetHTMLAttrsChecker->({}),
1344    checker => $HTMLSignificantStrictlyInlineChecker,    checker => sub {
1345        my ($self, $todo) = @_;
1346        $todo->{flag}->{has_heading}->[0] = 1;
1347        return $HTMLSignificantStrictlyInlineChecker->($self, $todo);
1348      },
1349  };  };
1350    
1351  $Element->{$HTML_NS}->{h2} = {  $Element->{$HTML_NS}->{h2} = {
1352    attrs_checker => $GetHTMLAttrsChecker->({}),    attrs_checker => $GetHTMLAttrsChecker->({}),
1353    checker => $HTMLSignificantStrictlyInlineChecker,    checker => $Element->{$HTML_NS}->{h1}->{checker},
1354  };  };
1355    
1356  $Element->{$HTML_NS}->{h3} = {  $Element->{$HTML_NS}->{h3} = {
1357    attrs_checker => $GetHTMLAttrsChecker->({}),    attrs_checker => $GetHTMLAttrsChecker->({}),
1358    checker => $HTMLSignificantStrictlyInlineChecker,    checker => $Element->{$HTML_NS}->{h1}->{checker},
1359  };  };
1360    
1361  $Element->{$HTML_NS}->{h4} = {  $Element->{$HTML_NS}->{h4} = {
1362    attrs_checker => $GetHTMLAttrsChecker->({}),    attrs_checker => $GetHTMLAttrsChecker->({}),
1363    checker => $HTMLSignificantStrictlyInlineChecker,    checker => $Element->{$HTML_NS}->{h1}->{checker},
1364  };  };
1365    
1366  $Element->{$HTML_NS}->{h5} = {  $Element->{$HTML_NS}->{h5} = {
1367    attrs_checker => $GetHTMLAttrsChecker->({}),    attrs_checker => $GetHTMLAttrsChecker->({}),
1368    checker => $HTMLSignificantStrictlyInlineChecker,    checker => $Element->{$HTML_NS}->{h1}->{checker},
1369  };  };
1370    
1371  $Element->{$HTML_NS}->{h6} = {  $Element->{$HTML_NS}->{h6} = {
1372    attrs_checker => $GetHTMLAttrsChecker->({}),    attrs_checker => $GetHTMLAttrsChecker->({}),
1373    checker => $HTMLSignificantStrictlyInlineChecker,    checker => $Element->{$HTML_NS}->{h1}->{checker},
1374  };  };
1375    
1376  ## TODO: header  $Element->{$HTML_NS}->{header} = {
1377      attrs_checker => $GetHTMLAttrsChecker->({}),
1378      checker => sub {
1379        my ($self, $todo) = @_;
1380        my $old_flag = $todo->{flag}->{has_heading} || [];
1381        my $new_flag = [];
1382        local $todo->{flag}->{has_heading} = $new_flag;
1383        my $node = $todo->{node};
1384    
1385        my $end = $self->_add_minuses
1386            ({$HTML_NS => {qw/header 1 footer 1/}},
1387             $HTMLSectioningElements);
1388        my ($new_todos, $ch) = $HTMLBlockChecker->($self, $todo);
1389        push @$new_todos, $end,
1390            {type => 'code', code => sub {
1391               if ($new_flag->[0]) {
1392                 $old_flag->[0] = 1;
1393               } else {
1394                 $self->{onerror}->(node => $node, type => 'element missing:hn');
1395               }
1396             }};
1397        return ($new_todos, $ch);
1398      },
1399    };
1400    
1401  $Element->{$HTML_NS}->{footer} = {  $Element->{$HTML_NS}->{footer} = {
1402    attrs_checker => $GetHTMLAttrsChecker->({}),    attrs_checker => $GetHTMLAttrsChecker->({}),
# Line 1385  $Element->{$HTML_NS}->{footer} = { Line 1453  $Element->{$HTML_NS}->{footer} = {
1453          }          }
1454          $self->{onerror}->(node => $node, type => 'element not allowed')          $self->{onerror}->(node => $node, type => 'element not allowed')
1455            if $not_allowed;            if $not_allowed;
1456          my ($sib, $ch) = $self->_check_get_children ($node);          my ($sib, $ch) = $self->_check_get_children ($node, $todo);
1457          unshift @nodes, @$sib;          unshift @nodes, @$sib;
1458          push @$new_todos, @$ch;          push @$new_todos, @$ch;
1459        } elsif ($nt == 3 or $nt == 4) {        } elsif ($nt == 3 or $nt == 4) {
# Line 1479  $Element->{$HTML_NS}->{dialog} = { Line 1547  $Element->{$HTML_NS}->{dialog} = {
1547              $self->{onerror}->(node => $node, type => 'element not allowed');              $self->{onerror}->(node => $node, type => 'element not allowed');
1548            }            }
1549          }          }
1550          my ($sib, $ch) = $self->_check_get_children ($node);          my ($sib, $ch) = $self->_check_get_children ($node, $todo);
1551          unshift @nodes, @$sib;          unshift @nodes, @$sib;
1552          push @$new_todos, @$ch;          push @$new_todos, @$ch;
1553        } elsif ($nt == 3 or $nt == 4) {        } elsif ($nt == 3 or $nt == 4) {
# Line 1525  $Element->{$HTML_NS}->{ol} = { Line 1593  $Element->{$HTML_NS}->{ol} = {
1593          unless ($node_ns eq $HTML_NS and $node_ln eq 'li') {          unless ($node_ns eq $HTML_NS and $node_ln eq 'li') {
1594            $self->{onerror}->(node => $node, type => 'element not allowed');            $self->{onerror}->(node => $node, type => 'element not allowed');
1595          }          }
1596          my ($sib, $ch) = $self->_check_get_children ($node);          my ($sib, $ch) = $self->_check_get_children ($node, $todo);
1597          unshift @nodes, @$sib;          unshift @nodes, @$sib;
1598          push @$new_todos, @$ch;          push @$new_todos, @$ch;
1599        } elsif ($nt == 3 or $nt == 4) {        } elsif ($nt == 3 or $nt == 4) {
# Line 1624  $Element->{$HTML_NS}->{dl} = { Line 1692  $Element->{$HTML_NS}->{dl} = {
1692              $self->{onerror}->(node => $node, type => 'element not allowed');              $self->{onerror}->(node => $node, type => 'element not allowed');
1693            }            }
1694          }          }
1695          my ($sib, $ch) = $self->_check_get_children ($node);          my ($sib, $ch) = $self->_check_get_children ($node, $todo);
1696          unshift @nodes, @$sib;          unshift @nodes, @$sib;
1697          push @$new_todos, @$ch;          push @$new_todos, @$ch;
1698        } elsif ($nt == 3 or $nt == 4) {        } elsif ($nt == 3 or $nt == 4) {
# Line 1745  $Element->{$HTML_NS}->{m} = { Line 1813  $Element->{$HTML_NS}->{m} = {
1813    checker => $HTMLInlineOrStrictlyInlineChecker,    checker => $HTMLInlineOrStrictlyInlineChecker,
1814  };  };
1815    
1816  $Element->{$HTML_NS}->{dfn} = { ## TODO: term duplication  $Element->{$HTML_NS}->{dfn} = {
1817    attrs_checker => $GetHTMLAttrsChecker->({}),    attrs_checker => $GetHTMLAttrsChecker->({}),
1818    checker => sub {    checker => sub {
1819      my ($self, $todo) = @_;      my ($self, $todo) = @_;
# Line 1753  $Element->{$HTML_NS}->{dfn} = { ## TODO: Line 1821  $Element->{$HTML_NS}->{dfn} = { ## TODO:
1821      my $end = $self->_add_minuses ({$HTML_NS => {dfn => 1}});      my $end = $self->_add_minuses ({$HTML_NS => {dfn => 1}});
1822      my ($sib, $ch) = $HTMLStrictlyInlineChecker->($self, $todo);      my ($sib, $ch) = $HTMLStrictlyInlineChecker->($self, $todo);
1823      push @$sib, $end;      push @$sib, $end;
1824    
1825        my $node = $todo->{node};
1826        my $term = $node->get_attribute_ns (undef, 'title');
1827        unless (defined $term) {
1828          for my $child (@{$node->child_nodes}) {
1829            if ($child->node_type == 1) { # ELEMENT_NODE
1830              if (defined $term) {
1831                undef $term;
1832                last;
1833              } elsif ($child->manakai_local_name eq 'abbr') {
1834                my $nsuri = $child->namespace_uri;
1835                if (defined $nsuri and $nsuri eq $HTML_NS) {
1836                  my $attr = $child->get_attribute_node_ns (undef, 'title');
1837                  if ($attr) {
1838                    $term = $attr->value;
1839                  }
1840                }
1841              }
1842            } elsif ($child->node_type == 3 or $child->node_type == 4) {
1843              ## TEXT_NODE or CDATA_SECTION_NODE
1844              if ($child->data =~ /\A[\x09-\x0D\x20]+\z/) { # Inter-element whitespace
1845                next;
1846              }
1847              undef $term;
1848              last;
1849            }
1850          }
1851          unless (defined $term) {
1852            $term = $node->text_content;
1853          }
1854        }
1855        if ($self->{term}->{$term}) {
1856          $self->{onerror}->(node => $node, type => 'duplicate term');
1857        } else {
1858          $self->{term}->{$term} = 1;
1859        }
1860    
1861      return ($sib, $ch);      return ($sib, $ch);
1862    },    },
1863  };  };
# Line 1862  $Element->{$HTML_NS}->{bdo} = { Line 1967  $Element->{$HTML_NS}->{bdo} = {
1967  $Element->{$HTML_NS}->{ins} = {  $Element->{$HTML_NS}->{ins} = {
1968    attrs_checker => $GetHTMLAttrsChecker->({    attrs_checker => $GetHTMLAttrsChecker->({
1969      cite => $HTMLURIAttrChecker,      cite => $HTMLURIAttrChecker,
1970      ## TODO: datetime      datetime => $HTMLDatetimeAttrChecker,
1971    }),    }),
1972    checker => $HTMLTransparentChecker,    checker => $HTMLTransparentChecker,
1973  };  };
# Line 1870  $Element->{$HTML_NS}->{ins} = { Line 1975  $Element->{$HTML_NS}->{ins} = {
1975  $Element->{$HTML_NS}->{del} = {  $Element->{$HTML_NS}->{del} = {
1976    attrs_checker => $GetHTMLAttrsChecker->({    attrs_checker => $GetHTMLAttrsChecker->({
1977      cite => $HTMLURIAttrChecker,      cite => $HTMLURIAttrChecker,
1978      ## TODO: datetime      datetime => $HTMLDatetimeAttrChecker,
1979    }),    }),
1980    checker => sub {    checker => sub {
1981      my ($self, $todo) = @_;      my ($self, $todo) = @_;
# Line 2311  $Element->{$HTML_NS}->{table} = { Line 2416  $Element->{$HTML_NS}->{table} = {
2416          } else { # after tfoot          } else { # after tfoot
2417            $self->{onerror}->(node => $node, type => 'element not allowed');            $self->{onerror}->(node => $node, type => 'element not allowed');
2418          }          }
2419          my ($sib, $ch) = $self->_check_get_children ($node);          my ($sib, $ch) = $self->_check_get_children ($node, $todo);
2420          unshift @nodes, @$sib;          unshift @nodes, @$sib;
2421          push @$new_todos, @$ch;          push @$new_todos, @$ch;
2422        } elsif ($nt == 3 or $nt == 4) {        } elsif ($nt == 3 or $nt == 4) {
# Line 2366  $Element->{$HTML_NS}->{colgroup} = { Line 2471  $Element->{$HTML_NS}->{colgroup} = {
2471          unless ($node_ns eq $HTML_NS and $node_ln eq 'col') {          unless ($node_ns eq $HTML_NS and $node_ln eq 'col') {
2472            $self->{onerror}->(node => $node, type => 'element not allowed');            $self->{onerror}->(node => $node, type => 'element not allowed');
2473          }          }
2474          my ($sib, $ch) = $self->_check_get_children ($node);          my ($sib, $ch) = $self->_check_get_children ($node, $todo);
2475          unshift @nodes, @$sib;          unshift @nodes, @$sib;
2476          push @$new_todos, @$ch;          push @$new_todos, @$ch;
2477        } elsif ($nt == 3 or $nt == 4) {        } elsif ($nt == 3 or $nt == 4) {
# Line 2412  $Element->{$HTML_NS}->{tbody} = { Line 2517  $Element->{$HTML_NS}->{tbody} = {
2517          } else {          } else {
2518            $self->{onerror}->(node => $node, type => 'element not allowed');            $self->{onerror}->(node => $node, type => 'element not allowed');
2519          }          }
2520          my ($sib, $ch) = $self->_check_get_children ($node);          my ($sib, $ch) = $self->_check_get_children ($node, $todo);
2521          unshift @nodes, @$sib;          unshift @nodes, @$sib;
2522          push @$new_todos, @$ch;          push @$new_todos, @$ch;
2523        } elsif ($nt == 3 or $nt == 4) {        } elsif ($nt == 3 or $nt == 4) {
# Line 2464  $Element->{$HTML_NS}->{tr} = { Line 2569  $Element->{$HTML_NS}->{tr} = {
2569          } else {          } else {
2570            $self->{onerror}->(node => $node, type => 'element not allowed');            $self->{onerror}->(node => $node, type => 'element not allowed');
2571          }          }
2572          my ($sib, $ch) = $self->_check_get_children ($node);          my ($sib, $ch) = $self->_check_get_children ($node, $todo);
2573          unshift @nodes, @$sib;          unshift @nodes, @$sib;
2574          push @$new_todos, @$ch;          push @$new_todos, @$ch;
2575        } elsif ($nt == 3 or $nt == 4) {        } elsif ($nt == 3 or $nt == 4) {
# Line 2500  $Element->{$HTML_NS}->{th} = { Line 2605  $Element->{$HTML_NS}->{th} = {
2605    checker => $HTMLBlockOrInlineChecker,    checker => $HTMLBlockOrInlineChecker,
2606  };  };
2607    
 ## TODO: table model error checking  
   
2608  ## TODO: forms  ## TODO: forms
2609    
2610  $Element->{$HTML_NS}->{script} = {  $Element->{$HTML_NS}->{script} = {
# Line 2626  $Element->{$HTML_NS}->{menu} = { Line 2729  $Element->{$HTML_NS}->{menu} = {
2729          }          }
2730          $self->{onerror}->(node => $node, type => 'element not allowed')          $self->{onerror}->(node => $node, type => 'element not allowed')
2731            if $not_allowed;            if $not_allowed;
2732          my ($sib, $ch) = $self->_check_get_children ($node);          my ($sib, $ch) = $self->_check_get_children ($node, $todo);
2733          unshift @nodes, @$sib;          unshift @nodes, @$sib;
2734          push @$new_todos, @$ch;          push @$new_todos, @$ch;
2735        } elsif ($nt == 3 or $nt == 4) {        } elsif ($nt == 3 or $nt == 4) {
# Line 2722  sub check_element ($$$) { Line 2825  sub check_element ($$$) {
2825    
2826    $self->{minuses} = {};    $self->{minuses} = {};
2827    $self->{id} = {};    $self->{id} = {};
2828      $self->{term} = {};
2829    $self->{usemap} = [];    $self->{usemap} = [];
2830    $self->{map} = {};    $self->{map} = {};
2831    $self->{has_link_type} = {};    $self->{has_link_type} = {};
# Line 2761  sub check_element ($$$) { Line 2865  sub check_element ($$$) {
2865        $eldef->{attrs_checker}->($self, $todo);        $eldef->{attrs_checker}->($self, $todo);
2866      } elsif ($todo->{type} eq 'plus') {      } elsif ($todo->{type} eq 'plus') {
2867        $self->_remove_minuses ($todo);        $self->_remove_minuses ($todo);
2868        } elsif ($todo->{type} eq 'code') {
2869          $todo->{code}->();
2870        } else {
2871          die "$0: Internal error: Unsupported checking action type |$todo->{type}|";
2872      }      }
2873    }    }
2874    
# Line 2803  sub _remove_minuses ($$) { Line 2911  sub _remove_minuses ($$) {
2911    1;    1;
2912  } # _remove_minuses  } # _remove_minuses
2913    
2914  sub _check_get_children ($$) {  sub _check_get_children ($$$) {
2915    my ($self, $node) = @_;    my ($self, $node, $parent_todo) = @_;
2916    my $new_todos = [];    my $new_todos = [];
2917    my $sib = [];    my $sib = [];
2918    TP: {    TP: {
# Line 2852  sub _check_get_children ($$) { Line 2960  sub _check_get_children ($$) {
2960      }      }
2961      push @$new_todos, {type => 'element', node => $node};      push @$new_todos, {type => 'element', node => $node};
2962    } # TP    } # TP
2963      
2964      for my $new_todo (@$new_todos) {
2965        $new_todo->{flag} = {%{$parent_todo->{flag} or {}}};
2966      }
2967      
2968    return ($sib, $new_todos);    return ($sib, $new_todos);
2969  } # _check_get_children  } # _check_get_children
2970    
Legend:
Removed from v.1.29  
changed lines
  Added in v.1.30
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24