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