--- test/html-webhacc/cc.cgi 2007/07/17 13:52:54 1.13
+++ test/html-webhacc/cc.cgi 2007/09/02 07:59:01 1.17
@@ -2,12 +2,10 @@
use strict;
use lib qw[/home/httpd/html/www/markup/html/whatpm
- /home/wakaba/work/manakai/lib
- /home/wakaba/public_html/-temp/wiki/lib];
+ /home/wakaba/work/manakai2/lib];
use CGI::Carp qw[fatalsToBrowser];
use Scalar::Util qw[refaddr];
-
-use SuikaWiki::Input::HTTP; ## TODO: Use some better CGI module
+use Time::HiRes qw/time/;
sub htescape ($) {
my $s = $_[0];
@@ -21,23 +19,20 @@
return $s;
} # htescape
-my $http = SuikaWiki::Input::HTTP->new;
-
-## TODO: _charset_
+ use Message::CGI::HTTP;
+ my $http = Message::CGI::HTTP->new;
- if ($http->meta_variable ('PATH_INFO') ne '/') {
+ if ($http->get_meta_variable ('PATH_INFO') ne '/') {
print STDOUT "Status: 404 Not Found\nContent-Type: text/plain; charset=us-ascii\n\n400";
exit;
}
binmode STDOUT, ':utf8';
+ $| = 1;
require Message::DOM::DOMImplementation;
my $dom = Message::DOM::DOMImplementation->new;
- my $input = get_input_document ($http, $dom);
- my $inner_html_element = $http->parameter ('e');
-
load_text_catalog ('en'); ## TODO: conneg
my @nav;
@@ -52,7 +47,17 @@
+];
+
+ $| = 0;
+ my $input = get_input_document ($http, $dom);
+ my $inner_html_element = $http->get_parameter ('e');
+ my $char_length = 0;
+ my %time;
+ my $time1;
+ my $time2;
+ print qq[
- Request URI
@@ -63,6 +68,7 @@
push @nav, ['#document-info' => 'Information'];
if (defined $input->{s}) {
+ $char_length = length $input->{s};
print STDOUT qq[
- Base URI
@@ -73,6 +79,8 @@
- Character Encoding
- @{[defined $input->{charset} ? '
'.htescape ($input->{charset}).'
' : '(none)']}
@{[$input->{charset_overridden} ? '(overridden)' : '']}
+- Length
+ - $char_length byte@{[$char_length == 1 ? '' : 's']}
];
@@ -87,8 +95,11 @@
require Whatpm::HTML;
$input->{charset} ||= 'ISO-8859-1'; ## TODO: for now.
-
+
+ $time1 = time;
my $t = Encode::decode ($input->{charset}, $input->{s});
+ $time2 = time;
+ $time{decode} = $time2 - $time1;
print STDOUT qq[
@@ -113,6 +124,7 @@
};
$doc = $dom->create_document;
+ $time1 = time;
if (defined $inner_html_element and length $inner_html_element) {
$el = $doc->create_element_ns
('http://www.w3.org/1999/xhtml', [undef, $inner_html_element]);
@@ -120,6 +132,8 @@
} else {
Whatpm::HTML->parse_string ($t => $doc, $onerror);
}
+ $time2 = time;
+ $time{parse} = $time2 - $time1;
print STDOUT qq[
@@ -128,6 +142,9 @@
print_source_string_section (\($input->{s}), $input->{charset});
} elsif ({
'text/xml' => 1,
+ 'application/atom+xml' => 1,
+ 'application/rss+xml' => 1,
+ 'application/svg+xml' => 1,
'application/xhtml+xml' => 1,
'application/xml' => 1,
}->{$input->{media_type}}) {
@@ -149,9 +166,12 @@
return 1;
};
+ $time1 = time;
open my $fh, '<', \($input->{s});
$doc = Message::DOM::XMLParserTemp->parse_byte_stream
($fh => $dom, $onerror, charset => $input->{charset});
+ $time2 = time;
+ $time{parse_xml} = $time2 - $time1;
print STDOUT qq[
@@ -190,7 +210,7 @@
require Whatpm::ContentChecker;
my $onerror = sub {
my %opt = @_;
- my ($type, $cls, $msg) = get_text ($opt{type}, $opt{level});
+ my ($type, $cls, $msg) = get_text ($opt{type}, $opt{level}, $opt{node});
$type =~ tr/ /-/;
$type =~ s/\|/%7C/g;
$msg .= qq[ [Description]];
@@ -198,12 +218,15 @@
qq[\n], $msg, "\n";
};
+ $time1 = time;
my $elements;
if ($el) {
$elements = Whatpm::ContentChecker->check_element ($el, $onerror);
} else {
$elements = Whatpm::ContentChecker->check_document ($doc, $onerror);
}
+ $time2 = time;
+ $time{check} = $time2 - $time1;
print STDOUT qq[
@@ -212,6 +235,7 @@
if (@{$elements->{table}}) {
require JSON;
+ push @nav, ['#tables' => 'Tables'];
print STDOUT qq[
Tables
@@ -266,6 +290,7 @@
}
if (keys %{$elements->{id}}) {
+ push @nav, ['#identifiers' => 'IDs'];
print STDOUT qq[
Identifiers
@@ -273,7 +298,7 @@
];
for my $id (sort {$a cmp $b} keys %{$elements->{id}}) {
- print STDOUT qq[- @{[htescape $id]}
];
+ print STDOUT qq[@{[htescape $id]}
];
for (@{$elements->{id}->{$id}}) {
print STDOUT qq[- ].get_node_link ($_).qq[
];
}
@@ -282,6 +307,7 @@
}
if (keys %{$elements->{term}}) {
+ push @nav, ['#terms' => 'Terms'];
print STDOUT qq[
Terms
@@ -296,6 +322,23 @@
}
print STDOUT qq[];
}
+
+ if (keys %{$elements->{class}}) {
+ push @nav, ['#classes' => 'Classes'];
+ print STDOUT qq[
+
+
Classes
+
+
+];
+ for my $class (sort {$a cmp $b} keys %{$elements->{class}}) {
+ print STDOUT qq[@{[htescape $class]}
];
+ for (@{$elements->{class}->{$class}}) {
+ print STDOUT qq[- ].get_node_link ($_).qq[
];
+ }
+ }
+ print STDOUT qq[
];
+ }
}
## TODO: Show result
@@ -324,6 +367,12 @@
];
+ for (qw/decode parse parse_xml check/) {
+ next unless defined $time{$_};
+ open my $file, '>>', ".cc-$_.txt" or die ".cc-$_.txt: $!";
+ print $file $char_length, "\t", $time{$_}, "\n";
+ }
+
exit;
sub print_http_header_section ($) {
@@ -510,7 +559,7 @@
} # load_text_catalog
sub get_text ($) {
- my ($type, $level) = @_;
+ my ($type, $level, $node) = @_;
$type = $level . ':' . $type if defined $level;
my @arg;
{
@@ -519,6 +568,23 @@
$msg =~ s{\$([0-9]+)}{
defined $arg[$1] ? htescape ($arg[$1]) : '(undef)';
}ge;
+ $msg =~ s{{\@([A-Za-z0-9:_.-]+)}}{
+ UNIVERSAL::can ($node, 'get_attribute_ns')
+ ? htescape ($node->get_attribute_ns (undef, $1)) : ''
+ }ge;
+ $msg =~ s{{\@}}{
+ UNIVERSAL::can ($node, 'value') ? htescape ($node->value) : ''
+ }ge;
+ $msg =~ s{{local-name}}{
+ UNIVERSAL::can ($node, 'manakai_local_name')
+ ? htescape ($node->manakai_local_name) : ''
+ }ge;
+ $msg =~ s{{element-local-name}}{
+ (UNIVERSAL::can ($node, 'owner_element') and
+ $node->owner_element)
+ ? htescape ($node->owner_element->manakai_local_name)
+ : ''
+ }ge;
return ($type, $Msg->{$type}->[0], $msg);
} elsif ($type =~ s/:([^:]*)$//) {
unshift @arg, $1;
@@ -533,7 +599,7 @@
sub get_input_document ($$) {
my ($http, $dom) = @_;
- my $request_uri = $http->parameter ('uri');
+ my $request_uri = $http->get_parameter ('uri');
my $r = {};
if (defined $request_uri and length $request_uri) {
my $uri = $dom->create_uri_reference ($request_uri);
@@ -582,7 +648,8 @@
$ua->max_size (1000_000);
my $req = HTTP::Request->new (GET => $request_uri);
my $res = $ua->request ($req);
- if ($res->is_success or $http->parameter ('error-page')) {
+ ## TODO: 401 sets |is_success| true.
+ if ($res->is_success or $http->get_parameter ('error-page')) {
$r->{base_uri} = $res->base; ## NOTE: It does check |Content-Base|, |Content-Location|, and . ## TODO: Use our own code!
$r->{uri} = $res->request->uri;
$r->{request_uri} = $request_uri;
@@ -597,7 +664,7 @@
$r->{charset} =~ tr/\\//d;
}
- my $input_charset = $http->parameter ('charset');
+ my $input_charset = $http->get_parameter ('charset');
if (defined $input_charset and length $input_charset) {
$r->{charset_overridden}
= (not defined $r->{charset} or $r->{charset} ne $input_charset);
@@ -618,17 +685,17 @@
$r->{header_status_code} = $res->code;
$r->{header_status_text} = $res->message;
} else {
- $r->{s} = ''.$http->parameter ('s');
+ $r->{s} = ''.$http->get_parameter ('s');
$r->{uri} = q;
$r->{request_uri} = q;
$r->{base_uri} = q;
- $r->{charset} = ''.$http->parameter ('_charset_');
+ $r->{charset} = ''.$http->get_parameter ('_charset_');
$r->{charset} =~ s/\s+//g;
$r->{charset} = 'utf-8' if $r->{charset} eq '';
$r->{header_field} = [];
}
- my $input_format = $http->parameter ('i');
+ my $input_format = $http->get_parameter ('i');
if (defined $input_format and length $input_format) {
$r->{media_type_overridden}
= (not defined $r->{media_type} or $input_format ne $r->{media_type});
@@ -692,4 +759,4 @@
=cut
-## $Date: 2007/07/17 13:52:54 $
+## $Date: 2007/09/02 07:59:01 $