--- test/html-webhacc/cc.cgi 2008/02/10 02:30:14 1.32
+++ 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,8 +86,12 @@
$char_length byte@{[$char_length == 1 ? '' : 's']}
+
+
];
+ $input->{id_prefix} = '';
+ #$input->{nested} = 0;
my $result = {conforming_min => 1, conforming_max => 1};
check_and_print ($input => $result);
print_result_section ($result);
@@ -116,6 +120,7 @@
}
exit;
+}
sub add_error ($$$) {
my ($layer, $err, $result) = @_;
@@ -129,6 +134,8 @@
} 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;
@@ -147,19 +154,21 @@
sub check_and_print ($$) {
my ($input, $result) = @_;
- $input->{id_prefix} = '';
- #$input->{nested} = 1/0;
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->{s}), $input->{charset} || $doc->input_encoding);
+ ($input,
+ \($input->{s}),
+ $input->{charset} || $doc->input_encoding);
} elsif ({
'text/xml' => 1,
'application/atom+xml' => 1,
@@ -169,35 +178,83 @@
'application/xml' => 1,
}->{$input->{media_type}}) {
($doc, $el) = print_syntax_error_xml_section ($input, $result);
- print_source_string_section (\($input->{s}), $doc->input_encoding);
+ 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->{s}), 'utf-8');
+ 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);
+ ($input, $doc, $el, $result, sub {
+ push @subdoc, shift;
+ });
print_table_section ($input, $elements->{table}) if @{$elements->{table}};
- print_id_section ($input, $elements->{id}) if keys %{$elements->{id}};
- print_term_section ($input, $elements->{term}) if keys %{$elements->{term}};
- print_class_section ($input, $elements->{class}) if keys %{$elements->{class}};
+ 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'] unless $input->{nested};
print STDOUT qq[