--- test/html-whatpm/parser.cgi 2007/05/01 11:05:04 1.3 +++ test/html-whatpm/parser.cgi 2007/05/20 08:14:48 1.4 @@ -31,7 +31,8 @@ print STDOUT "#errors\n"; my $onerror = sub { - print STDOUT "0,0,", $_[0], "\n"; + my (%opt) = @_; + print STDOUT "$opt{line},$opt{column},$opt{type}\n"; }; my $doc = Whatpm::HTML->parse_string @@ -46,6 +47,26 @@ $out = test_serialize ($doc); } print STDOUT Encode::encode ('utf-8', $$out); + print STDOUT "\n"; + + if ($http->parameter ('dom5')) { + require Whatpm::ContentChecker; + print STDOUT "#domerrors\n"; + my $docel = $doc->document_element; + my $docel_nsuri = $docel->namespace_uri; + if (defined $docel_nsuri and + $docel_nsuri eq q and + $docel->manakai_local_name eq 'html') { + # + } else { + print STDOUT get_node_path ($docel) . ";element not allowed\n"; + } + my $cc = Whatpm::ContentChecker->new; + $cc->check_element ($docel, sub { + my %opt = @_; + print STDOUT get_node_path ($opt{node}) . ';' . $opt{type} . "\n"; + }); + } } else { print STDOUT "Status: 404 Not Found\nContent-Type: text/plain; charset=us-ascii\n\n404"; } @@ -84,3 +105,44 @@ return \$r; } # test_serialize + +sub get_node_path ($) { + my $node = shift; + my @r; + while (defined $node) { + my $rs; + if ($node->node_type == 1) { + $rs = $node->manakai_local_name; + $node = $node->parent_node; + } elsif ($node->node_type == 2) { + $rs = '@' . $node->manakai_local_name; + $node = $node->owner_element; + } elsif ($node->node_type == 3) { + $rs = '"' . $node->data . '"'; + $node = $node->parent_node; + } elsif ($node->node_type == 9) { + $rs = ''; + $node = $node->parent_node; + } else { + $rs = '#' . $node->node_type; + $node = $node->parent_node; + } + unshift @r, $rs; + } + return join '/', @r; +} # get_node_path + +=head1 AUTHOR + +Wakaba . + +=head1 LICENSE + +Copyright 2007 Wakaba + +This library is free software; you can redistribute it +and/or modify it under the same terms as Perl itself. + +=cut + +## $Date: 2007/05/20 08:14:48 $