--- test/html-whatpm/parser.cgi 2007/05/01 09:25:31 1.1
+++ test/html-whatpm/parser.cgi 2007/05/28 14:04:57 1.7
@@ -1,7 +1,10 @@
#!/usr/bin/perl
use strict;
-use lib qw[.. /home/wakaba/public_html/-temp/wiki/lib];
+use lib qw[/home/httpd/html/www/markup/html/whatpm
+ /home/wakaba/public_html/-temp/wiki/lib];
+use CGI::Carp qw[fatalsToBrowser];
+use Time::HiRes qw/time/;
use SuikaWiki::Input::HTTP; ## TODO: Use some better CGI module
@@ -12,10 +15,10 @@
my $mode = $http->meta_variable ('PATH_INFO');
## TODO: decode unreserved characters
-if ($mode eq '/html' or $mode eq '/error-and-html') {
+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) {
@@ -23,23 +26,139 @@
exit;
}
+ my $time1 = time;
$s = Encode::decode ('utf-8', $s);
-
+ my $time2 = time;
+ my %time = (decode => $time2 - $time1);
+ my $char_length = length $s;
+
print STDOUT "Content-Type: text/plain; charset=utf-8\n\n";
- my $onerror = $mode eq '/error-and-html' ? sub {
- print STDOUT "0,0,", $_[0], "\n";
- } : sub { };
-
- my $doc = What::HTML->parse_string
- ($s => What::NanoDOM::Document->new, $onerror);
+ print STDOUT "#errors\n";
- if ($mode eq '/error-and-html') {
- print "--\n";
+ my $onerror = sub {
+ my (%opt) = @_;
+ print STDOUT "$opt{line},$opt{column},$opt{type}\n";
+ };
+
+ $time1 = time;
+ my $doc = Whatpm::HTML->parse_string
+ ($s => Whatpm::NanoDOM::Document->new, $onerror);
+ $time2 = time;
+ $time{parse} = $time2 - $time1;
+
+ print "#document\n";
+
+ my $out;
+ $time1 = time;
+ if ($mode eq '/html') {
+ $out = Whatpm::HTML->get_inner_html ($doc);
+ } else { # test
+ $out = test_serialize ($doc);
+ }
+ $time2 = time;
+ $time{serialize} = $time2 - $time1;
+ print STDOUT Encode::encode ('utf-8', $$out);
+ print STDOUT "\n";
+
+ if ($http->parameter ('dom5')) {
+ require Whatpm::ContentChecker;
+ print STDOUT "#domerrors\n";
+ $time1 = time;
+ Whatpm::ContentChecker->check_document ($doc, sub {
+ my %opt = @_;
+ print STDOUT get_node_path ($opt{node}) . ';' . $opt{type} . "\n";
+ });
+ $time2 = time;
+ $time{check} = $time2 - $time1;
}
- my $html = What::HTML->get_inner_html ($doc);
- print STDOUT Encode::encode ('utf-8', $$html);
+ print STDOUT "#log\n";
+ print STDOUT "byte->char\t", $time{decode}, "s\n";
+ print STDOUT "html5->dom5\t", $time{parse}, "s\n";
+ print STDOUT "dom5->serialize\t", $time{serialize}, "s\n";
+ print STDOUT "dom5 check\t", $time{check}, "s\n" if defined $time{check};
+ for (qw/decode parse serialize check/) {
+ next unless defined $time{$_};
+ open my $file, '>>', ".$_.txt" or die ".$_.txt: $!";
+ print $file $char_length, "\t", $time{$_}, "\n";
+ }
} else {
print STDOUT "Status: 404 Not Found\nContent-Type: text/plain; charset=us-ascii\n\n404";
}
+
+exit;
+
+sub test_serialize ($) {
+ my $node = shift;
+ my $r = '';
+
+ my @node = map { [$_, ''] } @{$node->child_nodes};
+ while (@node) {
+ my $child = shift @node;
+ my $nt = $child->[0]->node_type;
+ if ($nt == $child->[0]->ELEMENT_NODE) {
+ $r .= '| ' . $child->[1] . '<' . $child->[0]->tag_name . ">\x0A"; ## ISSUE: case?
+
+ for my $attr (sort {$a->[0] cmp $b->[0]} map { [$_->name, $_->value] }
+ @{$child->[0]->attributes}) {
+ $r .= '| ' . $child->[1] . ' ' . $attr->[0] . '="'; ## ISSUE: case?
+ $r .= $attr->[1] . '"' . "\x0A";
+ }
+
+ unshift @node,
+ map { [$_, $child->[1] . ' '] } @{$child->[0]->child_nodes};
+ } elsif ($nt == $child->[0]->TEXT_NODE) {
+ $r .= '| ' . $child->[1] . '"' . $child->[0]->data . '"' . "\x0A";
+ } elsif ($nt == $child->[0]->COMMENT_NODE) {
+ $r .= '| ' . $child->[1] . '\x0A";
+ } elsif ($nt == $child->[0]->DOCUMENT_TYPE_NODE) {
+ $r .= '| ' . $child->[1] . '[0]->name . ">\x0A";
+ } else {
+ $r .= '| ' . $child->[1] . $child->[0]->node_type . "\x0A"; # error
+ }
+ }
+
+ 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/28 14:04:57 $