--- test/html-whatpm/parser.cgi	2007/05/01 11:05:04	1.3
+++ test/html-whatpm/parser.cgi	2007/08/11 13:54:55	1.8
@@ -2,15 +2,16 @@
 use strict;
 
 use lib qw[/home/httpd/html/www/markup/html/whatpm
-           /home/wakaba/public_html/-temp/wiki/lib];
+           /home/wakaba/work/manakai2/lib];
+use CGI::Carp qw[fatalsToBrowser];
+use Time::HiRes qw/time/;
 
-use SuikaWiki::Input::HTTP; ## TODO: Use some better CGI module
-
-my $http = SuikaWiki::Input::HTTP->new;
+use Message::CGI::HTTP;
+my $http = Message::CGI::HTTP->new;
 
 ## TODO: _charset_
 
-my $mode = $http->meta_variable ('PATH_INFO');
+my $mode = $http->get_meta_variable ('PATH_INFO');
 ## TODO: decode unreserved characters
 
 if ($mode eq '/html' or $mode eq '/test') {
@@ -18,34 +19,69 @@
   require Whatpm::HTML;
   require Whatpm::NanoDOM;
 
-  my $s = $http->parameter ('s');
+  my $s = $http->get_parameter ('s');
   if (length $s > 1000_000) {
     print STDOUT "Status: 400 Document Too Long\nContent-Type: text/plain; charset=us-ascii\n\nToo long";
     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";
 
   print STDOUT "#errors\n";
 
   my $onerror = sub {
-    print STDOUT "0,0,", $_[0], "\n";
+    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->get_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;
+  }
+
+  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";
 }
@@ -84,3 +120,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 <w@suika.fam.cx>.
+
+=head1 LICENSE
+
+Copyright 2007 Wakaba <w@suika.fam.cx>
+
+This library is free software; you can redistribute it
+and/or modify it under the same terms as Perl itself.
+
+=cut
+
+## $Date: 2007/08/11 13:54:55 $