@@ -94,20 +110,21 @@
my $onerror = sub {
my (%opt) = @_;
- my ($cls, $msg) = get_text ($opt{type}, $opt{level});
+ my ($type, $cls, $msg) = get_text ($opt{type}, $opt{level});
if ($opt{column} > 0) {
print STDOUT qq[
Line $opt{line} column $opt{column}\n];
} else {
$opt{line} = $opt{line} - 1 || 1;
print STDOUT qq[
Line $opt{line}\n];
}
- $opt{type} =~ tr/ /-/;
- $opt{type} =~ s/\|/%7C/g;
- $msg .= qq[ [
Description]];
+ $type =~ tr/ /-/;
+ $type =~ s/\|/%7C/g;
+ $msg .= qq[ [
Description]];
print STDOUT qq[
$msg\n];
};
$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]);
@@ -115,6 +132,8 @@
} else {
Whatpm::HTML->parse_string ($t => $doc, $onerror);
}
+ $time2 = time;
+ $time{parse} = $time2 - $time1;
print STDOUT qq[
Tables
@@ -224,7 +252,9 @@
$i++;
print STDOUT qq[
] .
get_node_link ($table_el) . q[
];
-
+
+ ## TODO: Make |ContentChecker| return |form_table| result
+ ## so that this script don't have to run the algorithm twice.
my $table = Whatpm::HTMLTable->form_table ($table_el);
for (@{$table->{column_group}}, @{$table->{column}}, $table->{caption}) {
@@ -246,6 +276,7 @@
for (@$_) {
$_->{id} = refaddr $_->{element} if defined $_->{element};
delete $_->{element};
+ $_->{is_header} = $_->{is_header} ? 1 : 0;
}
}
}
@@ -258,7 +289,25 @@
print STDOUT qq[];
}
+ if (keys %{$elements->{id}}) {
+ push @nav, ['#identifiers' => 'IDs'];
+ print STDOUT qq[
+
+
Identifiers
+
+
+];
+ for my $id (sort {$a cmp $b} keys %{$elements->{id}}) {
+ print STDOUT qq[@{[htescape $id]}- ].get_node_link ($_).qq[
];
+ }
+ }
+ print STDOUT qq[
];
+ }
+
if (keys %{$elements->{term}}) {
+ push @nav, ['#terms' => 'Terms'];
print STDOUT qq[
Terms
@@ -273,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]}- ].get_node_link ($_).qq[
];
+ }
+ }
+ print STDOUT qq[
];
+ }
}
## TODO: Show result
@@ -301,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 ($) {
@@ -487,7 +559,7 @@
} # load_text_catalog
sub get_text ($) {
- my ($type, $level) = @_;
+ my ($type, $level, $node) = @_;
$type = $level . ':' . $type if defined $level;
my @arg;
{
@@ -496,13 +568,30 @@
$msg =~ s{
\$([0-9]+)}{
defined $arg[$1] ? htescape ($arg[$1]) : '(undef)';
}ge;
- return ($Msg->{$type}->[0], $msg);
+ $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;
redo;
}
}
- return ('', htescape ($_[0]));
+ return ($type, '', htescape ($_[0]));
} # get_text
}
@@ -510,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);
@@ -559,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;
@@ -574,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);
@@ -595,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});
@@ -669,4 +759,4 @@
=cut
-## $Date: 2007/07/16 08:38:48 $
+## $Date: 2007/09/02 07:59:01 $