/[suikacvs]/test/html-whatpm/parser-manakai.cgi
Suika

Contents of /test/html-whatpm/parser-manakai.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.6 - (hide annotations) (download)
Sat Aug 11 13:54:55 2007 UTC (17 years, 2 months ago) by wakaba
Branch: MAIN
Changes since 1.5: +7 -9 lines
++ ChangeLog	11 Aug 2007 13:54:20 -0000
2007-08-11  Wakaba  <wakaba@suika.fam.cx>

	* cc.cgi, parser-manakai.cgi, parser.cgi: Use |Message::CGI::HTTP|
	instead of |SuikaWiki::Input::HTTP|.

2007-08-05  Wakaba  <wakaba@suika.fam.cx>

	* cc-interface.en.html: IMT |application/atom+xml| is added.
	Link to |cc-todo| is added.

2007-07-24  Wakaba  <wakaba@suika.fam.cx>

	* error-description.xml: Description for "after body", "bare etago",
	and "bogus end tag" are added.

1 wakaba 1.3 #!/usr/bin/perl
2 wakaba 1.1 use strict;
3    
4     use lib qw[/home/httpd/html/www/markup/html/whatpm
5 wakaba 1.6 /home/wakaba/work/manakai2/lib];
6 wakaba 1.1 use CGI::Carp qw[fatalsToBrowser];
7     use Time::HiRes qw/time/;
8    
9 wakaba 1.6 use Message::CGI::HTTP;
10     my $http = Message::CGI::HTTP->new;
11 wakaba 1.1
12     ## TODO: _charset_
13    
14 wakaba 1.6 my @mode = split m#/#, scalar $http->get_meta_variable ('PATH_INFO'), -1;
15 wakaba 1.2 shift @mode if @mode and $mode[0] == '';
16 wakaba 1.1 ## TODO: decode unreserved characters
17    
18 wakaba 1.6 my $s = $http->get_parameter ('s');
19 wakaba 1.1 if (length $s > 1000_000) {
20     print STDOUT "Status: 400 Document Too Long\nContent-Type: text/plain; charset=us-ascii\n\nToo long";
21     exit;
22     }
23     my $char_length = length $s;
24     my %time;
25     my $time1;
26     my $time2;
27    
28     require Message::DOM::DOMImplementation;
29 wakaba 1.4 my $dom = Message::DOM::DOMImplementation->new;
30 wakaba 1.2 # $| = 1;
31 wakaba 1.1 my $doc;
32 wakaba 1.2 my $el;
33 wakaba 1.1
34 wakaba 1.2 if (@mode == 3 and $mode[0] eq 'html' and
35     ($mode[2] eq 'html' or $mode[2] eq 'test')) {
36 wakaba 1.1 print STDOUT "Content-Type: text/plain; charset=utf-8\n\n";
37    
38     require Encode;
39     require Whatpm::HTML;
40    
41     $time1 = time;
42     $s = Encode::decode ('utf-8', $s);
43     $time2 = time;
44     $time{decode} = $time2 - $time1;
45    
46    
47     print STDOUT "#errors\n";
48    
49     my $onerror = sub {
50     my (%opt) = @_;
51     print STDOUT "$opt{line},$opt{column},$opt{type}\n";
52     };
53    
54 wakaba 1.2 $doc = $dom->create_document;
55 wakaba 1.4 $doc->manakai_is_html (1);
56 wakaba 1.1 $time1 = time;
57 wakaba 1.2 if (length $mode[1]) {
58     $el = $doc->create_element_ns
59     ('http://www.w3.org/1999/xhtml', [undef, $mode[1]]);
60     Whatpm::HTML->set_inner_html ($el, $s, $onerror);
61     } else {
62     Whatpm::HTML->parse_string ($s => $doc, $onerror);
63     }
64 wakaba 1.1 $time2 = time;
65     $time{parse} = $time2 - $time1;
66    
67     print "#document\n";
68    
69     my $out;
70 wakaba 1.2 if ($mode[2] eq 'html') {
71     $time1 = time;
72 wakaba 1.4 $out = \( ($el or $doc)->inner_html );
73 wakaba 1.2 $time2 = time;
74     $time{serialize_html} = $time2 - $time1;
75 wakaba 1.1 } else { # test
76 wakaba 1.2 $time1 = time;
77     $out = test_serialize ($el || $doc);
78     $time2 = time;
79     $time{serialize_test} = $time2 - $time1;
80 wakaba 1.1 }
81     print STDOUT Encode::encode ('utf-8', $$out);
82     print STDOUT "\n";
83 wakaba 1.2 } elsif (@mode == 3 and $mode[0] eq 'xhtml' and
84     ($mode[2] eq 'html' or $mode[2] eq 'test')) {
85 wakaba 1.1 print STDOUT "Content-Type: text/plain; charset=utf-8\n\n";
86    
87     require Message::DOM::XMLParserTemp;
88     print STDOUT "#errors\n";
89    
90     my $onerror = sub {
91     my $err = shift;
92     print STDOUT $err->location->line_number, ",";
93 wakaba 1.2 print STDOUT $err->location->column_number, ",";
94 wakaba 1.1 print STDOUT $err->text, "\n";
95     return 1;
96     };
97    
98     open my $fh, '<', \$s;
99     my $time1 = time;
100     $doc = Message::DOM::XMLParserTemp->parse_byte_stream
101     ($fh => $dom, $onerror, charset => 'utf-8');
102     my $time2 = time;
103     $time{parse_xml} = $time2 - $time1;
104    
105     print "#document\n";
106    
107     my $out;
108 wakaba 1.2 if ($mode[2] eq 'html') {
109 wakaba 1.4 $time1 = time;
110     $out = \( $doc->inner_html ); ## TODO: $el case
111     $time2 = time;
112     $time{serialize_xml} = $time2 - $time1;
113 wakaba 1.1 } else { # test
114     $time1 = time;
115     $out = test_serialize ($doc);
116     $time2 = time;
117     $time{serialize_test} = $time2 - $time1;
118     }
119     print STDOUT Encode::encode ('utf-8', $$out);
120     print STDOUT "\n";
121 wakaba 1.5 } elsif (@mode == 3 and $mode[0] eq 'h2h' and $mode[1] eq '' and
122     ($mode[2] eq 'html' or $mode[2] eq 'test')) {
123     print STDOUT "Content-Type: text/plain; charset=utf-8\n\n";
124    
125     require Encode;
126     $time1 = time;
127     $s = Encode::decode ('utf-8', $s);
128     $time2 = time;
129     $time{decode} = $time2 - $time1;
130    
131     require Whatpm::H2H;
132     $doc = $dom->create_document;
133     Whatpm::H2H->parse_string ($s => $doc);
134    
135     print "#document\n";
136    
137     my $out;
138     if ($mode[2] eq 'html') {
139     $time1 = time;
140     $out = \( $doc->inner_html );
141     $time2 = time;
142     $time{serialize_xml} = $time2 - $time1;
143     } else { # test
144     $time1 = time;
145     $out = test_serialize ($doc);
146     $time2 = time;
147     $time{serialize_test} = $time2 - $time1;
148     }
149     print STDOUT Encode::encode ('utf-8', $$out);
150     print STDOUT "\n";
151 wakaba 1.1 } else {
152     print STDOUT "Status: 404 Not Found\nContent-Type: text/plain; charset=us-ascii\n\n404";
153     exit;
154     }
155    
156 wakaba 1.6 if ($http->get_parameter ('dom5')) {
157 wakaba 1.1 require Whatpm::ContentChecker;
158 wakaba 1.2 my $onerror = sub {
159     my %opt = @_;
160     print STDOUT get_node_path ($opt{node}) . ';' . $opt{type} . "\n";
161     };
162 wakaba 1.1 print STDOUT "#domerrors\n";
163     $time1 = time;
164 wakaba 1.2 if ($el) {
165     Whatpm::ContentChecker->check_element ($el, $onerror);
166     } else {
167     Whatpm::ContentChecker->check_document ($doc, $onerror);
168     }
169 wakaba 1.1 $time2 = time;
170     $time{check} = $time2 - $time1;
171     }
172    
173     print STDOUT "#log\n";
174     for (qw/decode parse parse_xml serialize_html serialize_xml serialize_test
175     check/) {
176     next unless defined $time{$_};
177     print STDOUT {
178     decode => 'bytes->chars',
179     parse => 'html5(chars)->dom5',
180     parse_xml => 'xml1(chars)->dom5',
181 wakaba 1.2 serialize_html => 'dom5->html5(char)',
182     serialize_xml => 'dom5->xml1(char)',
183     serialize_test => 'dom5->test(char)',
184 wakaba 1.1 check => 'dom5 check',
185     }->{$_};
186     print STDOUT "\t", $time{$_}, "s\n";
187     open my $file, '>>', ".manakai-$_.txt" or die ".manakai-$_.txt: $!";
188     print $file $char_length, "\t", $time{$_}, "\n";
189     }
190    
191     exit;
192    
193     sub test_serialize ($) {
194     my $node = shift;
195     my $r = '';
196    
197     my @node = map { [$_, ''] } @{$node->child_nodes};
198     while (@node) {
199     my $child = shift @node;
200     my $nt = $child->[0]->node_type;
201     if ($nt == $child->[0]->ELEMENT_NODE) {
202     $r .= '| ' . $child->[1] . '<' . $child->[0]->tag_name . ">\x0A"; ## ISSUE: case?
203    
204     for my $attr (sort {$a->[0] cmp $b->[0]} map { [$_->name, $_->value] }
205     @{$child->[0]->attributes}) {
206     $r .= '| ' . $child->[1] . ' ' . $attr->[0] . '="'; ## ISSUE: case?
207     $r .= $attr->[1] . '"' . "\x0A";
208     }
209    
210     unshift @node,
211     map { [$_, $child->[1] . ' '] } @{$child->[0]->child_nodes};
212     } elsif ($nt == $child->[0]->TEXT_NODE) {
213     $r .= '| ' . $child->[1] . '"' . $child->[0]->data . '"' . "\x0A";
214     } elsif ($nt == $child->[0]->CDATA_SECTION_NODE) {
215     $r .= '| ' . $child->[1] . '<![CDATA[' . $child->[0]->data . "]]>\x0A";
216     } elsif ($nt == $child->[0]->COMMENT_NODE) {
217     $r .= '| ' . $child->[1] . '<!-- ' . $child->[0]->data . " -->\x0A";
218     } elsif ($nt == $child->[0]->DOCUMENT_TYPE_NODE) {
219     $r .= '| ' . $child->[1] . '<!DOCTYPE ' . $child->[0]->name . ">\x0A";
220     } elsif ($nt == $child->[0]->PROCESSING_INSTRUCTION_NODE) {
221     $r .= '| ' . $child->[1] . '<?' . $child->[0]->target . ' ' .
222     $child->[0]->data . "?>\x0A";
223     } else {
224     $r .= '| ' . $child->[1] . $child->[0]->node_type . "\x0A"; # error
225     }
226     }
227    
228     return \$r;
229     } # test_serialize
230    
231     sub get_node_path ($) {
232     my $node = shift;
233     my @r;
234     while (defined $node) {
235     my $rs;
236     if ($node->node_type == 1) {
237     $rs = $node->manakai_local_name;
238     $node = $node->parent_node;
239     } elsif ($node->node_type == 2) {
240     $rs = '@' . $node->manakai_local_name;
241     $node = $node->owner_element;
242     } elsif ($node->node_type == 3) {
243     $rs = '"' . $node->data . '"';
244     $node = $node->parent_node;
245     } elsif ($node->node_type == 9) {
246     $rs = '';
247     $node = $node->parent_node;
248     } else {
249     $rs = '#' . $node->node_type;
250     $node = $node->parent_node;
251     }
252     unshift @r, $rs;
253     }
254     return join '/', @r;
255     } # get_node_path
256    
257     =head1 AUTHOR
258    
259     Wakaba <w@suika.fam.cx>.
260    
261     =head1 LICENSE
262    
263     Copyright 2007 Wakaba <w@suika.fam.cx>
264    
265     This library is free software; you can redistribute it
266     and/or modify it under the same terms as Perl itself.
267    
268     =cut
269    
270 wakaba 1.6 ## $Date: 2007/07/15 07:53:00 $

admin@suikawiki.org
ViewVC Help
Powered by ViewVC 1.1.24