/[pub]/test/html-webhacc/cc.cgi
Suika

Contents of /test/html-webhacc/cc.cgi

Parent Directory Parent Directory | Revision Log Revision Log

Revision 1.56 - (hide annotations) (download)
Mon Jul 21 08:39:12 2008 UTC (18 years ago) by wakaba
Branch: MAIN
Changes since 1.55: +1 -137 lines 
++ ChangeLog	21 Jul 2008 08:33:17 -0000
	* cc.cgi (print_table_section): Removed (now part of
	WebHACC::Language::DOM).

2008-07-21  Wakaba  <wakaba@suika.fam.cx>

++ html/WebHACC/Language/ChangeLog	21 Jul 2008 08:39:05 -0000
	* Base.pm (generate_source_string_section): Invoke
	|add_source_to_parse_error_list| method for generating a
	script fragment.

	* CSS.pm, CacheManifest.pm, DOM.pm, HTML.pm, WebIDL.pm,
	XML.pm: Use new methods for generating sections and error lists.

	* DOM.pm (generate_additional_sections, generate_table_section): New.

	* Default.pm: Pass |input| in place of |url| for unknown syntax
	error.

2008-07-21  Wakaba  <wakaba@suika.fam.cx>

++ html/WebHACC/ChangeLog	21 Jul 2008 08:36:01 -0000
	* Output.pm (start_section, end_section): "role" option
	implemented.  Automatical rank setting implemented.
	(start_error_list, end_error_list): New.
	(add_source_to_parse_error_list): New.

	* Result.pm: "Unknown location" message text changed.

