| 89 |
]; |
]; |
| 90 |
|
|
| 91 |
my $result = {conforming_min => 1, conforming_max => 1}; |
my $result = {conforming_min => 1, conforming_max => 1}; |
| 92 |
print_http_header_section ($input, $result); |
check_and_print ($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); |
|
|
} |
|
|
|
|
| 93 |
print_result_section ($result); |
print_result_section ($result); |
| 94 |
} else { |
} else { |
| 95 |
print STDOUT qq[</dl></div>]; |
print STDOUT qq[</dl></div>]; |
| 126 |
$result->{conforming_min} = 0; |
$result->{conforming_min} = 0; |
| 127 |
} elsif ($err->{level} eq 'w' or $err->{level} eq 'g') { |
} elsif ($err->{level} eq 'w' or $err->{level} eq 'g') { |
| 128 |
$result->{$layer}->{warning}++; |
$result->{$layer}->{warning}++; |
| 129 |
} elsif ($err->{level} eq 'unsupported') { |
} elsif ($err->{level} eq 'u' or $err->{level} eq 'unsupported') { |
| 130 |
$result->{$layer}->{unsupported}++; |
$result->{$layer}->{unsupported}++; |
| 131 |
$result->{unsupported} = 1; |
$result->{unsupported} = 1; |
| 132 |
} else { |
} else { |
| 145 |
} |
} |
| 146 |
} # add_error |
} # add_error |
| 147 |
|
|
| 148 |
|
sub check_and_print ($$) { |
| 149 |
|
my ($input, $result) = @_; |
| 150 |
|
|
| 151 |
|
print_http_header_section ($input, $result); |
| 152 |
|
|
| 153 |
|
my $doc; |
| 154 |
|
my $el; |
| 155 |
|
my $manifest; |
| 156 |
|
|
| 157 |
|
if ($input->{media_type} eq 'text/html') { |
| 158 |
|
($doc, $el) = print_syntax_error_html_section ($input, $result); |
| 159 |
|
print_source_string_section |
| 160 |
|
(\($input->{s}), $input->{charset} || $doc->input_encoding); |
| 161 |
|
} elsif ({ |
| 162 |
|
'text/xml' => 1, |
| 163 |
|
'application/atom+xml' => 1, |
| 164 |
|
'application/rss+xml' => 1, |
| 165 |
|
'application/svg+xml' => 1, |
| 166 |
|
'application/xhtml+xml' => 1, |
| 167 |
|
'application/xml' => 1, |
| 168 |
|
}->{$input->{media_type}}) { |
| 169 |
|
($doc, $el) = print_syntax_error_xml_section ($input, $result); |
| 170 |
|
print_source_string_section (\($input->{s}), $doc->input_encoding); |
| 171 |
|
} elsif ($input->{media_type} eq 'text/cache-manifest') { |
| 172 |
|
## TODO: MUST be text/cache-manifest |
| 173 |
|
$manifest = print_syntax_error_manifest_section ($input, $result); |
| 174 |
|
print_source_string_section (\($input->{s}), 'utf-8'); |
| 175 |
|
} else { |
| 176 |
|
## TODO: Change HTTP status code?? |
| 177 |
|
print_result_unknown_type_section ($input, $result); |
| 178 |
|
} |
| 179 |
|
|
| 180 |
|
if (defined $doc or defined $el) { |
| 181 |
|
print_structure_dump_dom_section ($doc, $el); |
| 182 |
|
my $elements = print_structure_error_dom_section ($doc, $el, $result); |
| 183 |
|
print_table_section ($elements->{table}) if @{$elements->{table}}; |
| 184 |
|
print_id_section ($elements->{id}) if keys %{$elements->{id}}; |
| 185 |
|
print_term_section ($elements->{term}) if keys %{$elements->{term}}; |
| 186 |
|
print_class_section ($elements->{class}) if keys %{$elements->{class}}; |
| 187 |
|
} elsif (defined $manifest) { |
| 188 |
|
print_structure_dump_manifest_section ($manifest); |
| 189 |
|
print_structure_error_manifest_section ($manifest, $result); |
| 190 |
|
} |
| 191 |
|
} # check_and_print |
| 192 |
|
|
| 193 |
sub print_http_header_section ($$) { |
sub print_http_header_section ($$) { |
| 194 |
my ($input, $result) = @_; |
my ($input, $result) = @_; |
| 195 |
return unless defined $input->{header_status_code} or |
return unless defined $input->{header_status_code} or |
| 811 |
</div> |
</div> |
| 812 |
]; |
]; |
| 813 |
push @nav, ['#parse-errors' => 'Errors']; |
push @nav, ['#parse-errors' => 'Errors']; |
| 814 |
add_error (char => {level => 'unsupported'} => $result); |
add_error (char => {level => 'u'} => $result); |
| 815 |
add_error (syntax => {level => 'unsupported'} => $result); |
add_error (syntax => {level => 'u'} => $result); |
| 816 |
add_error (structure => {level => 'unsupported'} => $result); |
add_error (structure => {level => 'u'} => $result); |
| 817 |
} # print_result_unknown_type_section |
} # print_result_unknown_type_section |
| 818 |
|
|
| 819 |
sub print_result_input_error_section ($) { |
sub print_result_input_error_section ($) { |
| 870 |
} elsif ($err->{level} eq 'w') { |
} elsif ($err->{level} eq 'w') { |
| 871 |
$r = qq[<strong><a href="../error-description#level-w">Warning</a></strong>: |
$r = qq[<strong><a href="../error-description#level-w">Warning</a></strong>: |
| 872 |
]; |
]; |
| 873 |
} elsif ($err->{level} eq 'unsupported') { |
} elsif ($err->{level} eq 'u' or $err->{level} eq 'unsupported') { |
| 874 |
$r = qq[<strong><a href="../error-description#level-u">Not |
$r = qq[<strong><a href="../error-description#level-u">Not |
| 875 |
supported</a></strong>: ]; |
supported</a></strong>: ]; |
| 876 |
} else { |
} else { |