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

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

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.15 by wakaba, Sat Jul 21 04:58:17 2007 UTC revision 1.37 by wakaba, Sun Feb 24 02:17:51 2008 UTC
# Line 1  Line 1 
1  #!/usr/bin/perl  #!/usr/bin/perl
2  use strict;  use strict;
3    use utf8;
4    
5  use lib qw[/home/httpd/html/www/markup/html/whatpm  use lib qw[/home/httpd/html/www/markup/html/whatpm
6             /home/wakaba/work/manakai/lib             /home/wakaba/work/manakai2/lib];
            /home/wakaba/public_html/-temp/wiki/lib];  
7  use CGI::Carp qw[fatalsToBrowser];  use CGI::Carp qw[fatalsToBrowser];
8  use Scalar::Util qw[refaddr];  use Scalar::Util qw[refaddr];
9    use Time::HiRes qw/time/;
 use SuikaWiki::Input::HTTP; ## TODO: Use some better CGI module  
10    
11  sub htescape ($) {  sub htescape ($) {
12    my $s = $_[0];    my $s = $_[0];
# Line 21  sub htescape ($) { Line 20  sub htescape ($) {
20    return $s;    return $s;
21  } # htescape  } # htescape
22    
23  my $http = SuikaWiki::Input::HTTP->new;    my @nav;
24      my %time;
25  ## TODO: _charset_    require Message::DOM::DOMImplementation;
26      my $dom = Message::DOM::DOMImplementation->new;
27    {
28      use Message::CGI::HTTP;
29      my $http = Message::CGI::HTTP->new;
30    
31    if ($http->meta_variable ('PATH_INFO') ne '/') {    if ($http->get_meta_variable ('PATH_INFO') ne '/') {
32      print STDOUT "Status: 404 Not Found\nContent-Type: text/plain; charset=us-ascii\n\n400";      print STDOUT "Status: 404 Not Found\nContent-Type: text/plain; charset=us-ascii\n\n400";
33      exit;      exit;
34    }    }
# Line 33  my $http = SuikaWiki::Input::HTTP->new; Line 36  my $http = SuikaWiki::Input::HTTP->new;
36    binmode STDOUT, ':utf8';    binmode STDOUT, ':utf8';
37    $| = 1;    $| = 1;
38    
   require Message::DOM::DOMImplementation;  
   my $dom = Message::DOM::DOMImplementation->new;  
   
39    load_text_catalog ('en'); ## TODO: conneg    load_text_catalog ('en'); ## TODO: conneg
40    
   my @nav;  
41    print STDOUT qq[Content-Type: text/html; charset=utf-8    print STDOUT qq[Content-Type: text/html; charset=utf-8
42    
43  <!DOCTYPE html>  <!DOCTYPE html>
# Line 54  my $http = SuikaWiki::Input::HTTP->new; Line 53  my $http = SuikaWiki::Input::HTTP->new;
53    
54    $| = 0;    $| = 0;
55    my $input = get_input_document ($http, $dom);    my $input = get_input_document ($http, $dom);
56    my $inner_html_element = $http->parameter ('e');    my $char_length = 0;
57    
58    print qq[    print qq[
59  <div id="document-info" class="section">  <div id="document-info" class="section">
# Line 62  my $http = SuikaWiki::Input::HTTP->new; Line 61  my $http = SuikaWiki::Input::HTTP->new;
61  <dt>Request URI</dt>  <dt>Request URI</dt>
62      <dd><code class="URI" lang="">&lt;<a href="@{[htescape $input->{request_uri}]}">@{[htescape $input->{request_uri}]}</a>&gt;</code></dd>      <dd><code class="URI" lang="">&lt;<a href="@{[htescape $input->{request_uri}]}">@{[htescape $input->{request_uri}]}</a>&gt;</code></dd>
63  <dt>Document URI</dt>  <dt>Document URI</dt>
64      <dd><code class="URI" lang="">&lt;<a href="@{[htescape $input->{uri}]}">@{[htescape $input->{uri}]}</a>&gt;</code></dd>      <dd><code class="URI" lang="">&lt;<a href="@{[htescape $input->{uri}]}" id=anchor-document-uri>@{[htescape $input->{uri}]}</a>&gt;</code>
65        <script>
66          document.title = '<'
67              + document.getElementById ('anchor-document-uri').href + '> \\u2014 '
68              + document.title;
69        </script></dd>
70  ]; # no </dl> yet  ]; # no </dl> yet
71    push @nav, ['#document-info' => 'Information'];    push @nav, ['#document-info' => 'Information'];
72    
73  if (defined $input->{s}) {  if (defined $input->{s}) {
74      $char_length = length $input->{s};
75    
76    print STDOUT qq[    print STDOUT qq[
77  <dt>Base URI</dt>  <dt>Base URI</dt>
78      <dd><code class="URI" lang="">&lt;<a href="@{[htescape $input->{base_uri}]}">@{[htescape $input->{base_uri}]}</a>&gt;</code></dd>      <dd><code class="URI" lang="">&lt;<a href="@{[htescape $input->{base_uri}]}">@{[htescape $input->{base_uri}]}</a>&gt;</code></dd>
79  <dt>Internet Media Type</dt>  <dt>Internet Media Type</dt>
80      <dd><code class="MIME" lang="en">@{[htescape $input->{media_type}]}</code>      <dd><code class="MIME" lang="en">@{[htescape $input->{media_type}]}</code>
81      @{[$input->{media_type_overridden} ? '<em>(overridden)</em>' : '']}</dd>      @{[$input->{media_type_overridden} ? '<em>(overridden)</em>' : defined $input->{official_type} ? $input->{media_type} eq $input->{official_type} ? '' : '<em>(sniffed; official type is: <code class=MIME lang=en>'.htescape ($input->{official_type}).'</code>)' : '<em>(sniffed)</em>']}</dd>
82  <dt>Character Encoding</dt>  <dt>Character Encoding</dt>
83      <dd>@{[defined $input->{charset} ? '<code class="charset" lang="en">'.htescape ($input->{charset}).'</code>' : '(none)']}      <dd>@{[defined $input->{charset} ? '<code class="charset" lang="en">'.htescape ($input->{charset}).'</code>' : '(none)']}
84      @{[$input->{charset_overridden} ? '<em>(overridden)</em>' : '']}</dd>      @{[$input->{charset_overridden} ? '<em>(overridden)</em>' : '']}</dd>
85    <dt>Length</dt>
86        <dd>$char_length byte@{[$char_length == 1 ? '' : 's']}</dd>
87  </dl>  </dl>
88  </div>  </div>
89  ];  ];
90    
91    print_http_header_section ($input);    $input->{id_prefix} = '';
92      #$input->{nested} = 0;
93      my $result = {conforming_min => 1, conforming_max => 1};
94      check_and_print ($input => $result);
95      print_result_section ($result);
96    } else {
97      print STDOUT qq[</dl></div>];
98      print_result_input_error_section ($input);
99    }
100    
101      print STDOUT qq[
102    <ul class="navigation" id="nav-items">
103    ];
104      for (@nav) {
105        print STDOUT qq[<li><a href="$_->[0]">$_->[1]</a></li>];
106      }
107      print STDOUT qq[
108    </ul>
109    </body>
110    </html>
111    ];
112    
113      for (qw/decode parse parse_html parse_xml parse_manifest
114              check check_manifest/) {
115        next unless defined $time{$_};
116        open my $file, '>>', ".cc-$_.txt" or die ".cc-$_.txt: $!";
117        print $file $char_length, "\t", $time{$_}, "\n";
118      }
119    
120    exit;
121    }
122    
123    sub add_error ($$$) {
124      my ($layer, $err, $result) = @_;
125      if (defined $err->{level}) {
126        if ($err->{level} eq 's') {
127          $result->{$layer}->{should}++;
128          $result->{$layer}->{score_min} -= 2;
129          $result->{conforming_min} = 0;
130        } elsif ($err->{level} eq 'w' or $err->{level} eq 'g') {
131          $result->{$layer}->{warning}++;
132        } elsif ($err->{level} eq 'u' or $err->{level} eq 'unsupported') {
133          $result->{$layer}->{unsupported}++;
134          $result->{unsupported} = 1;
135        } elsif ($err->{level} eq 'i') {
136          #
137        } else {
138          $result->{$layer}->{must}++;
139          $result->{$layer}->{score_max} -= 2;
140          $result->{$layer}->{score_min} -= 2;
141          $result->{conforming_min} = 0;
142          $result->{conforming_max} = 0;
143        }
144      } else {
145        $result->{$layer}->{must}++;
146        $result->{$layer}->{score_max} -= 2;
147        $result->{$layer}->{score_min} -= 2;
148        $result->{conforming_min} = 0;
149        $result->{conforming_max} = 0;
150      }
151    } # add_error
152    
153    sub check_and_print ($$) {
154      my ($input, $result) = @_;
155    
156      print_http_header_section ($input, $result);
157    
158    my $doc;    my $doc;
159    my $el;    my $el;
160      my $cssom;
161      my $manifest;
162      my @subdoc;
163    
164    if ($input->{media_type} eq 'text/html') {    if ($input->{media_type} eq 'text/html') {
165      require Encode;      ($doc, $el) = print_syntax_error_html_section ($input, $result);
166      require Whatpm::HTML;      print_source_string_section
167            ($input,
168             \($input->{s}),
169             $input->{charset} || $doc->input_encoding);
170      } elsif ({
171                'text/xml' => 1,
172                'application/atom+xml' => 1,
173                'application/rss+xml' => 1,
174                'application/svg+xml' => 1,
175                'application/xhtml+xml' => 1,
176                'application/xml' => 1,
177               }->{$input->{media_type}}) {
178        ($doc, $el) = print_syntax_error_xml_section ($input, $result);
179        print_source_string_section ($input,
180                                     \($input->{s}),
181                                     $doc->input_encoding);
182      } elsif ($input->{media_type} eq 'text/css') {
183        $cssom = print_syntax_error_css_section ($input, $result);
184        print_source_string_section
185            ($input, \($input->{s}),
186             $cssom->manakai_input_encoding);
187      } elsif ($input->{media_type} eq 'text/cache-manifest') {
188    ## TODO: MUST be text/cache-manifest
189        $manifest = print_syntax_error_manifest_section ($input, $result);
190        print_source_string_section ($input, \($input->{s}),
191                                     'utf-8');
192      } else {
193        ## TODO: Change HTTP status code??
194        print_result_unknown_type_section ($input, $result);
195      }
196    
197      $input->{charset} ||= 'ISO-8859-1'; ## TODO: for now.    if (defined $doc or defined $el) {
198            $doc->document_uri ($input->{uri});
199      my $t = Encode::decode ($input->{charset}, $input->{s});      $doc->manakai_entity_base_uri ($input->{base_uri});
200        print_structure_dump_dom_section ($input, $doc, $el);
201        my $elements = print_structure_error_dom_section
202            ($input, $doc, $el, $result, sub {
203              push @subdoc, shift;
204            });
205        print_table_section ($input, $elements->{table}) if @{$elements->{table}};
206        print_listing_section ({
207          id => 'identifiers', label => 'IDs', heading => 'Identifiers',
208        }, $input, $elements->{id}) if keys %{$elements->{id}};
209        print_listing_section ({
210          id => 'terms', label => 'Terms', heading => 'Terms',
211        }, $input, $elements->{term}) if keys %{$elements->{term}};
212        print_listing_section ({
213          id => 'classes', label => 'Classes', heading => 'Classes',
214        }, $input, $elements->{class}) if keys %{$elements->{class}};
215      } elsif (defined $cssom) {
216        print_structure_dump_cssom_section ($input, $cssom);
217        ## TODO: CSSOM validation
218        add_error ('structure', {level => 'u'} => $result);
219      } elsif (defined $manifest) {
220        print_structure_dump_manifest_section ($input, $manifest);
221        print_structure_error_manifest_section ($input, $manifest, $result);
222      }
223    
224      my $id_prefix = 0;
225      for my $subinput (@subdoc) {
226        $subinput->{id_prefix} = 'subdoc-' . ++$id_prefix;
227        $subinput->{nested} = 1;
228        $subinput->{base_uri} = $subinput->{container_node}->base_uri
229            unless defined $subinput->{base_uri};
230        my $ebaseuri = htescape ($subinput->{base_uri});
231        push @nav, ['#' . $subinput->{id_prefix} => 'Sub #' . $id_prefix];
232        print STDOUT qq[<div id="$subinput->{id_prefix}" class=section>
233          <h2>Subdocument #$id_prefix</h2>
234    
235          <dl>
236          <dt>Internet Media Type</dt>
237            <dd><code class="MIME" lang="en">@{[htescape $subinput->{media_type}]}</code>
238          <dt>Container Node</dt>
239            <dd>@{[get_node_link ($input, $subinput->{container_node})]}</dd>
240          <dt>Base <abbr title="Uniform Resource Identifiers">URI</abbr></dt>
241            <dd><code class=URI>&lt;<a href="$ebaseuri">$ebaseuri</a>></code></dd>
242          </dl>];              
243    
244        $subinput->{id_prefix} .= '-';
245        check_and_print ($subinput => $result);
246    
247      print STDOUT qq[      print STDOUT qq[</div>];
248  <div id="parse-errors" class="section">    }
249    } # check_and_print
250    
251    sub print_http_header_section ($$) {
252      my ($input, $result) = @_;
253      return unless defined $input->{header_status_code} or
254          defined $input->{header_status_text} or
255          @{$input->{header_field} or []};
256      
257      push @nav, ['#source-header' => 'HTTP Header'] unless $input->{nested};
258      print STDOUT qq[<div id="$input->{id_prefix}source-header" class="section">
259    <h2>HTTP Header</h2>
260    
261    <p><strong>Note</strong>: Due to the limitation of the
262    network library in use, the content of this section might
263    not be the real header.</p>
264    
265    <table><tbody>
266    ];
267    
268      if (defined $input->{header_status_code}) {
269        print STDOUT qq[<tr><th scope="row">Status code</th>];
270        print STDOUT qq[<td><code>@{[htescape ($input->{header_status_code})]}</code></td></tr>];
271      }
272      if (defined $input->{header_status_text}) {
273        print STDOUT qq[<tr><th scope="row">Status text</th>];
274        print STDOUT qq[<td><code>@{[htescape ($input->{header_status_text})]}</code></td></tr>];
275      }
276      
277      for (@{$input->{header_field}}) {
278        print STDOUT qq[<tr><th scope="row"><code>@{[htescape ($_->[0])]}</code></th>];
279        print STDOUT qq[<td><code>@{[htescape ($_->[1])]}</code></td></tr>];
280      }
281    
282      print STDOUT qq[</tbody></table></div>];
283    } # print_http_header_section
284    
285    sub print_syntax_error_html_section ($$) {
286      my ($input, $result) = @_;
287      
288      require Encode;
289      require Whatpm::HTML;
290      
291      print STDOUT qq[
292    <div id="$input->{id_prefix}parse-errors" class="section">
293  <h2>Parse Errors</h2>  <h2>Parse Errors</h2>
294    
295  <dl>];  <dl>];
296    push @nav, ['#parse-errors' => 'Parse Error'];    push @nav, ['#parse-errors' => 'Parse Error'] unless $input->{nested};
297    
298    my $onerror = sub {    my $onerror = sub {
299      my (%opt) = @_;      my (%opt) = @_;
300      my ($type, $cls, $msg) = get_text ($opt{type}, $opt{level});      my ($type, $cls, $msg) = get_text ($opt{type}, $opt{level});
301      if ($opt{column} > 0) {      if ($opt{column} > 0) {
302        print STDOUT qq[<dt class="$cls"><a href="#line-$opt{line}">Line $opt{line}</a> column $opt{column}</dt>\n];        print STDOUT qq[<dt class="$cls"><a href="#$input->{id_prefix}line-$opt{line}">Line $opt{line}</a> column $opt{column}</dt>\n];
303      } else {      } else {
304        $opt{line} = $opt{line} - 1 || 1;        $opt{line} = $opt{line} - 1 || 1;
305        print STDOUT qq[<dt class="$cls"><a href="#line-$opt{line}">Line $opt{line}</a></dt>\n];        print STDOUT qq[<dt class="$cls"><a href="#$input->{id_prefix}line-$opt{line}">Line $opt{line}</a></dt>\n];
306      }      }
307      $type =~ tr/ /-/;      $type =~ tr/ /-/;
308      $type =~ s/\|/%7C/g;      $type =~ s/\|/%7C/g;
309      $msg .= qq[ [<a href="../error-description#@{[htescape ($type)]}">Description</a>]];      $msg .= qq[ [<a href="../error-description#@{[htescape ($type)]}">Description</a>]];
310      print STDOUT qq[<dd class="$cls">$msg</dd>\n];      print STDOUT qq[<dd class="$cls">], get_error_level_label (\%opt);
311        print STDOUT qq[$msg</dd>\n];
312    
313        add_error ('syntax', \%opt => $result);
314    };    };
315    
316    $doc = $dom->create_document;    my $doc = $dom->create_document;
317      my $el;
318      my $inner_html_element = $input->{inner_html_element};
319    if (defined $inner_html_element and length $inner_html_element) {    if (defined $inner_html_element and length $inner_html_element) {
320        $input->{charset} ||= 'windows-1252'; ## TODO: for now.
321        my $time1 = time;
322        my $t = Encode::decode ($input->{charset}, $input->{s});
323        $time{decode} = time - $time1;
324        
325      $el = $doc->create_element_ns      $el = $doc->create_element_ns
326          ('http://www.w3.org/1999/xhtml', [undef, $inner_html_element]);          ('http://www.w3.org/1999/xhtml', [undef, $inner_html_element]);
327        $time1 = time;
328      Whatpm::HTML->set_inner_html ($el, $t, $onerror);      Whatpm::HTML->set_inner_html ($el, $t, $onerror);
329        $time{parse} = time - $time1;
330    } else {    } else {
331      Whatpm::HTML->parse_string ($t => $doc, $onerror);      my $time1 = time;
332        Whatpm::HTML->parse_byte_string
333            ($input->{charset}, $input->{s} => $doc, $onerror);
334        $time{parse_html} = time - $time1;
335    }    }
336      $doc->manakai_charset ($input->{official_charset})
337          if defined $input->{official_charset};
338      
339      print STDOUT qq[</dl></div>];
340    
341    print STDOUT qq[</dl>    return ($doc, $el);
342  </div>  } # print_syntax_error_html_section
 ];  
   
     print_source_string_section (\($input->{s}), $input->{charset});  
   } elsif ({  
             'text/xml' => 1,  
             'application/xhtml+xml' => 1,  
             'application/xml' => 1,  
            }->{$input->{media_type}}) {  
     require Message::DOM::XMLParserTemp;  
343    
344      print STDOUT qq[  sub print_syntax_error_xml_section ($$) {
345  <div id="parse-errors" class="section">    my ($input, $result) = @_;
346      
347      require Message::DOM::XMLParserTemp;
348      
349      print STDOUT qq[
350    <div id="$input->{id_prefix}parse-errors" class="section">
351  <h2>Parse Errors</h2>  <h2>Parse Errors</h2>
352    
353  <dl>];  <dl>];
354    push @nav, ['#parse-errors' => 'Parse Error'];    push @nav, ['#parse-errors' => 'Parse Error'] unless $input->{prefix};
355    
356    my $onerror = sub {    my $onerror = sub {
357      my $err = shift;      my $err = shift;
358      my $line = $err->location->line_number;      my $line = $err->location->line_number;
359      print STDOUT qq[<dt><a href="#line-$line">Line $line</a> column ];      print STDOUT qq[<dt><a href="#$input->{id_prefix}line-$line">Line $line</a> column ];
360      print STDOUT $err->location->column_number, "</dt><dd>";      print STDOUT $err->location->column_number, "</dt><dd>";
361      print STDOUT htescape $err->text, "</dd>\n";      print STDOUT htescape $err->text, "</dd>\n";
362    
363        add_error ('syntax', {type => $err->text,
364                    level => [
365                              $err->SEVERITY_FATAL_ERROR => 'm',
366                              $err->SEVERITY_ERROR => 'm',
367                              $err->SEVERITY_WARNING => 's',
368                             ]->[$err->severity]} => $result);
369    
370      return 1;      return 1;
371    };    };
372    
373      my $time1 = time;
374    open my $fh, '<', \($input->{s});    open my $fh, '<', \($input->{s});
375    $doc = Message::DOM::XMLParserTemp->parse_byte_stream    my $doc = Message::DOM::XMLParserTemp->parse_byte_stream
376        ($fh => $dom, $onerror, charset => $input->{charset});        ($fh => $dom, $onerror, charset => $input->{charset});
377      $time{parse_xml} = time - $time1;
378      $doc->manakai_charset ($input->{official_charset})
379          if defined $input->{official_charset};
380    
381      print STDOUT qq[</dl></div>];
382    
383      return ($doc, undef);
384    } # print_syntax_error_xml_section
385    
386    sub get_css_parser () {
387      our $CSSParser;
388      return $CSSParser if $CSSParser;
389    
390      require Whatpm::CSS::Parser;
391      my $p = Whatpm::CSS::Parser->new;
392    
393      $p->{prop}->{$_} = 1 for qw/
394        alignment-baseline
395        background background-attachment background-color background-image
396        background-position background-position-x background-position-y
397        background-repeat border border-bottom border-bottom-color
398        border-bottom-style border-bottom-width border-collapse border-color
399        border-left border-left-color
400        border-left-style border-left-width border-right border-right-color
401        border-right-style border-right-width
402        border-spacing -manakai-border-spacing-x -manakai-border-spacing-y
403        border-style border-top border-top-color border-top-style border-top-width
404        border-width bottom
405        caption-side clear clip color content counter-increment counter-reset
406        cursor direction display dominant-baseline empty-cells float font
407        font-family font-size font-size-adjust font-stretch
408        font-style font-variant font-weight height left
409        letter-spacing line-height
410        list-style list-style-image list-style-position list-style-type
411        margin margin-bottom margin-left margin-right margin-top marker-offset
412        marks max-height max-width min-height min-width opacity -moz-opacity
413        orphans outline outline-color outline-style outline-width overflow
414        overflow-x overflow-y
415        padding padding-bottom padding-left padding-right padding-top
416        page page-break-after page-break-before page-break-inside
417        position quotes right size table-layout
418        text-align text-anchor text-decoration text-indent text-transform
419        top unicode-bidi vertical-align visibility white-space width widows
420        word-spacing writing-mode z-index
421      /;
422      $p->{prop_value}->{display}->{$_} = 1 for qw/
423        block clip inline inline-block inline-table list-item none
424        table table-caption table-cell table-column table-column-group
425        table-header-group table-footer-group table-row table-row-group
426        compact marker
427      /;
428      $p->{prop_value}->{position}->{$_} = 1 for qw/
429        absolute fixed relative static
430      /;
431      $p->{prop_value}->{float}->{$_} = 1 for qw/
432        left right none
433      /;
434      $p->{prop_value}->{clear}->{$_} = 1 for qw/
435        left right none both
436      /;
437      $p->{prop_value}->{direction}->{ltr} = 1;
438      $p->{prop_value}->{direction}->{rtl} = 1;
439      $p->{prop_value}->{marks}->{crop} = 1;
440      $p->{prop_value}->{marks}->{cross} = 1;
441      $p->{prop_value}->{'unicode-bidi'}->{$_} = 1 for qw/
442        normal bidi-override embed
443      /;
444      for my $prop_name (qw/overflow overflow-x overflow-y/) {
445        $p->{prop_value}->{$prop_name}->{$_} = 1 for qw/
446          visible hidden scroll auto -webkit-marquee -moz-hidden-unscrollable
447        /;
448      }
449      $p->{prop_value}->{visibility}->{$_} = 1 for qw/
450        visible hidden collapse
451      /;
452      $p->{prop_value}->{'list-style-type'}->{$_} = 1 for qw/
453        disc circle square decimal decimal-leading-zero
454        lower-roman upper-roman lower-greek lower-latin
455        upper-latin armenian georgian lower-alpha upper-alpha none
456        hebrew cjk-ideographic hiragana katakana hiragana-iroha
457        katakana-iroha
458      /;
459      $p->{prop_value}->{'list-style-position'}->{outside} = 1;
460      $p->{prop_value}->{'list-style-position'}->{inside} = 1;
461      $p->{prop_value}->{'page-break-before'}->{$_} = 1 for qw/
462        auto always avoid left right
463      /;
464      $p->{prop_value}->{'page-break-after'}->{$_} = 1 for qw/
465        auto always avoid left right
466      /;
467      $p->{prop_value}->{'page-break-inside'}->{auto} = 1;
468      $p->{prop_value}->{'page-break-inside'}->{avoid} = 1;
469      $p->{prop_value}->{'background-repeat'}->{$_} = 1 for qw/
470        repeat repeat-x repeat-y no-repeat
471      /;
472      $p->{prop_value}->{'background-attachment'}->{scroll} = 1;
473      $p->{prop_value}->{'background-attachment'}->{fixed} = 1;
474      $p->{prop_value}->{'font-size'}->{$_} = 1 for qw/
475        xx-small x-small small medium large x-large xx-large
476        -manakai-xxx-large -webkit-xxx-large
477        larger smaller
478      /;
479      $p->{prop_value}->{'font-style'}->{normal} = 1;
480      $p->{prop_value}->{'font-style'}->{italic} = 1;
481      $p->{prop_value}->{'font-style'}->{oblique} = 1;
482      $p->{prop_value}->{'font-variant'}->{normal} = 1;
483      $p->{prop_value}->{'font-variant'}->{'small-caps'} = 1;
484      $p->{prop_value}->{'font-stretch'}->{$_} = 1 for
485          qw/normal wider narrower ultra-condensed extra-condensed
486            condensed semi-condensed semi-expanded expanded
487            extra-expanded ultra-expanded/;
488      $p->{prop_value}->{'text-align'}->{$_} = 1 for qw/
489        left right center justify begin end
490      /;
491      $p->{prop_value}->{'text-transform'}->{$_} = 1 for qw/
492        capitalize uppercase lowercase none
493      /;
494      $p->{prop_value}->{'white-space'}->{$_} = 1 for qw/
495        normal pre nowrap pre-line pre-wrap -moz-pre-wrap
496      /;
497      $p->{prop_value}->{'writing-mode'}->{$_} = 1 for qw/
498        lr rl tb lr-tb rl-tb tb-rl
499      /;
500      $p->{prop_value}->{'text-anchor'}->{$_} = 1 for qw/
501        start middle end
502      /;
503      $p->{prop_value}->{'dominant-baseline'}->{$_} = 1 for qw/
504        auto use-script no-change reset-size ideographic alphabetic
505        hanging mathematical central middle text-after-edge text-before-edge
506      /;
507      $p->{prop_value}->{'alignment-baseline'}->{$_} = 1 for qw/
508        auto baseline before-edge text-before-edge middle central
509        after-edge text-after-edge ideographic alphabetic hanging
510        mathematical
511      /;
512      $p->{prop_value}->{'text-decoration'}->{$_} = 1 for qw/
513        none blink underline overline line-through
514      /;
515      $p->{prop_value}->{'caption-side'}->{$_} = 1 for qw/
516        top bottom left right
517      /;
518      $p->{prop_value}->{'table-layout'}->{auto} = 1;
519      $p->{prop_value}->{'table-layout'}->{fixed} = 1;
520      $p->{prop_value}->{'border-collapse'}->{collapse} = 1;
521      $p->{prop_value}->{'border-collapse'}->{separate} = 1;
522      $p->{prop_value}->{'empty-cells'}->{show} = 1;
523      $p->{prop_value}->{'empty-cells'}->{hide} = 1;
524      $p->{prop_value}->{cursor}->{$_} = 1 for qw/
525        auto crosshair default pointer move e-resize ne-resize nw-resize n-resize
526        se-resize sw-resize s-resize w-resize text wait help progress
527      /;
528      for my $prop (qw/border-top-style border-left-style
529                       border-bottom-style border-right-style outline-style/) {
530        $p->{prop_value}->{$prop}->{$_} = 1 for qw/
531          none hidden dotted dashed solid double groove ridge inset outset
532        /;
533      }
534      for my $prop (qw/color background-color
535                       border-bottom-color border-left-color border-right-color
536                       border-top-color border-color/) {
537        $p->{prop_value}->{$prop}->{transparent} = 1;
538        $p->{prop_value}->{$prop}->{flavor} = 1;
539        $p->{prop_value}->{$prop}->{'-manakai-default'} = 1;
540      }
541      $p->{prop_value}->{'outline-color'}->{invert} = 1;
542      $p->{prop_value}->{'outline-color'}->{'-manakai-invert-or-currentcolor'} = 1;
543      $p->{pseudo_class}->{$_} = 1 for qw/
544        active checked disabled empty enabled first-child first-of-type
545        focus hover indeterminate last-child last-of-type link only-child
546        only-of-type root target visited
547        lang nth-child nth-last-child nth-of-type nth-last-of-type not
548        -manakai-contains -manakai-current
549      /;
550      $p->{pseudo_element}->{$_} = 1 for qw/
551        after before first-letter first-line
552      /;
553    
554      print STDOUT qq[</dl>    return $CSSParser = $p;
555  </div>  } # get_css_parser
   
 ];  
     print_source_string_section (\($input->{s}), $doc->input_encoding);  
   } else {  
     ## TODO: Change HTTP status code??  
     print STDOUT qq[  
 <div id="result-summary" class="section">  
 <p><em>Media type <code class="MIME" lang="en">@{[htescape $input->{media_type}]}</code> is not supported!</em></p>  
 </div>  
 ];  
     push @nav, ['#result-summary' => 'Result'];  
   }  
   
   
   if (defined $doc or defined $el) {  
     print STDOUT qq[  
 <div id="document-tree" class="section">  
 <h2>Document Tree</h2>  
 ];  
     push @nav, ['#document-tree' => 'Tree'];  
   
     print_document_tree ($el || $doc);  
556    
557      print STDOUT qq[  sub print_syntax_error_css_section ($$) {
558  </div>    my ($input, $result) = @_;
559    
560  <div id="document-errors" class="section">    print STDOUT qq[
561  <h2>Document Errors</h2>  <div id="$input->{id_prefix}parse-errors" class="section">
562    <h2>Parse Errors</h2>
563    
564  <dl>];  <dl>];
565      push @nav, ['#document-errors' => 'Document Error'];    push @nav, ['#parse-errors' => 'Parse Error'] unless $input->{nested};
566    
567      require Whatpm::ContentChecker;    my $p = get_css_parser ();
568      my $onerror = sub {    $p->init;
569        my %opt = @_;    $p->{onerror} = sub {
570        my ($type, $cls, $msg) = get_text ($opt{type}, $opt{level}, $opt{node});      my (%opt) = @_;
571        $type =~ tr/ /-/;      my ($type, $cls, $msg) = get_text ($opt{type}, $opt{level});
572        $type =~ s/\|/%7C/g;      if ($opt{token}) {
573        $msg .= qq[ [<a href="../error-description#@{[htescape ($type)]}">Description</a>]];        print STDOUT qq[<dt class="$cls"><a href="#$input->{id_prefix}line-$opt{token}->{line}">Line $opt{token}->{line}</a> column $opt{token}->{column}];
       print STDOUT qq[<dt class="$cls">] . get_node_link ($opt{node}) .  
           qq[</dt>\n<dd class="$cls">], $msg, "</dd>\n";  
     };  
   
     my $elements;  
     if ($el) {  
       $elements = Whatpm::ContentChecker->check_element ($el, $onerror);  
574      } else {      } else {
575        $elements = Whatpm::ContentChecker->check_document ($doc, $onerror);        print STDOUT qq[<dt class="$cls">Unknown location];
576      }      }
577        if (defined $opt{value}) {
578      print STDOUT qq[</dl>        print STDOUT qq[ (<code>@{[htescape ($opt{value})]}</code>)];
579  </div>      } elsif (defined $opt{token}) {
580  ];        print STDOUT qq[ (<code>@{[htescape (Whatpm::CSS::Tokenizer->serialize_token ($opt{token}))]}</code>)];
   
     if (@{$elements->{table}}) {  
       require JSON;  
   
       push @nav, ['#tables' => 'Tables'];  
       print STDOUT qq[  
 <div id="tables" class="section">  
 <h2>Tables</h2>  
   
 <!--[if IE]><script type="text/javascript" src="../excanvas.js"></script><![endif]-->  
 <script src="../table-script.js" type="text/javascript"></script>  
 <noscript>  
 <p><em>Structure of tables are visualized here if scripting is enabled.</em></p>  
 </noscript>  
 ];  
   
       my $i = 0;  
       for my $table_el (@{$elements->{table}}) {  
         $i++;  
         print STDOUT qq[<div class="section" id="table-$i"><h3>] .  
             get_node_link ($table_el) . q[</h3>];  
   
         ## TODO: Make |ContentChecker| return |form_table| result  
         ## so that this script don't have to run the algorithm twice.  
         my $table = Whatpm::HTMLTable->form_table ($table_el);  
           
         for (@{$table->{column_group}}, @{$table->{column}}, $table->{caption}) {  
           next unless $_;  
           delete $_->{element};  
         }  
           
         for (@{$table->{row_group}}) {  
           next unless $_;  
           next unless $_->{element};  
           $_->{type} = $_->{element}->manakai_local_name;  
           delete $_->{element};  
         }  
           
         for (@{$table->{cell}}) {  
           next unless $_;  
           for (@{$_}) {  
             next unless $_;  
             for (@$_) {  
               $_->{id} = refaddr $_->{element} if defined $_->{element};  
               delete $_->{element};  
               $_->{is_header} = $_->{is_header} ? 1 : 0;  
             }  
           }  
         }  
           
         print STDOUT '</div><script type="text/javascript">tableToCanvas (';  
         print STDOUT JSON::objToJson ($table);  
         print STDOUT qq[, document.getElementById ('table-$i'));</script>];  
       }  
       
       print STDOUT qq[</div>];  
581      }      }
582        $type =~ tr/ /-/;
583        $type =~ s/\|/%7C/g;
584        $msg .= qq[ [<a href="../error-description#@{[htescape ($type)]}">Description</a>]];
585        print STDOUT qq[<dd class="$cls">], get_error_level_label (\%opt);
586        print STDOUT qq[$msg</dd>\n];
587    
588      if (keys %{$elements->{id}}) {      add_error ('syntax', \%opt => $result);
589        push @nav, ['#identifiers' => 'IDs'];    };
590        print STDOUT qq[    $p->{href} = $input->{uri};
591  <div id="identifiers" class="section">    $p->{base_uri} = $input->{base_uri};
 <h2>Identifiers</h2>  
592    
593  <dl>  #  if ($parse_mode eq 'q') {
594  ];  #    $p->{unitless_px} = 1;
595        for my $id (sort {$a cmp $b} keys %{$elements->{id}}) {  #    $p->{hashless_color} = 1;
596          print STDOUT qq[<dt><code>@{[htescape $id]}</code></dt>];  #  }
597          for (@{$elements->{id}->{$id}}) {  
598            print STDOUT qq[<dd>].get_node_link ($_).qq[</dd>];  ## TODO: Make $input->{s} a ref.
599          }  
600        }    my $s = \$input->{s};
601        print STDOUT qq[</dl></div>];    my $charset;
602      unless ($input->{is_char_string}) {
603        require Encode;
604        if (defined $input->{charset}) {## TODO: IANA->Perl
605          $charset = $input->{charset};
606          $s = \(Encode::decode ($input->{charset}, $$s));
607        } else {
608          ## TODO: charset detection
609          $s = \(Encode::decode ($charset = 'utf-8', $$s));
610      }      }
611      }
612      
613      my $cssom = $p->parse_char_string ($$s);
614      $cssom->manakai_input_encoding ($charset) if defined $charset;
615    
616      if (keys %{$elements->{term}}) {    print STDOUT qq[</dl></div>];
       push @nav, ['#terms' => 'Terms'];  
       print STDOUT qq[  
 <div id="terms" class="section">  
 <h2>Terms</h2>  
617    
618  <dl>    return $cssom;
619  ];  } # print_syntax_error_css_section
       for my $term (sort {$a cmp $b} keys %{$elements->{term}}) {  
         print STDOUT qq[<dt>@{[htescape $term]}</dt>];  
         for (@{$elements->{term}->{$term}}) {  
           print STDOUT qq[<dd>].get_node_link ($_).qq[</dd>];  
         }  
       }  
       print STDOUT qq[</dl></div>];  
     }  
620    
621      if (keys %{$elements->{class}}) {  sub print_syntax_error_manifest_section ($$) {
622        push @nav, ['#classes' => 'Classes'];    my ($input, $result) = @_;
       print STDOUT qq[  
 <div id="classes" class="section">  
 <h2>Classes</h2>  
623    
624  <dl>    require Whatpm::CacheManifest;
 ];  
       for my $class (sort {$a cmp $b} keys %{$elements->{class}}) {  
         print STDOUT qq[<dt><code>@{[htescape $class]}</code></dt>];  
         for (@{$elements->{class}->{$class}}) {  
           print STDOUT qq[<dd>].get_node_link ($_).qq[</dd>];  
         }  
       }  
       print STDOUT qq[</dl></div>];  
     }  
   }  
625    
   ## TODO: Show result  
 } else {  
626    print STDOUT qq[    print STDOUT qq[
627  </dl>  <div id="$input->{id_prefix}parse-errors" class="section">
628  </div>  <h2>Parse Errors</h2>
629    
630  <div class="section" id="result-summary">  <dl>];
631  <p><em><strong>Input Error</strong>: @{[htescape ($input->{error_status_text})]}</em></p>    push @nav, ['#parse-errors' => 'Parse Error'] unless $input->{nested};
 </div>  
 ];  
   push @nav, ['#result-summary' => 'Result'];  
632    
633  }    my $onerror = sub {
634        my (%opt) = @_;
635        my ($type, $cls, $msg) = get_text ($opt{type}, $opt{level});
636        print STDOUT qq[<dt class="$cls">], get_error_label ($input, \%opt),
637            qq[</dt>];
638        $type =~ tr/ /-/;
639        $type =~ s/\|/%7C/g;
640        $msg .= qq[ [<a href="../error-description#@{[htescape ($type)]}">Description</a>]];
641        print STDOUT qq[<dd class="$cls">], get_error_level_label (\%opt);
642        print STDOUT qq[$msg</dd>\n];
643    
644    print STDOUT qq[      add_error ('syntax', \%opt => $result);
645  <ul class="navigation" id="nav-items">    };
 ];  
   for (@nav) {  
     print STDOUT qq[<li><a href="$_->[0]">$_->[1]</a></li>];  
   }  
   print STDOUT qq[  
 </ul>  
 </body>  
 </html>  
 ];  
646    
647  exit;    my $time1 = time;
648      my $manifest = Whatpm::CacheManifest->parse_byte_string
649          ($input->{s}, $input->{uri}, $input->{base_uri}, $onerror);
650      $time{parse_manifest} = time - $time1;
651    
652  sub print_http_header_section ($) {    print STDOUT qq[</dl></div>];
   my $input = shift;  
   return unless defined $input->{header_status_code} or  
       defined $input->{header_status_text} or  
       @{$input->{header_field}};  
     
   push @nav, ['#source-header' => 'HTTP Header'];  
   print STDOUT qq[<div id="source-header" class="section">  
 <h2>HTTP Header</h2>  
653    
654  <p><strong>Note</strong>: Due to the limitation of the    return $manifest;
655  network library in use, the content of this section might  } # print_syntax_error_manifest_section
 not be the real header.</p>  
656    
657  <table><tbody>  sub print_source_string_section ($$$) {
658  ];    my $input = shift;
659      my $s;
660      unless ($input->{is_char_string}) {
661        require Encode;
662        my $enc = Encode::find_encoding ($_[1]); ## TODO: charset name -> Perl name
663        return unless $enc;
664    
665    if (defined $input->{header_status_code}) {      $s = \($enc->decode (${$_[0]}));
666      print STDOUT qq[<tr><th scope="row">Status code</th>];    } else {
667      print STDOUT qq[<td><code>@{[htescape ($input->{header_status_code})]}</code></td></tr>];      $s = $_[0];
   }  
   if (defined $input->{header_status_text}) {  
     print STDOUT qq[<tr><th scope="row">Status text</th>];  
     print STDOUT qq[<td><code>@{[htescape ($input->{header_status_text})]}</code></td></tr>];  
   }  
     
   for (@{$input->{header_field}}) {  
     print STDOUT qq[<tr><th scope="row"><code>@{[htescape ($_->[0])]}</code></th>];  
     print STDOUT qq[<td><code>@{[htescape ($_->[1])]}</code></td></tr>];  
668    }    }
669    
   print STDOUT qq[</tbody></table></div>];  
 } # print_http_header_section  
   
 sub print_source_string_section ($$) {  
   require Encode;  
   my $enc = Encode::find_encoding ($_[1]); ## TODO: charset name -> Perl name  
   return unless $enc;  
   
   my $s = \($enc->decode (${$_[0]}));  
670    my $i = 1;                                my $i = 1;                            
671    push @nav, ['#source-string' => 'Source'];    push @nav, ['#source-string' => 'Source'] unless $input->{nested};
672    print STDOUT qq[<div id="source-string" class="section">    print STDOUT qq[<div id="$input->{id_prefix}source-string" class="section">
673  <h2>Document Source</h2>  <h2>Document Source</h2>
674  <ol lang="">\n];  <ol lang="">\n];
675    if (length $$s) {    if (length $$s) {
676      while ($$s =~ /\G([^\x0A]*?)\x0D?\x0A/gc) {      while ($$s =~ /\G([^\x0A]*?)\x0D?\x0A/gc) {
677        print STDOUT qq[<li id="line-$i">], htescape $1, "</li>\n";        print STDOUT qq[<li id="$input->{id_prefix}line-$i">], htescape $1,
678              "</li>\n";
679        $i++;        $i++;
680      }      }
681      if ($$s =~ /\G([^\x0A]+)/gc) {      if ($$s =~ /\G([^\x0A]+)/gc) {
682        print STDOUT qq[<li id="line-$i">], htescape $1, "</li>\n";        print STDOUT qq[<li id="$input->{id_prefix}line-$i">], htescape $1,
683              "</li>\n";
684      }      }
685    } else {    } else {
686      print STDOUT q[<li id="line-1"></li>];      print STDOUT q[<li id="$input->{id_prefix}line-1"></li>];
687    }    }
688    print STDOUT "</ol></div>";    print STDOUT "</ol></div>";
689  } # print_input_string_section  } # print_input_string_section
690    
691  sub print_document_tree ($) {  sub print_document_tree ($$) {
692    my $node = shift;    my ($input, $node) = @_;
693    
694    my $r = '<ol class="xoxo">';    my $r = '<ol class="xoxo">';
695    
696    my @node = ($node);    my @node = ($node);
# Line 421  sub print_document_tree ($) { Line 701  sub print_document_tree ($) {
701        next;        next;
702      }      }
703    
704      my $node_id = 'node-'.refaddr $child;      my $node_id = $input->{id_prefix} . 'node-'.refaddr $child;
705      my $nt = $child->node_type;      my $nt = $child->node_type;
706      if ($nt == $child->ELEMENT_NODE) {      if ($nt == $child->ELEMENT_NODE) {
707        my $child_nsuri = $child->namespace_uri;        my $child_nsuri = $child->namespace_uri;
# Line 432  sub print_document_tree ($) { Line 712  sub print_document_tree ($) {
712          $r .= '<ul class="attributes">';          $r .= '<ul class="attributes">';
713          for my $attr (sort {$a->[0] cmp $b->[0]} map { [$_->name, $_->value, $_->namespace_uri, 'node-'.refaddr $_] }          for my $attr (sort {$a->[0] cmp $b->[0]} map { [$_->name, $_->value, $_->namespace_uri, 'node-'.refaddr $_] }
714                        @{$child->attributes}) {                        @{$child->attributes}) {
715            $r .= qq[<li id="$attr->[3]" class="tree-attribute"><code title="@{[defined $_->[2] ? $_->[2] : '']}">] . htescape ($attr->[0]) . '</code> = '; ## ISSUE: case?            $r .= qq[<li id="$input->{id_prefix}$attr->[3]" class="tree-attribute"><code title="@{[defined $attr->[2] ? htescape ($attr->[2]) : '']}">] . htescape ($attr->[0]) . '</code> = '; ## ISSUE: case?
716            $r .= '<q>' . htescape ($attr->[1]) . '</q></li>'; ## TODO: children            $r .= '<q>' . htescape ($attr->[1]) . '</q></li>'; ## TODO: children
717          }          }
718          $r .= '</ul>';          $r .= '</ul>';
# Line 453  sub print_document_tree ($) { Line 733  sub print_document_tree ($) {
733      } elsif ($nt == $child->DOCUMENT_NODE) {      } elsif ($nt == $child->DOCUMENT_NODE) {
734        $r .= qq'<li id="$node_id" class="tree-document">Document';        $r .= qq'<li id="$node_id" class="tree-document">Document';
735        $r .= qq[<ul class="attributes">];        $r .= qq[<ul class="attributes">];
736          my $cp = $child->manakai_charset;
737          if (defined $cp) {
738            $r .= qq[<li><code>charset</code> parameter = <code>];
739            $r .= htescape ($cp) . qq[</code></li>];
740          }
741          $r .= qq[<li><code>inputEncoding</code> = ];
742          my $ie = $child->input_encoding;
743          if (defined $ie) {
744            $r .= qq[<code>@{[htescape ($ie)]}</code>];
745            if ($child->manakai_has_bom) {
746              $r .= qq[ (with <code class=charname><abbr>BOM</abbr></code>)];
747            }
748          } else {
749            $r .= qq[(<code>null</code>)];
750          }
751        $r .= qq[<li>@{[scalar get_text ('manakaiIsHTML:'.($child->manakai_is_html?1:0))]}</li>];        $r .= qq[<li>@{[scalar get_text ('manakaiIsHTML:'.($child->manakai_is_html?1:0))]}</li>];
752        $r .= qq[<li>@{[scalar get_text ('manakaiCompatMode:'.$child->manakai_compat_mode)]}</li>];        $r .= qq[<li>@{[scalar get_text ('manakaiCompatMode:'.$child->manakai_compat_mode)]}</li>];
753        unless ($child->manakai_is_html) {        unless ($child->manakai_is_html) {
# Line 486  sub print_document_tree ($) { Line 781  sub print_document_tree ($) {
781    print STDOUT $r;    print STDOUT $r;
782  } # print_document_tree  } # print_document_tree
783    
784    sub print_structure_dump_dom_section ($$$) {
785      my ($input, $doc, $el) = @_;
786    
787      print STDOUT qq[
788    <div id="$input->{id_prefix}document-tree" class="section">
789    <h2>Document Tree</h2>
790    ];
791      push @nav, [qq[#$input->{id_prefix}document-tree] => 'Tree']
792          unless $input->{nested};
793    
794      print_document_tree ($input, $el || $doc);
795    
796      print STDOUT qq[</div>];
797    } # print_structure_dump_dom_section
798    
799    sub print_structure_dump_cssom_section ($$) {
800      my ($input, $cssom) = @_;
801    
802      print STDOUT qq[
803    <div id="$input->{id_prefix}document-tree" class="section">
804    <h2>Document Tree</h2>
805    ];
806      push @nav, [qq[#$input->{id_prefix}document-tree] => 'Tree']
807          unless $input->{nested};
808    
809      ## TODO:
810      print STDOUT "<pre>".htescape ($cssom->css_text)."</pre>";
811    
812      print STDOUT qq[</div>];
813    } # print_structure_dump_cssom_section
814    
815    sub print_structure_dump_manifest_section ($$) {
816      my ($input, $manifest) = @_;
817    
818      print STDOUT qq[
819    <div id="$input->{id_prefix}dump-manifest" class="section">
820    <h2>Cache Manifest</h2>
821    ];
822      push @nav, [qq[#$input->{id_prefix}dump-manifest] => 'Cache Manifest']
823          unless $input->{nested};
824    
825      print STDOUT qq[<dl><dt>Explicit entries</dt>];
826      my $i = 0;
827      for my $uri (@{$manifest->[0]}) {
828        my $euri = htescape ($uri);
829        print STDOUT qq[<dd id="$input->{id_prefix}index-@{[$i++]}"><code class=uri>&lt;<a href="$euri">$euri</a>></code></dd>];
830      }
831    
832      print STDOUT qq[<dt>Fallback entries</dt><dd>
833          <table><thead><tr><th scope=row>Oppotunistic Caching Namespace</th>
834          <th scope=row>Fallback Entry</tr><tbody>];
835      for my $uri (sort {$a cmp $b} keys %{$manifest->[1]}) {
836        my $euri = htescape ($uri);
837        my $euri2 = htescape ($manifest->[1]->{$uri});
838        print STDOUT qq[<tr><td id="$input->{id_prefix}index-@{[$i++]}"><code class=uri>&lt;<a href="$euri">$euri</a>></code></td>
839            <td id="$input->{id_prefix}index-@{[$i++]}"><code class=uri>&lt;<a href="$euri2">$euri2</a>></code></td>];
840      }
841    
842      print STDOUT qq[</table><dt>Online whitelist</dt>];
843      for my $uri (@{$manifest->[2]}) {
844        my $euri = htescape ($uri);
845        print STDOUT qq[<dd id="$input->{id_prefix}index-@{[$i++]}"><code class=uri>&lt;<a href="$euri">$euri</a>></code></dd>];
846      }
847    
848      print STDOUT qq[</dl></div>];
849    } # print_structure_dump_manifest_section
850    
851    sub print_structure_error_dom_section ($$$$$) {
852      my ($input, $doc, $el, $result, $onsubdoc) = @_;
853    
854      print STDOUT qq[<div id="$input->{id_prefix}document-errors" class="section">
855    <h2>Document Errors</h2>
856    
857    <dl>];
858      push @nav, [qq[#$input->{id_prefix}document-errors] => 'Document Error']
859          unless $input->{nested};
860    
861      require Whatpm::ContentChecker;
862      my $onerror = sub {
863        my %opt = @_;
864        my ($type, $cls, $msg) = get_text ($opt{type}, $opt{level}, $opt{node});
865        $type =~ tr/ /-/;
866        $type =~ s/\|/%7C/g;
867        $msg .= qq[ [<a href="../error-description#@{[htescape ($type)]}">Description</a>]];
868        print STDOUT qq[<dt class="$cls">] . get_error_label ($input, \%opt) .
869            qq[</dt>\n<dd class="$cls">], get_error_level_label (\%opt);
870        print STDOUT $msg, "</dd>\n";
871        add_error ('structure', \%opt => $result);
872      };
873    
874      my $elements;
875      my $time1 = time;
876      if ($el) {
877        $elements = Whatpm::ContentChecker->check_element
878            ($el, $onerror, $onsubdoc);
879      } else {
880        $elements = Whatpm::ContentChecker->check_document
881            ($doc, $onerror, $onsubdoc);
882      }
883      $time{check} = time - $time1;
884    
885      print STDOUT qq[</dl></div>];
886    
887      return $elements;
888    } # print_structure_error_dom_section
889    
890    sub print_structure_error_manifest_section ($$$) {
891      my ($input, $manifest, $result) = @_;
892    
893      print STDOUT qq[<div id="$input->{id_prefix}document-errors" class="section">
894    <h2>Document Errors</h2>
895    
896    <dl>];
897      push @nav, [qq[#$input->{id_prefix}document-errors] => 'Document Error']
898          unless $input->{nested};
899    
900      require Whatpm::CacheManifest;
901      Whatpm::CacheManifest->check_manifest ($manifest, sub {
902        my %opt = @_;
903        my ($type, $cls, $msg) = get_text ($opt{type}, $opt{level}, $opt{node});
904        $type =~ tr/ /-/;
905        $type =~ s/\|/%7C/g;
906        $msg .= qq[ [<a href="../error-description#@{[htescape ($type)]}">Description</a>]];
907        print STDOUT qq[<dt class="$cls">] . get_error_label ($input, \%opt) .
908            qq[</dt>\n<dd class="$cls">], $msg, "</dd>\n";
909        add_error ('structure', \%opt => $result);
910      });
911    
912      print STDOUT qq[</div>];
913    } # print_structure_error_manifest_section
914    
915    sub print_table_section ($$) {
916      my ($input, $tables) = @_;
917      
918      push @nav, [qq[#$input->{id_prefix}tables] => 'Tables']
919          unless $input->{nested};
920      print STDOUT qq[
921    <div id="$input->{id_prefix}tables" class="section">
922    <h2>Tables</h2>
923    
924    <!--[if IE]><script type="text/javascript" src="../excanvas.js"></script><![endif]-->
925    <script src="../table-script.js" type="text/javascript"></script>
926    <noscript>
927    <p><em>Structure of tables are visualized here if scripting is enabled.</em></p>
928    </noscript>
929    ];
930      
931      require JSON;
932      
933      my $i = 0;
934      for my $table_el (@$tables) {
935        $i++;
936        print STDOUT qq[<div class="section" id="$input->{id_prefix}table-$i"><h3>] .
937            get_node_link ($input, $table_el) . q[</h3>];
938    
939        ## TODO: Make |ContentChecker| return |form_table| result
940        ## so that this script don't have to run the algorithm twice.
941        my $table = Whatpm::HTMLTable->form_table ($table_el);
942        
943        for (@{$table->{column_group}}, @{$table->{column}}, $table->{caption}) {
944          next unless $_;
945          delete $_->{element};
946        }
947        
948        for (@{$table->{row_group}}) {
949          next unless $_;
950          next unless $_->{element};
951          $_->{type} = $_->{element}->manakai_local_name;
952          delete $_->{element};
953        }
954        
955        for (@{$table->{cell}}) {
956          next unless $_;
957          for (@{$_}) {
958            next unless $_;
959            for (@$_) {
960              $_->{id} = refaddr $_->{element} if defined $_->{element};
961              delete $_->{element};
962              $_->{is_header} = $_->{is_header} ? 1 : 0;
963            }
964          }
965        }
966            
967        print STDOUT '</div><script type="text/javascript">tableToCanvas (';
968        print STDOUT JSON::objToJson ($table);
969        print STDOUT qq[, document.getElementById ('$input->{id_prefix}table-$i')];
970        print STDOUT qq[, '$input->{id_prefix}');</script>];
971      }
972      
973      print STDOUT qq[</div>];
974    } # print_table_section
975    
976    sub print_listing_section ($$$) {
977      my ($opt, $input, $ids) = @_;
978      
979      push @nav, ['#' . $input->{id_prefix} . $opt->{id} => $opt->{label}]
980          unless $input->{nested};
981      print STDOUT qq[
982    <div id="$input->{id_prefix}$opt->{id}" class="section">
983    <h2>$opt->{heading}</h2>
984    
985    <dl>
986    ];
987      for my $id (sort {$a cmp $b} keys %$ids) {
988        print STDOUT qq[<dt><code>@{[htescape $id]}</code></dt>];
989        for (@{$ids->{$id}}) {
990          print STDOUT qq[<dd>].get_node_link ($input, $_).qq[</dd>];
991        }
992      }
993      print STDOUT qq[</dl></div>];
994    } # print_listing_section
995    
996    sub print_result_section ($) {
997      my $result = shift;
998    
999      print STDOUT qq[
1000    <div id="result-summary" class="section">
1001    <h2>Result</h2>];
1002    
1003      if ($result->{unsupported} and $result->{conforming_max}) {  
1004        print STDOUT qq[<p class=uncertain id=result-para>The conformance
1005            checker cannot decide whether the document is conforming or
1006            not, since the document contains one or more unsupported
1007            features.  The document might or might not be conforming.</p>];
1008      } elsif ($result->{conforming_min}) {
1009        print STDOUT qq[<p class=PASS id=result-para>No conformance-error is
1010            found in this document.</p>];
1011      } elsif ($result->{conforming_max}) {
1012        print STDOUT qq[<p class=SEE-RESULT id=result-para>This document
1013            is <strong>likely <em>non</em>-conforming</strong>, but in rare case
1014            it might be conforming.</p>];
1015      } else {
1016        print STDOUT qq[<p class=FAIL id=result-para>This document is
1017            <strong><em>non</em>-conforming</strong>.</p>];
1018      }
1019    
1020      print STDOUT qq[<table>
1021    <colgroup><col><colgroup><col><col><col><colgroup><col>
1022    <thead>
1023    <tr><th scope=col></th>
1024    <th scope=col><a href="../error-description#level-m"><em class=rfc2119>MUST</em>‐level
1025    Errors</a></th>
1026    <th scope=col><a href="../error-description#level-s"><em class=rfc2119>SHOULD</em>‐level
1027    Errors</a></th>
1028    <th scope=col><a href="../error-description#level-w">Warnings</a></th>
1029    <th scope=col>Score</th></tr></thead><tbody>];
1030    
1031      my $must_error = 0;
1032      my $should_error = 0;
1033      my $warning = 0;
1034      my $score_min = 0;
1035      my $score_max = 0;
1036      my $score_base = 20;
1037      my $score_unit = $score_base / 100;
1038      for (
1039        [Transfer => 'transfer', ''],
1040        [Character => 'char', ''],
1041        [Syntax => 'syntax', '#parse-errors'],
1042        [Structure => 'structure', '#document-errors'],
1043      ) {
1044        $must_error += ($result->{$_->[1]}->{must} += 0);
1045        $should_error += ($result->{$_->[1]}->{should} += 0);
1046        $warning += ($result->{$_->[1]}->{warning} += 0);
1047        $score_min += (($result->{$_->[1]}->{score_min} *= $score_unit) += $score_base);
1048        $score_max += (($result->{$_->[1]}->{score_max} *= $score_unit) += $score_base);
1049    
1050        my $uncertain = $result->{$_->[1]}->{unsupported} ? '?' : '';
1051        my $label = $_->[0];
1052        if ($result->{$_->[1]}->{must} or
1053            $result->{$_->[1]}->{should} or
1054            $result->{$_->[1]}->{warning} or
1055            $result->{$_->[1]}->{unsupported}) {
1056          $label = qq[<a href="$_->[2]">$label</a>];
1057        }
1058    
1059        print STDOUT qq[<tr class="@{[$uncertain ? 'uncertain' : '']}"><th scope=row>$label</th><td class="@{[$result->{$_->[1]}->{must} ? 'FAIL' : '']}">$result->{$_->[1]}->{must}$uncertain</td><td class="@{[$result->{$_->[1]}->{should} ? 'SEE-RESULT' : '']}">$result->{$_->[1]}->{should}$uncertain</td><td>$result->{$_->[1]}->{warning}$uncertain</td>];
1060        if ($uncertain) {
1061          print qq[<td class="@{[$result->{$_->[1]}->{must} ? 'FAIL' : $result->{$_->[1]}->{should} ? 'SEE-RESULT' : '']}">&#x2212;&#x221E;..$result->{$_->[1]}->{score_max}</td>];
1062        } elsif ($result->{$_->[1]}->{score_min} != $result->{$_->[1]}->{score_max}) {
1063          print qq[<td class="@{[$result->{$_->[1]}->{must} ? 'FAIL' : 'SEE-RESULT']}">$result->{$_->[1]}->{score_min}..$result->{$_->[1]}->{score_max}</td></tr>];
1064        } else {
1065          print qq[<td class="@{[$result->{$_->[1]}->{must} ? 'FAIL' : '']}">$result->{$_->[1]}->{score_min}</td></tr>];
1066        }
1067      }
1068    
1069      $score_max += $score_base;
1070    
1071      print STDOUT qq[
1072    <tr class=uncertain><th scope=row>Semantics</th><td>0?</td><td>0?</td><td>0?</td><td>&#x2212;&#x221E;..$score_base</td></tr>
1073    </tbody>
1074    <tfoot><tr class=uncertain><th scope=row>Total</th>
1075    <td class="@{[$must_error ? 'FAIL' : '']}">$must_error?</td>
1076    <td class="@{[$should_error ? 'SEE-RESULT' : '']}">$should_error?</td>
1077    <td>$warning?</td>
1078    <td class="@{[$must_error ? 'FAIL' : $should_error ? 'SEE-RESULT' : '']}"><strong>&#x2212;&#x221E;..$score_max</strong></td></tr></tfoot>
1079    </table>
1080    
1081    <p><strong>Important</strong>: This conformance checking service
1082    is <em>under development</em>.  The result above might be <em>wrong</em>.</p>
1083    </div>];
1084      push @nav, ['#result-summary' => 'Result'];
1085    } # print_result_section
1086    
1087    sub print_result_unknown_type_section ($$) {
1088      my ($input, $result) = @_;
1089    
1090      my $euri = htescape ($input->{uri});
1091      print STDOUT qq[
1092    <div id="$input->{id_prefix}parse-errors" class="section">
1093    <h2>Errors</h2>
1094    
1095    <dl>
1096    <dt class=unsupported><code>&lt;<a href="$euri">$euri</a>&gt;</code></dt>
1097        <dd class=unsupported><strong><a href="../error-description#level-u">Not
1098            supported</a></strong>:
1099        Media type
1100        <code class="MIME" lang="en">@{[htescape $input->{media_type}]}</code>
1101        is not supported.</dd>
1102    </dl>
1103    </div>
1104    ];
1105      push @nav, [qq[#$input->{id_prefix}parse-errors] => 'Errors']
1106          unless $input->{nested};
1107      add_error (char => {level => 'u'} => $result);
1108      add_error (syntax => {level => 'u'} => $result);
1109      add_error (structure => {level => 'u'} => $result);
1110    } # print_result_unknown_type_section
1111    
1112    sub print_result_input_error_section ($) {
1113      my $input = shift;
1114      print STDOUT qq[<div class="section" id="result-summary">
1115    <p><em><strong>Input Error</strong>: @{[htescape ($input->{error_status_text})]}</em></p>
1116    </div>];
1117      push @nav, ['#result-summary' => 'Result'];
1118    } # print_result_input_error_section
1119    
1120    sub get_error_label ($$) {
1121      my ($input, $err) = @_;
1122    
1123      my $r = '';
1124    
1125      if (defined $err->{line}) {
1126        if ($err->{column} > 0) {
1127          $r = qq[<a href="#$input->{id_prefix}line-$err->{line}">Line $err->{line}</a> column $err->{column}];
1128        } else {
1129          $err->{line} = $err->{line} - 1 || 1;
1130          $r = qq[<a href="#$input->{id_prefix}line-$err->{line}">Line $err->{line}</a>];
1131        }
1132      }
1133    
1134      if (defined $err->{node}) {
1135        $r .= ' ' if length $r;
1136        $r = get_node_link ($input, $err->{node});
1137      }
1138    
1139      if (defined $err->{index}) {
1140        if (length $r) {
1141          $r .= ', Index ' . (0+$err->{index});
1142        } else {
1143          $r .= "<a href='#$input->{id_prefix}index-@{[0+$err->{index}]}'>Index "
1144              . (0+$err->{index}) . '</a>';
1145        }
1146      }
1147    
1148      if (defined $err->{value}) {
1149        $r .= ' ' if length $r;
1150        $r .= '<q><code>' . htescape ($err->{value}) . '</code></q>';
1151      }
1152    
1153      return $r;
1154    } # get_error_label
1155    
1156    sub get_error_level_label ($) {
1157      my $err = shift;
1158    
1159      my $r = '';
1160    
1161      if (not defined $err->{level} or $err->{level} eq 'm') {
1162        $r = qq[<strong><a href="../error-description#level-m"><em class=rfc2119>MUST</em>‐level
1163            error</a></strong>: ];
1164      } elsif ($err->{level} eq 's') {
1165        $r = qq[<strong><a href="../error-description#level-s"><em class=rfc2119>SHOULD</em>‐level
1166            error</a></strong>: ];
1167      } elsif ($err->{level} eq 'w') {
1168        $r = qq[<strong><a href="../error-description#level-w">Warning</a></strong>:
1169            ];
1170      } elsif ($err->{level} eq 'u' or $err->{level} eq 'unsupported') {
1171        $r = qq[<strong><a href="../error-description#level-u">Not
1172            supported</a></strong>: ];
1173      } elsif ($err->{level} eq 'i') {
1174        $r = qq[<strong><a href="../error-description#level-i">Information</a></strong>: ];
1175      } else {
1176        my $elevel = htescape ($err->{level});
1177        $r = qq[<strong><a href="../error-description#level-$elevel">$elevel</a></strong>:
1178            ];
1179      }
1180    
1181      return $r;
1182    } # get_error_level_label
1183    
1184  sub get_node_path ($) {  sub get_node_path ($) {
1185    my $node = shift;    my $node = shift;
1186    my @r;    my @r;
# Line 513  sub get_node_path ($) { Line 1208  sub get_node_path ($) {
1208    return join '/', @r;    return join '/', @r;
1209  } # get_node_path  } # get_node_path
1210    
1211  sub get_node_link ($) {  sub get_node_link ($$) {
1212    return qq[<a href="#node-@{[refaddr $_[0]]}">] .    return qq[<a href="#$_[0]->{id_prefix}node-@{[refaddr $_[1]]}">] .
1213        htescape (get_node_path ($_[0])) . qq[</a>];        htescape (get_node_path ($_[1])) . qq[</a>];
1214  } # get_node_link  } # get_node_link
1215    
1216  {  {
# Line 523  sub get_node_link ($) { Line 1218  sub get_node_link ($) {
1218    
1219  sub load_text_catalog ($) {  sub load_text_catalog ($) {
1220    my $lang = shift; # MUST be a canonical lang name    my $lang = shift; # MUST be a canonical lang name
1221    open my $file, '<', "cc-msg.$lang.txt" or die "$0: cc-msg.$lang.txt: $!";    open my $file, '<:utf8', "cc-msg.$lang.txt"
1222          or die "$0: cc-msg.$lang.txt: $!";
1223    while (<$file>) {    while (<$file>) {
1224      if (s/^([^;]+);([^;]*);//) {      if (s/^([^;]+);([^;]*);//) {
1225        my ($type, $cls, $msg) = ($1, $2, $_);        my ($type, $cls, $msg) = ($1, $2, $_);
# Line 536  sub load_text_catalog ($) { Line 1232  sub load_text_catalog ($) {
1232  sub get_text ($) {  sub get_text ($) {
1233    my ($type, $level, $node) = @_;    my ($type, $level, $node) = @_;
1234    $type = $level . ':' . $type if defined $level;    $type = $level . ':' . $type if defined $level;
1235      $level = 'm' unless defined $level;
1236    my @arg;    my @arg;
1237    {    {
1238      if (defined $Msg->{$type}) {      if (defined $Msg->{$type}) {
# Line 550  sub get_text ($) { Line 1247  sub get_text ($) {
1247        $msg =~ s{<var>{\@}</var>}{        $msg =~ s{<var>{\@}</var>}{
1248          UNIVERSAL::can ($node, 'value') ? htescape ($node->value) : ''          UNIVERSAL::can ($node, 'value') ? htescape ($node->value) : ''
1249        }ge;        }ge;
1250        return ($type, $Msg->{$type}->[0], $msg);        $msg =~ s{<var>{local-name}</var>}{
1251            UNIVERSAL::can ($node, 'manakai_local_name')
1252              ? htescape ($node->manakai_local_name) : ''
1253          }ge;
1254          $msg =~ s{<var>{element-local-name}</var>}{
1255            (UNIVERSAL::can ($node, 'owner_element') and
1256             $node->owner_element)
1257              ? htescape ($node->owner_element->manakai_local_name)
1258              : ''
1259          }ge;
1260          return ($type, 'level-' . $level . ' ' . $Msg->{$type}->[0], $msg);
1261      } elsif ($type =~ s/:([^:]*)$//) {      } elsif ($type =~ s/:([^:]*)$//) {
1262        unshift @arg, $1;        unshift @arg, $1;
1263        redo;        redo;
1264      }      }
1265    }    }
1266    return ($type, '', htescape ($_[0]));    return ($type, 'level-'.$level, htescape ($_[0]));
1267  } # get_text  } # get_text
1268    
1269  }  }
# Line 564  sub get_text ($) { Line 1271  sub get_text ($) {
1271  sub get_input_document ($$) {  sub get_input_document ($$) {
1272    my ($http, $dom) = @_;    my ($http, $dom) = @_;
1273    
1274    my $request_uri = $http->parameter ('uri');    my $request_uri = $http->get_parameter ('uri');
1275    my $r = {};    my $r = {};
1276    if (defined $request_uri and length $request_uri) {    if (defined $request_uri and length $request_uri) {
1277      my $uri = $dom->create_uri_reference ($request_uri);      my $uri = $dom->create_uri_reference ($request_uri);
# Line 612  EOH Line 1319  EOH
1319      $ua->protocols_allowed ([qw/http/]);      $ua->protocols_allowed ([qw/http/]);
1320      $ua->max_size (1000_000);      $ua->max_size (1000_000);
1321      my $req = HTTP::Request->new (GET => $request_uri);      my $req = HTTP::Request->new (GET => $request_uri);
1322        $req->header ('Accept-Encoding' => 'identity, *; q=0');
1323      my $res = $ua->request ($req);      my $res = $ua->request ($req);
1324      if ($res->is_success or $http->parameter ('error-page')) {      ## TODO: 401 sets |is_success| true.
1325        if ($res->is_success or $http->get_parameter ('error-page')) {
1326        $r->{base_uri} = $res->base; ## NOTE: It does check |Content-Base|, |Content-Location|, and <base>. ## TODO: Use our own code!        $r->{base_uri} = $res->base; ## NOTE: It does check |Content-Base|, |Content-Location|, and <base>. ## TODO: Use our own code!
1327        $r->{uri} = $res->request->uri;        $r->{uri} = $res->request->uri;
1328        $r->{request_uri} = $request_uri;        $r->{request_uri} = $request_uri;
1329    
1330        ## TODO: More strict parsing...        ## TODO: More strict parsing...
1331        my $ct = $res->header ('Content-Type');        my $ct = $res->header ('Content-Type');
1332        if (defined $ct and $ct =~ m#^([0-9A-Za-z._+-]+/[0-9A-Za-z._+-]+)#) {        if (defined $ct and $ct =~ /;\s*charset\s*=\s*"?([^\s;"]+)"?/i) {
         $r->{media_type} = lc $1;  
       }  
       if (defined $ct and $ct =~ /;\s*charset\s*=\s*"?(\S+)"?/i) {  
1333          $r->{charset} = lc $1;          $r->{charset} = lc $1;
1334          $r->{charset} =~ tr/\\//d;          $r->{charset} =~ tr/\\//d;
1335            $r->{official_charset} = $r->{charset};
1336        }        }
1337    
1338        my $input_charset = $http->parameter ('charset');        my $input_charset = $http->get_parameter ('charset');
1339        if (defined $input_charset and length $input_charset) {        if (defined $input_charset and length $input_charset) {
1340          $r->{charset_overridden}          $r->{charset_overridden}
1341              = (not defined $r->{charset} or $r->{charset} ne $input_charset);              = (not defined $r->{charset} or $r->{charset} ne $input_charset);
1342          $r->{charset} = $input_charset;          $r->{charset} = $input_charset;
1343        }        }
1344    
1345          ## TODO: Support for HTTP Content-Encoding
1346    
1347        $r->{s} = ''.$res->content;        $r->{s} = ''.$res->content;
1348    
1349          require Whatpm::ContentType;
1350          ($r->{official_type}, $r->{media_type})
1351              = Whatpm::ContentType->get_sniffed_type
1352                  (get_file_head => sub {
1353                     return substr $r->{s}, 0, shift;
1354                   },
1355                   http_content_type_byte => $ct,
1356                   has_http_content_encoding =>
1357                       defined $res->header ('Content-Encoding'),
1358                   supported_image_types => {});
1359      } else {      } else {
1360        $r->{uri} = $res->request->uri;        $r->{uri} = $res->request->uri;
1361        $r->{request_uri} = $request_uri;        $r->{request_uri} = $request_uri;
# Line 649  EOH Line 1369  EOH
1369      $r->{header_status_code} = $res->code;      $r->{header_status_code} = $res->code;
1370      $r->{header_status_text} = $res->message;      $r->{header_status_text} = $res->message;
1371    } else {    } else {
1372      $r->{s} = ''.$http->parameter ('s');      $r->{s} = ''.$http->get_parameter ('s');
1373      $r->{uri} = q<thismessage:/>;      $r->{uri} = q<thismessage:/>;
1374      $r->{request_uri} = q<thismessage:/>;      $r->{request_uri} = q<thismessage:/>;
1375      $r->{base_uri} = q<thismessage:/>;      $r->{base_uri} = q<thismessage:/>;
1376      $r->{charset} = ''.$http->parameter ('_charset_');      $r->{charset} = ''.$http->get_parameter ('_charset_');
1377      $r->{charset} =~ s/\s+//g;      $r->{charset} =~ s/\s+//g;
1378      $r->{charset} = 'utf-8' if $r->{charset} eq '';      $r->{charset} = 'utf-8' if $r->{charset} eq '';
1379        $r->{official_charset} = $r->{charset};
1380      $r->{header_field} = [];      $r->{header_field} = [];
1381    
1382        require Whatpm::ContentType;
1383        ($r->{official_type}, $r->{media_type})
1384            = Whatpm::ContentType->get_sniffed_type
1385                (get_file_head => sub {
1386                   return substr $r->{s}, 0, shift;
1387                 },
1388                 http_content_type_byte => undef,
1389                 has_http_content_encoding => 0,
1390                 supported_image_types => {});
1391    }    }
1392    
1393    my $input_format = $http->parameter ('i');    my $input_format = $http->get_parameter ('i');
1394    if (defined $input_format and length $input_format) {    if (defined $input_format and length $input_format) {
1395      $r->{media_type_overridden}      $r->{media_type_overridden}
1396          = (not defined $r->{media_type} or $input_format ne $r->{media_type});          = (not defined $r->{media_type} or $input_format ne $r->{media_type});
# Line 673  EOH Line 1404  EOH
1404    if ($r->{media_type} eq 'text/xml') {    if ($r->{media_type} eq 'text/xml') {
1405      unless (defined $r->{charset}) {      unless (defined $r->{charset}) {
1406        $r->{charset} = 'us-ascii';        $r->{charset} = 'us-ascii';
1407          $r->{official_charset} = $r->{charset};
1408      } elsif ($r->{charset_overridden} and $r->{charset} eq 'us-ascii') {      } elsif ($r->{charset_overridden} and $r->{charset} eq 'us-ascii') {
1409        $r->{charset_overridden} = 0;        $r->{charset_overridden} = 0;
1410      }      }
# Line 684  EOH Line 1416  EOH
1416      return $r;      return $r;
1417    }    }
1418    
1419      $r->{inner_html_element} = $http->get_parameter ('e');
1420    
1421    return $r;    return $r;
1422  } # get_input_document  } # get_input_document
1423    
# Line 716  Wakaba <w@suika.fam.cx>. Line 1450  Wakaba <w@suika.fam.cx>.
1450    
1451  =head1 LICENSE  =head1 LICENSE
1452    
1453  Copyright 2007 Wakaba <w@suika.fam.cx>  Copyright 2007-2008 Wakaba <w@suika.fam.cx>
1454    
1455  This library is free software; you can redistribute it  This library is free software; you can redistribute it
1456  and/or modify it under the same terms as Perl itself.  and/or modify it under the same terms as Perl itself.
Legend:
Removed from v.1.15  
changed lines
  Added in v.1.37
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24