--- test/html-whatpm/parser.cgi 2007/05/01 10:27:06 1.2 +++ test/html-whatpm/parser.cgi 2007/05/25 14:24:31 1.5 @@ -3,6 +3,7 @@ use lib qw[/home/httpd/html/www/markup/html/whatpm /home/wakaba/public_html/-temp/wiki/lib]; +use CGI::Carp qw[fatalsToBrowser]; use SuikaWiki::Input::HTTP; ## TODO: Use some better CGI module @@ -15,8 +16,8 @@ if ($mode eq '/html' or $mode eq '/test') { require Encode; - require What::HTML; - require What::NanoDOM; + require Whatpm::HTML; + require Whatpm::NanoDOM; my $s = $http->parameter ('s'); if (length $s > 1000_000) { @@ -31,21 +32,42 @@ 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 = What::HTML->parse_string - ($s => What::NanoDOM::Document->new, $onerror); + my $doc = Whatpm::HTML->parse_string + ($s => Whatpm::NanoDOM::Document->new, $onerror); print "#document\n"; my $out; if ($mode eq '/html') { - $out = What::HTML->get_inner_html ($doc); + $out = Whatpm::HTML->get_inner_html ($doc); } else { # test $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 +106,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/25 14:24:31 $