1 |
#!/usr/bin/perl |
#!/usr/bin/perl |
2 |
use strict; |
use strict; |
|
use utf8; |
|
3 |
|
|
4 |
use lib qw[/home/httpd/html/www/markup/html/whatpm |
use lib qw[/home/httpd/html/www/markup/html/whatpm |
5 |
/home/wakaba/work/manakai2/lib]; |
/home/wakaba/work/manakai2/lib]; |
6 |
use CGI::Carp qw[fatalsToBrowser]; |
use CGI::Carp qw[fatalsToBrowser]; |
|
use Scalar::Util qw[refaddr]; |
|
7 |
|
|
8 |
require WebHACC::Input; |
require WebHACC::Input; |
|
require WebHACC::Result; |
|
|
require WebHACC::Output; |
|
|
|
|
|
my $out; |
|
9 |
|
|
|
require Message::DOM::DOMImplementation; |
|
|
my $dom = Message::DOM::DOMImplementation->new; |
|
10 |
{ |
{ |
11 |
use Message::CGI::HTTP; |
require Message::CGI::HTTP; |
12 |
my $http = Message::CGI::HTTP->new; |
my $http = Message::CGI::HTTP->new; |
13 |
|
|
14 |
|
require WebHACC::Output; |
15 |
|
my $out = WebHACC::Output->new; |
16 |
|
$out->handle (*STDOUT); |
17 |
|
$out->set_utf8; |
18 |
|
|
19 |
if ($http->get_meta_variable ('PATH_INFO') ne '/') { |
if ($http->get_meta_variable ('PATH_INFO') ne '/') { |
20 |
print STDOUT "Status: 404 Not Found\nContent-Type: text/plain; charset=us-ascii\n\n400"; |
$out->http_error (404); |
21 |
exit; |
exit; |
22 |
} |
} |
23 |
|
|
24 |
load_text_catalog ('en'); ## TODO: conneg |
load_text_catalog ('en'); ## TODO: conneg |
25 |
|
|
|
$out = WebHACC::Output->new; |
|
|
$out->handle (*STDOUT); |
|
|
$out->set_utf8; |
|
26 |
$out->set_flush; |
$out->set_flush; |
27 |
$out->html (qq[Content-Type: text/html; charset=utf-8 |
$out->http_header; |
28 |
|
$out->html_header; |
29 |
<!DOCTYPE html> |
$out->unset_flush; |
|
<html lang="en"> |
|
|
<head> |
|
|
<title>Web Document Conformance Checker (BETA)</title> |
|
|
<link rel="stylesheet" href="../cc-style.css" type="text/css"> |
|
|
</head> |
|
|
<body> |
|
|
<h1><a href="../cc-interface">Web Document Conformance Checker</a> |
|
|
(<em>beta</em>)</h1> |
|
|
]); |
|
|
|
|
|
my $input = get_input_document ($http, $dom); |
|
30 |
|
|
31 |
|
my $input = get_input_document ($http); |
32 |
$out->input ($input); |
$out->input ($input); |
|
$out->unset_flush; |
|
33 |
|
|
34 |
|
require WebHACC::Result; |
35 |
my $result = WebHACC::Result->new; |
my $result = WebHACC::Result->new; |
36 |
$result->output ($out); |
$result->output ($out); |
37 |
$result->{conforming_min} = 1; |
$result->{conforming_min} = 1; |
177 |
|
|
178 |
} |
} |
179 |
|
|
180 |
sub get_input_document ($$) { |
sub get_input_document ($) { |
181 |
my ($http, $dom) = @_; |
my $http = shift; |
182 |
|
|
183 |
|
require Message::DOM::DOMImplementation; |
184 |
|
my $dom = Message::DOM::DOMImplementation->new; |
185 |
|
|
186 |
require Encode; |
require Encode; |
187 |
my $request_uri = Encode::decode ('utf-8', $http->get_parameter ('uri')); |
my $request_uri = Encode::decode ('utf-8', $http->get_parameter ('uri')); |