2008-07-21  Wakaba  <wakaba@suika.fam.cx>
1 wakaba 1.1 #!/usr/bin/perl
2     use strict;
3 wakaba 1.23 use utf8;
4 wakaba 1.1
5     use lib qw[/home/httpd/html/www/markup/html/whatpm
6 wakaba 1.16 /home/wakaba/work/manakai2/lib];
7 wakaba 1.1 use CGI::Carp qw[fatalsToBrowser];
8 wakaba 1.2 use Scalar::Util qw[refaddr];
9 wakaba 1.1
10 wakaba 1.53 require WebHACC::Input;
11     require WebHACC::Result;
12     require WebHACC::Output;
13    
14     my $out;
15 wakaba 1.2
16 wakaba 1.35 require Message::DOM::DOMImplementation;
17     my $dom = Message::DOM::DOMImplementation->new;
18     {
19 wakaba 1.16 use Message::CGI::HTTP;
20     my $http = Message::CGI::HTTP->new;
21 wakaba 1.1
22 wakaba 1.16 if ($http->get_meta_variable ('PATH_INFO') ne '/') {
23 wakaba 1.8 print STDOUT "Status: 404 Not Found\nContent-Type: text/plain; charset=us-ascii\n\n400";
24     exit;
25     }
26 wakaba 1.53
27 wakaba 1.7 load_text_catalog ('en'); ## TODO: conneg
28    
29 wakaba 1.53 $out = WebHACC::Output->new;
30     $out->handle (*STDOUT);
31     $out->set_utf8;
32     $out->set_flush;
33     $out->html (qq[Content-Type: text/html; charset=utf-8
34 wakaba 1.2
35     <!DOCTYPE html>
36     <html lang="en">
37     <head>
38     <title>Web Document Conformance Checker (BETA)</title>
39 wakaba 1.3 <link rel="stylesheet" href="../cc-style.css" type="text/css">
40 wakaba 1.2 </head>
41     <body>
42 wakaba 1.13 <h1><a href="../cc-interface">Web Document Conformance Checker</a>
43     (<em>beta</em>)</h1>
44 wakaba 1.53 ]);
45 wakaba 1.2
46 wakaba 1.14 my $input = get_input_document ($http, $dom);
47 wakaba 1.55
48 wakaba 1.53 $out->input ($input);
49     $out->unset_flush;
50    
51 wakaba 1.55 my $result = WebHACC::Result->new;
52     $result->output ($out);
53     $result->{conforming_min} = 1;
54     $result->{conforming_max} = 1;
55 wakaba 1.14
56 wakaba 1.55 $out->html ('<script src="../cc-script.js"></script>');
57 wakaba 1.54
58 wakaba 1.55 check_and_print ($input => $result => $out);
59    
60     $result->generate_result_section;
61 wakaba 1.1
62 wakaba 1.53 $out->nav_list;
63 wakaba 1.16
64 wakaba 1.53 exit;
65 wakaba 1.35 }
66 wakaba 1.1
67 wakaba 1.53 sub check_and_print ($$$) {
68     my ($input, $result, $out) = @_;
69     my $original_input = $out->input;
70     $out->input ($input);
71 wakaba 1.31
72 wakaba 1.55 $input->generate_info_section ($result);
73    
74 wakaba 1.54 $input->generate_transfer_sections ($result);
75 wakaba 1.31
76 wakaba 1.55 unless (defined $input->{s}) {
77     $result->{conforming_min} = 0;
78     return;
79     }
80 wakaba 1.31
81 wakaba 1.53 my $checker_class = {
82     'text/cache-manifest' => 'WebHACC::Language::CacheManifest',
83     'text/css' => 'WebHACC::Language::CSS',
84     'text/html' => 'WebHACC::Language::HTML',
85     'text/x-webidl' => 'WebHACC::Language::WebIDL',
86    
87     'text/xml' => 'WebHACC::Language::XML',
88     'application/atom+xml' => 'WebHACC::Language::XML',
89     'application/rss+xml' => 'WebHACC::Language::XML',
90     'image/svg+xml' => 'WebHACC::Language::XML',
91     'application/xhtml+xml' => 'WebHACC::Language::XML',
92     'application/xml' => 'WebHACC::Language::XML',
93     ## TODO: Should we make all XML MIME Types fall
94     ## into this category?
95    
96     ## NOTE: This type has different model from normal XML types.
97     'application/rdf+xml' => 'WebHACC::Language::XML',
98     }->{$input->{media_type}} || 'WebHACC::Language::Default';
99    
100     eval qq{ require $checker_class } or die "$0: Loading $checker_class: $@";
101     my $checker = $checker_class->new;
102     $checker->input ($input);
103     $checker->output ($out);
104     $checker->result ($result);
105    
106     ## TODO: A cache manifest MUST be text/cache-manifest
107     ## TODO: WebIDL media type "text/x-webidl"
108    
109     $checker->generate_syntax_error_section;
110     $checker->generate_source_string_section;
111    
112 wakaba 1.55 my @subdoc;
113 wakaba 1.53 $checker->onsubdoc (sub {
114     push @subdoc, shift;
115     });
116    
117     $checker->generate_structure_dump_section;
118     $checker->generate_structure_error_section;
119     $checker->generate_additional_sections;
120    
121     =pod
122 wakaba 1.31
123     if (defined $doc or defined $el) {
124 wakaba 1.53
125 wakaba 1.33 print_listing_section ({
126     id => 'identifiers', label => 'IDs', heading => 'Identifiers',
127     }, $input, $elements->{id}) if keys %{$elements->{id}};
128     print_listing_section ({
129     id => 'terms', label => 'Terms', heading => 'Terms',
130     }, $input, $elements->{term}) if keys %{$elements->{term}};
131     print_listing_section ({
132     id => 'classes', label => 'Classes', heading => 'Classes',
133     }, $input, $elements->{class}) if keys %{$elements->{class}};
134 wakaba 1.53
135 wakaba 1.45 print_rdf_section ($input, $elements->{rdf}) if @{$elements->{rdf}};
136 wakaba 1.31 }
137 wakaba 1.34
138 wakaba 1.53 =cut
139    
140 wakaba 1.34 my $id_prefix = 0;
141 wakaba 1.53 for my $_subinput (@subdoc) {
142 wakaba 1.55 my $subinput = WebHACC::Input::Subdocument->new (++$id_prefix);
143 wakaba 1.53 $subinput->{$_} = $_subinput->{$_} for keys %$_subinput;
144 wakaba 1.34 $subinput->{base_uri} = $subinput->{container_node}->base_uri
145     unless defined $subinput->{base_uri};
146 wakaba 1.55 $subinput->{parent_input} = $input;
147 wakaba 1.34
148 wakaba 1.55 $subinput->start_section ($result);
149 wakaba 1.53 check_and_print ($subinput => $result => $out);
150 wakaba 1.55 $subinput->end_section ($result);
151 wakaba 1.34 }
152 wakaba 1.53
153     $out->input ($original_input);
154 wakaba 1.31 } # check_and_print
155    
156 wakaba 1.45
157 wakaba 1.7 {
158     my $Msg = {};
159    
160     sub load_text_catalog ($) {
161 wakaba 1.53 # my $self = shift;
162 wakaba 1.7 my $lang = shift; # MUST be a canonical lang name
163 wakaba 1.26 open my $file, '<:utf8', "cc-msg.$lang.txt"