--- test/html-webhacc/cc.cgi 2007/11/18 11:05:12 1.26
+++ test/html-webhacc/cc.cgi 2008/03/16 11:38:47 1.41
@@ -20,6 +20,11 @@
return $s;
} # htescape
+ my @nav;
+ my %time;
+ require Message::DOM::DOMImplementation;
+ my $dom = Message::DOM::DOMImplementation->new;
+{
use Message::CGI::HTTP;
my $http = Message::CGI::HTTP->new;
@@ -31,12 +36,8 @@
binmode STDOUT, ':utf8';
$| = 1;
- require Message::DOM::DOMImplementation;
- my $dom = Message::DOM::DOMImplementation->new;
-
load_text_catalog ('en'); ## TODO: conneg
- my @nav;
print STDOUT qq[Content-Type: text/html; charset=utf-8
@@ -53,7 +54,6 @@
$| = 0;
my $input = get_input_document ($http, $dom);
my $char_length = 0;
- my %time;
print qq[
@@ -86,50 +86,14 @@
$char_length byte@{[$char_length == 1 ? '' : 's']}
+
+
];
+ $input->{id_prefix} = '';
+ #$input->{nested} = 0;
my $result = {conforming_min => 1, conforming_max => 1};
- print_http_header_section ($input, $result);
-
- my $doc;
- my $el;
- my $manifest;
-
- if ($input->{media_type} eq 'text/html') {
- ($doc, $el) = print_syntax_error_html_section ($input, $result);
- print_source_string_section
- (\($input->{s}), $input->{charset} || $doc->input_encoding);
- } 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}}) {
- ($doc, $el) = print_syntax_error_xml_section ($input, $result);
- print_source_string_section (\($input->{s}), $doc->input_encoding);
- } elsif ($input->{media_type} eq 'text/cache-manifest') {
-## TODO: MUST be text/cache-manifest
- $manifest = print_syntax_error_manifest_section ($input, $result);
- print_source_string_section (\($input->{s}), 'utf-8');
- } else {
- ## TODO: Change HTTP status code??
- print_result_unknown_type_section ($input, $result);
- }
-
- if (defined $doc or defined $el) {
- print_structure_dump_dom_section ($doc, $el);
- my $elements = print_structure_error_dom_section ($doc, $el, $result);
- print_table_section ($elements->{table}) if @{$elements->{table}};
- print_id_section ($elements->{id}) if keys %{$elements->{id}};
- print_term_section ($elements->{term}) if keys %{$elements->{term}};
- print_class_section ($elements->{class}) if keys %{$elements->{class}};
- } elsif (defined $manifest) {
- print_structure_dump_manifest_section ($manifest);
- print_structure_error_manifest_section ($manifest, $result);
- }
-
+ check_and_print ($input => $result);
print_result_section ($result);
} else {
print STDOUT qq[];
@@ -156,6 +120,7 @@
}
exit;
+}
sub add_error ($$$) {
my ($layer, $err, $result) = @_;
@@ -166,9 +131,11 @@
$result->{conforming_min} = 0;
} elsif ($err->{level} eq 'w' or $err->{level} eq 'g') {
$result->{$layer}->{warning}++;
- } elsif ($err->{level} eq 'unsupported') {
+ } elsif ($err->{level} eq 'u' or $err->{level} eq 'unsupported') {
$result->{$layer}->{unsupported}++;
$result->{unsupported} = 1;
+ } elsif ($err->{level} eq 'i') {
+ #
} else {
$result->{$layer}->{must}++;
$result->{$layer}->{score_max} -= 2;
@@ -185,14 +152,112 @@
}
} # add_error
+sub check_and_print ($$) {
+ my ($input, $result) = @_;
+
+ print_http_header_section ($input, $result);
+
+ my $doc;
+ my $el;
+ my $cssom;
+ my $manifest;
+ my @subdoc;
+
+ if ($input->{media_type} eq 'text/html') {
+ ($doc, $el) = print_syntax_error_html_section ($input, $result);
+ print_source_string_section
+ ($input,
+ \($input->{s}),
+ $input->{charset} || $doc->input_encoding);
+ } 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}}) {
+ ($doc, $el) = print_syntax_error_xml_section ($input, $result);
+ print_source_string_section ($input,
+ \($input->{s}),
+ $doc->input_encoding);
+ } elsif ($input->{media_type} eq 'text/css') {
+ $cssom = print_syntax_error_css_section ($input, $result);
+ print_source_string_section
+ ($input, \($input->{s}),
+ $cssom->manakai_input_encoding);
+ } elsif ($input->{media_type} eq 'text/cache-manifest') {
+## TODO: MUST be text/cache-manifest
+ $manifest = print_syntax_error_manifest_section ($input, $result);
+ print_source_string_section ($input, \($input->{s}),
+ 'utf-8');
+ } else {
+ ## TODO: Change HTTP status code??
+ print_result_unknown_type_section ($input, $result);
+ }
+
+ if (defined $doc or defined $el) {
+ $doc->document_uri ($input->{uri});
+ $doc->manakai_entity_base_uri ($input->{base_uri});
+ print_structure_dump_dom_section ($input, $doc, $el);
+ my $elements = print_structure_error_dom_section
+ ($input, $doc, $el, $result, sub {
+ push @subdoc, shift;
+ });
+ print_table_section ($input, $elements->{table}) if @{$elements->{table}};
+ print_listing_section ({
+ id => 'identifiers', label => 'IDs', heading => 'Identifiers',
+ }, $input, $elements->{id}) if keys %{$elements->{id}};
+ print_listing_section ({
+ id => 'terms', label => 'Terms', heading => 'Terms',
+ }, $input, $elements->{term}) if keys %{$elements->{term}};
+ print_listing_section ({
+ id => 'classes', label => 'Classes', heading => 'Classes',
+ }, $input, $elements->{class}) if keys %{$elements->{class}};
+ } elsif (defined $cssom) {
+ print_structure_dump_cssom_section ($input, $cssom);
+ ## TODO: CSSOM validation
+ add_error ('structure', {level => 'u'} => $result);
+ } elsif (defined $manifest) {
+ print_structure_dump_manifest_section ($input, $manifest);
+ print_structure_error_manifest_section ($input, $manifest, $result);
+ }
+
+ my $id_prefix = 0;
+ for my $subinput (@subdoc) {
+ $subinput->{id_prefix} = 'subdoc-' . ++$id_prefix;
+ $subinput->{nested} = 1;
+ $subinput->{base_uri} = $subinput->{container_node}->base_uri
+ unless defined $subinput->{base_uri};
+ my $ebaseuri = htescape ($subinput->{base_uri});
+ push @nav, ['#' . $subinput->{id_prefix} => 'Sub #' . $id_prefix];
+ print STDOUT qq[];
+ }
+} # check_and_print
+
sub print_http_header_section ($$) {
my ($input, $result) = @_;
return unless defined $input->{header_status_code} or
defined $input->{header_status_text} or
- @{$input->{header_field}};
+ @{$input->{header_field} or []};
- push @nav, ['#source-header' => 'HTTP Header'];
- print STDOUT qq[