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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.61 - (show annotations) (download)
Sun Jul 27 10:33:45 2008 UTC (15 years, 9 months ago) by wakaba
Branch: MAIN
Changes since 1.60: +10 -1 lines
++ ChangeLog	27 Jul 2008 10:33:38 -0000
2008-07-27  Wakaba  <wakaba@suika.fam.cx>

	* .htaccess: Files gone.

	* cc-interface.en.html, cc-todo.txt: Removed.

	* cc-about.en.html: New document.

	* cc.cgi: Insert document input section before anything.
	No check performed if no URL is specified and the
	input is empty.

	* error-description-source.xml (WebHACC:Heading): Link
	to cc-about in place of cc-interface.

++ html/WebHACC/Language/ChangeLog	27 Jul 2008 10:31:14 -0000
2008-07-27  Wakaba  <wakaba@suika.fam.cx>

	* CSS.pm (generate_structure_dump_section): Role name was wrong.

++ html/WebHACC/ChangeLog	27 Jul 2008 10:30:52 -0000
2008-07-27  Wakaba  <wakaba@suika.fam.cx>

	* Output.pm (new, input): |input| attribute should always have an input
	object, even though it might be an empty one.
	(add_source_to_parse_error_list): s/shift/shift ()/ to remove
	ambigiousness warning.
	(select): New method.
	(generate_input_section): New method.

1 #!/usr/bin/perl
2 use strict;
3
4 use lib qw[/home/httpd/html/www/markup/html/whatpm
5 /home/wakaba/work/manakai2/lib];
6 use CGI::Carp qw[fatalsToBrowser];
7
8 require WebHACC::Input;
9
10 {
11 require Message::CGI::HTTP;
12 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 '/') {
20 $out->http_error (404);
21 exit;
22 }
23
24 ## TODO: We need real conneg support...
25 my $primary_language = 'en';
26 if ($ENV{HTTP_ACCEPT_LANGUAGE} =~ /ja/) {
27 $primary_language = 'ja';
28 }
29 $out->load_text_catalog ($primary_language);
30
31 $out->set_flush;
32 $out->http_header;
33 $out->html_header;
34 $out->unset_flush;
35
36 $out->generate_input_section ($http);
37
38 my $u = $http->get_parameter ('uri');
39 my $s = $http->get_parameter ('s');
40 if ((not defined $u or not length $u) and
41 (not defined $s or not length $s)) {
42 exit;
43 }
44
45 require WebHACC::Result;
46 my $result = WebHACC::Result->new;
47 $result->{conforming_min} = 1;
48 $result->{conforming_max} = 1;
49 $result->output ($out);
50
51 require WebHACC::Input;
52 my $input = WebHACC::Input->get_document ($http => $result => $out);
53
54 check_and_print ($input => $result => $out);
55
56 $result->generate_result_section;
57
58 $out->nav_list;
59
60 exit;
61 }
62
63 sub check_and_print ($$$) {
64 my ($input, $result, $out) = @_;
65 my $original_input = $out->input;
66 $out->input ($input);
67
68 $input->generate_info_section ($result);
69
70 $input->generate_transfer_sections ($result);
71
72 unless (defined $input->{s}) {
73 $result->{conforming_min} = 0;
74 return;
75 }
76
77 my $checker_class = {
78 'text/cache-manifest' => 'WebHACC::Language::CacheManifest',
79 'text/css' => 'WebHACC::Language::CSS',
80 'text/html' => 'WebHACC::Language::HTML',
81 'text/x-webidl' => 'WebHACC::Language::WebIDL',
82
83 'text/xml' => 'WebHACC::Language::XML',
84 'application/atom+xml' => 'WebHACC::Language::XML',
85 'application/rss+xml' => 'WebHACC::Language::XML',
86 'image/svg+xml' => 'WebHACC::Language::XML',
87 'application/xhtml+xml' => 'WebHACC::Language::XML',
88 'application/xml' => 'WebHACC::Language::XML',
89 ## TODO: Should we make all XML MIME Types fall
90 ## into this category?
91
92 ## NOTE: This type has different model from normal XML types.
93 'application/rdf+xml' => 'WebHACC::Language::XML',
94 }->{$input->{media_type}} || 'WebHACC::Language::Default';
95
96 eval qq{ require $checker_class } or die "$0: Loading $checker_class: $@";
97 my $checker = $checker_class->new;
98 $checker->input ($input);
99 $checker->output ($out);
100 $checker->result ($result);
101
102 ## TODO: A cache manifest MUST be text/cache-manifest
103 ## TODO: WebIDL media type "text/x-webidl"
104
105 $checker->generate_syntax_error_section;
106 $checker->generate_source_string_section;
107
108 my @subdoc;
109 $checker->onsubdoc (sub {
110 push @subdoc, shift;
111 });
112
113 $checker->generate_structure_dump_section;
114 $checker->generate_structure_error_section;
115 $checker->generate_additional_sections;
116
117 my $id_prefix = 0;
118 for my $_subinput (@subdoc) {
119 my $subinput = WebHACC::Input::Subdocument->new (++$id_prefix);
120 $subinput->{$_} = $_subinput->{$_} for keys %$_subinput;
121 $subinput->{base_uri} = $subinput->{container_node}->base_uri
122 unless defined $subinput->{base_uri};
123 $subinput->{parent_input} = $input;
124
125 $subinput->start_section ($result);
126 check_and_print ($subinput => $result => $out);
127 $subinput->end_section ($result);
128 }
129
130 $out->input ($original_input);
131 } # check_and_print
132
133 =head1 AUTHOR
134
135 Wakaba <w@suika.fam.cx>.
136
137 =head1 LICENSE
138
139 Copyright 2007-2008 Wakaba <w@suika.fam.cx>
140
141 This library is free software; you can redistribute it
142 and/or modify it under the same terms as Perl itself.
143
144 =cut
145
146 ## $Date: 2008/07/26 11:27:25 $

admin@suikawiki.org
ViewVC Help
Powered by ViewVC 1.1.24