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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.4 - (hide annotations) (download)
Wed Jun 27 14:36:45 2007 UTC (19 years ago) by wakaba
Branch: MAIN
Changes since 1.3: +31 -30 lines
Style sheet

1 wakaba 1.1 #!/usr/bin/perl
2     use strict;
3    
4     use lib qw[/home/httpd/html/www/markup/html/whatpm
5     /home/wakaba/work/manakai/lib
6     /home/wakaba/public_html/-temp/wiki/lib];
7     use CGI::Carp qw[fatalsToBrowser];
8 wakaba 1.2 use Scalar::Util qw[refaddr];
9 wakaba 1.1
10     use SuikaWiki::Input::HTTP; ## TODO: Use some better CGI module
11    
12 wakaba 1.2 sub htescape ($) {
13     my $s = $_[0];
14     $s =~ s/&/&/g;
15     $s =~ s/</&lt;/g;
16     $s =~ s/>/&gt;/g;
17     $s =~ s/"/&quot;/g;
18     $s =~ s!([\x00-\x09\x0B-\x1F\x7F-\x80])!sprintf '<var>U+%04X</var>', ord $1!ge;
19     return $s;
20     } # htescape
21    
22 wakaba 1.1 my $http = SuikaWiki::Input::HTTP->new;
23    
24     ## TODO: _charset_
25    
26 wakaba 1.2 my $input_format = $http->parameter ('i') || 'text/html';
27     my $inner_html_element = $http->parameter ('e');
28     my $input_uri = 'thismessage:/';
29 wakaba 1.1
30     my $s = $http->parameter ('s');
31     if (length $s > 1000_000) {
32     print STDOUT "Status: 400 Document Too Long\nContent-Type: text/plain; charset=us-ascii\n\nToo long";
33     exit;
34     }
35 wakaba 1.2
36 wakaba 1.3 my @nav;
37 wakaba 1.2 print STDOUT qq[Content-Type: text/html; charset=utf-8
38    
39     <!DOCTYPE html>
40     <html lang="en">
41     <head>
42     <title>Web Document Conformance Checker (BETA)</title>
43 wakaba 1.3 <link rel="stylesheet" href="../cc-style.css" type="text/css">
44 wakaba 1.2 </head>
45     <body>
46     <h1>Web Document Conformance Checker (<em>beta</em>)</h1>
47    
48 wakaba 1.4 <div id="document-info" class="section">
49 wakaba 1.2 <dl>
50     <dt>Document URI</dt>
51     <dd><code class="URI" lang="">&lt;<a href="@{[htescape $input_uri]}">@{[htescape $input_uri]}</a>&gt;</code></dd>
52     <dt>Internet Media Type</dt>
53     <dd><code class="MIME" lang="en">@{[htescape $input_format]}</code></dd>
54     ]; # no </dl> yet
55 wakaba 1.3 push @nav, ['#document-info' => 'Information'];
56 wakaba 1.1
57     require Message::DOM::DOMImplementation;
58     my $dom = Message::DOM::DOMImplementation->____new;
59     my $doc;
60     my $el;
61    
62 wakaba 1.2 if ($input_format eq 'text/html') {
63     require Encode;
64     require Whatpm::HTML;
65    
66     $s = Encode::decode ('utf-8', $s);
67    
68     print STDOUT qq[
69     <dt>Character Encoding</dt>
70     <dd>(none)</dd>
71     </dl>
72 wakaba 1.3 </div>
73 wakaba 1.2
74     <div id="source-string" class="section">
75 wakaba 1.3 <h2>Document Source</h2>
76 wakaba 1.2 ];
77 wakaba 1.3 push @nav, ['#source-string' => 'Source'];
78 wakaba 1.2 print_source_string (\$s);
79     print STDOUT qq[
80     </div>
81 wakaba 1.1
82 wakaba 1.2 <div id="parse-errors" class="section">
83     <h2>Parse Errors</h2>
84    
85 wakaba 1.4 <dl>
86 wakaba 1.2 ];
87 wakaba 1.3 push @nav, ['#parse-errors' => 'Parse Error'];
88 wakaba 1.1
89     my $onerror = sub {
90     my (%opt) = @_;
91 wakaba 1.2 if ($opt{column} > 0) {
92 wakaba 1.4 print STDOUT qq[<dt><a href="#line-$opt{line}">Line $opt{line}</a> column $opt{column}</dt>\n];
93 wakaba 1.2 } else {
94     $opt{line}--;
95 wakaba 1.4 print STDOUT qq[<dt><a href="#line-$opt{line}">Line $opt{line}</a></dt>\n];
96 wakaba 1.2 }
97 wakaba 1.4 print STDOUT qq[<dd>@{[htescape $opt{type}]}</dd>\n];
98 wakaba 1.1 };
99    
100     $doc = $dom->create_document;
101 wakaba 1.2 if (defined $inner_html_element and length $inner_html_element) {
102 wakaba 1.1 $el = $doc->create_element_ns
103 wakaba 1.2 ('http://www.w3.org/1999/xhtml', [undef, $inner_html_element]);
104 wakaba 1.1 Whatpm::HTML->set_inner_html ($el, $s, $onerror);
105     } else {
106     Whatpm::HTML->parse_string ($s => $doc, $onerror);
107     }
108    
109 wakaba 1.2 print STDOUT qq[
110 wakaba 1.4 </dl>
111 wakaba 1.2 </div>
112     ];
113     } elsif ($input_format eq 'application/xhtml+xml') {
114     require Message::DOM::XMLParserTemp;
115     require Encode;
116    
117   &nb