/[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.19 by wakaba, Mon Sep 10 11:51:09 2007 UTC revision 1.45 by wakaba, Fri Mar 21 08:59:47 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/manakai2/lib];             /home/wakaba/work/manakai2/lib];
# Line 19  sub htescape ($) { Line 20  sub htescape ($) {
20    return $s;    return $s;
21  } # htescape  } # htescape
22    
23      my @nav;
24      my %time;
25      require Message::DOM::DOMImplementation;
26      my $dom = Message::DOM::DOMImplementation->new;
27    {
28    use Message::CGI::HTTP;    use Message::CGI::HTTP;
29    my $http = Message::CGI::HTTP->new;    my $http = Message::CGI::HTTP->new;
30    
# Line 30  sub htescape ($) { Line 36  sub htescape ($) {
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 51  sub htescape ($) { Line 53  sub htescape ($) {
53    
54    $| = 0;    $| = 0;
55    my $input = get_input_document ($http, $dom);    my $input = get_input_document ($http, $dom);
   my $inner_html_element = $http->get_parameter ('e');  
56    my $char_length = 0;    my $char_length = 0;
   my %time;  
57    
58    print qq[    print qq[
59  <div id="document-info" class="section">  <div id="document-info" class="section">
# Line 61  sub htescape ($) { Line 61  sub htescape ($) {
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    
# Line 73  if (defined $input->{s}) { Line 78  if (defined $input->{s}) {
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>
# Line 81  if (defined $input->{s}) { Line 86  if (defined $input->{s}) {
86      <dd>$char_length byte@{[$char_length == 1 ? '' : 's']}</dd>      <dd>$char_length byte@{[$char_length == 1 ? '' : 's']}</dd>
87  </dl>  </dl>
88  </div>  </div>
 ];  
   
   my $result = {};  
   print_http_header_section ($input, $result);  
   
   my $doc;  
   my $el;  
   
   if ($input->{media_type} eq 'text/html') {  
     ($doc, $el) = print_syntax_error_html_section ($input, $result);  
     print_source_string_section (\($input->{s}), $input->{charset});  
   } elsif ({  
             'text/xml' => 1,  
             'application/atom+xml' => 1,  
             'application/rss+xml' => 1,  
             'application/svg+xml' => 1,  
             'application/xhtml+xml' => 1,  
             'application/xml' => 1,  
            }->{$input->{media_type}}) {  
     ($doc, $el) = print_syntax_error_xml_section ($input, $result);  
     print_source_string_section (\($input->{s}), $doc->input_encoding);  
   } else {  
     ## TODO: Change HTTP status code??  
     print_result_unknown_type_section ($input);  
   }  
89    
90    if (defined $doc or defined $el) {  <script src="../cc-script.js"></script>
91      print_structure_dump_section ($doc, $el);  ];
     my $elements = print_structure_error_section ($doc, $el, $result);  
     print_table_section ($elements->{table}) if @{$elements->{table}};  
     print_id_section ($elements->{id}) if keys %{$elements->{id}};  
     print_term_section ($elements->{term}) if keys %{$elements->{term}};  
     print_class_section ($elements->{class}) if keys %{$elements->{class}};  
   }  
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);    print_result_section ($result);
98  } else {  } else {
99    print STDOUT qq[</dl></div>];    print STDOUT qq[</dl></div>];
# Line 134  if (defined $input->{s}) { Line 112  if (defined $input->{s}) {
112  </html>  </html>
113  ];  ];
114    
115    for (qw/decode parse parse_xml check/) {    for (qw/decode parse parse_html parse_xml parse_manifest
116              check check_manifest/) {
117      next unless defined $time{$_};      next unless defined $time{$_};
118      open my $file, '>>', ".cc-$_.txt" or die ".cc-$_.txt: $!";      open my $file, '>>', ".cc-$_.txt" or die ".cc-$_.txt: $!";
119      print $file $char_length, "\t", $time{$_}, "\n";      print $file $char_length, "\t", $time{$_}, "\n";
120    }    }
121    
122  exit;  exit;
123    }
124    
125  sub add_error ($$$) {  sub add_error ($$$) {
126    my ($layer, $err, $result) = @_;    my ($layer, $err, $result) = @_;
# Line 151  sub add_error ($$$) { Line 131  sub add_error ($$$) {
131        $result->{conforming_min} = 0;        $result->{conforming_min} = 0;
132      } elsif ($err->{level} eq 'w' or $err->{level} eq 'g') {      } elsif ($err->{level} eq 'w' or $err->{level} eq 'g') {
133        $result->{$layer}->{warning}++;        $result->{$layer}->{warning}++;
134      } elsif ($err->{level} eq 'unsupported') {      } elsif ($err->{level} eq 'u' or $err->{level} eq 'unsupported') {
135        $result->{$layer}->{unsupported}++;        $result->{$layer}->{unsupported}++;
136        $result->{unsupported} = 1;        $result->{unsupported} = 1;
137        } elsif ($err->{level} eq 'i') {
138          #
139      } else {      } else {
140        $result->{$layer}->{must}++;        $result->{$layer}->{must}++;
141        $result->{$layer}->{score_max} -= 2;        $result->{$layer}->{score_max} -= 2;
# Line 170  sub add_error ($$$) { Line 152  sub add_error ($$$) {
152    }    }
153  } # add_error  } # add_error
154    
155    sub check_and_print ($$) {
156      my ($input, $result) = @_;
157    
158      print_http_header_section ($input, $result);
159    
160      my $doc;
161      my $el;
162      my $cssom;
163      my $manifest;
164      my @subdoc;
165    
166      if ($input->{media_type} eq 'text/html') {
167        ($doc, $el) = print_syntax_error_html_section ($input, $result);
168        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                'image/svg+xml' => 1,
177                'application/xhtml+xml' => 1,
178                'application/xml' => 1,
179                ## TODO: Should we make all XML MIME Types fall
180                ## into this category?
181    
182                'application/rdf+xml' => 1, ## NOTE: This type has different model.
183               }->{$input->{media_type}}) {
184        ($doc, $el) = print_syntax_error_xml_section ($input, $result);
185        print_source_string_section ($input,
186                                     \($input->{s}),
187                                     $doc->input_encoding);
188      } elsif ($input->{media_type} eq 'text/css') {
189        $cssom = print_syntax_error_css_section ($input, $result);
190        print_source_string_section
191            ($input, \($input->{s}),
192             $cssom->manakai_input_encoding);
193      } elsif ($input->{media_type} eq 'text/cache-manifest') {
194    ## TODO: MUST be text/cache-manifest
195        $manifest = print_syntax_error_manifest_section ($input, $result);
196        print_source_string_section ($input, \($input->{s}),
197                                     'utf-8');
198      } else {
199        ## TODO: Change HTTP status code??
200        print_result_unknown_type_section ($input, $result);
201      }
202    
203      if (defined $doc or defined $el) {
204        $doc->document_uri ($input->{uri});
205        $doc->manakai_entity_base_uri ($input->{base_uri});
206        print_structure_dump_dom_section ($input, $doc, $el);
207        my $elements = print_structure_error_dom_section
208            ($input, $doc, $el, $result, sub {
209              push @subdoc, shift;
210            });
211        print_table_section ($input, $elements->{table}) if @{$elements->{table}};
212        print_listing_section ({
213          id => 'identifiers', label => 'IDs', heading => 'Identifiers',
214        }, $input, $elements->{id}) if keys %{$elements->{id}};
215        print_listing_section ({
216          id => 'terms', label => 'Terms', heading => 'Terms',
217        }, $input, $elements->{term}) if keys %{$elements->{term}};
218        print_listing_section ({
219          id => 'classes', label => 'Classes', heading => 'Classes',
220        }, $input, $elements->{class}) if keys %{$elements->{class}};
221        print_rdf_section ($input, $elements->{rdf}) if @{$elements->{rdf}};
222      } elsif (defined $cssom) {
223        print_structure_dump_cssom_section ($input, $cssom);
224        ## TODO: CSSOM validation
225        add_error ('structure', {level => 'u'} => $result);
226      } elsif (defined $manifest) {
227        print_structure_dump_manifest_section ($input, $manifest);
228        print_structure_error_manifest_section ($input, $manifest, $result);
229      }
230    
231      my $id_prefix = 0;
232      for my $subinput (@subdoc) {
233        $subinput->{id_prefix} = 'subdoc-' . ++$id_prefix;
234        $subinput->{nested} = 1;
235        $subinput->{base_uri} = $subinput->{container_node}->base_uri
236            unless defined $subinput->{base_uri};
237        my $ebaseuri = htescape ($subinput->{base_uri});
238        push @nav, ['#' . $subinput->{id_prefix} => 'Sub #' . $id_prefix];
239        print STDOUT qq[<div id="$subinput->{id_prefix}" class=section>
240          <h2>Subdocument #$id_prefix</h2>
241    
242          <dl>
243          <dt>Internet Media Type</dt>
244            <dd><code class="MIME" lang="en">@{[htescape $subinput->{media_type}]}</code>
245          <dt>Container Node</dt>
246            <dd>@{[get_node_link ($input, $subinput->{container_node})]}</dd>
247          <dt>Base <abbr title="Uniform Resource Identifiers">URI</abbr></dt>
248            <dd><code class=URI>&lt;<a href="$ebaseuri">$ebaseuri</a>></code></dd>
249          </dl>];              
250    
251        $subinput->{id_prefix} .= '-';
252        check_and_print ($subinput => $result);
253    
254        print STDOUT qq[</div>];
255      }
256    } # check_and_print
257    
258  sub print_http_header_section ($$) {  sub print_http_header_section ($$) {
259    my ($input, $result) = @_;    my ($input, $result) = @_;
260    return unless defined $input->{header_status_code} or    return unless defined $input->{header_status_code} or
261        defined $input->{header_status_text} or        defined $input->{header_status_text} or
262        @{$input->{header_field}};        @{$input->{header_field} or []};
263        
264    push @nav, ['#source-header' => 'HTTP Header'];    push @nav, ['#source-header' => 'HTTP Header'] unless $input->{nested};
265    print STDOUT qq[<div id="source-header" class="section">    print STDOUT qq[<div id="$input->{id_prefix}source-header" class="section">
266  <h2>HTTP Header</h2>  <h2>HTTP Header</h2>
267    
268  <p><strong>Note</strong>: Due to the limitation of the  <p><strong>Note</strong>: Due to the limitation of the
# Line 209  sub print_syntax_error_html_section ($$) Line 294  sub print_syntax_error_html_section ($$)
294        
295    require Encode;    require Encode;
296    require Whatpm::HTML;    require Whatpm::HTML;
   
   $input->{charset} ||= 'ISO-8859-1'; ## TODO: for now.  
297        
   my $time1 = time;  
   my $t = Encode::decode ($input->{charset}, $input->{s});  
   $time{decode} = time - $time1;  
   
298    print STDOUT qq[    print STDOUT qq[
299  <div id="parse-errors" class="section">  <div id="$input->{id_prefix}parse-errors" class="section">
300  <h2>Parse Errors</h2>  <h2>Parse Errors</h2>
301    
302  <dl>];  <dl id="$input->{id_prefix}parse-errors-list">];
303    push @nav, ['#parse-errors' => 'Parse Error'];    push @nav, ['#parse-errors' => 'Parse Error'] unless $input->{nested};
304    
305    my $onerror = sub {    my $onerror = sub {
306      my (%opt) = @_;      my (%opt) = @_;
307      my ($type, $cls, $msg) = get_text ($opt{type}, $opt{level});      my ($type, $cls, $msg) = get_text ($opt{type}, $opt{level});
308      if ($opt{column} > 0) {      print STDOUT qq[<dt class="$cls">], get_error_label ($input, \%opt),
309        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];  
     }  
310      $type =~ tr/ /-/;      $type =~ tr/ /-/;
311      $type =~ s/\|/%7C/g;      $type =~ s/\|/%7C/g;
312      $msg .= qq[ [<a href="../error-description#@{[htescape ($type)]}">Description</a>]];      $msg .= qq[ [<a href="../error-description#@{[htescape ($type)]}">Description</a>]];
313      print STDOUT qq[<dd class="$cls">$msg</dd>\n];      print STDOUT qq[<dd class="$cls">], get_error_level_label (\%opt);
314        print STDOUT qq[$msg</dd>\n];
315    
316      add_error ('syntax', \%opt => $result);      add_error ('syntax', \%opt => $result);
317    };    };
318    
319    my $doc = $dom->create_document;    my $doc = $dom->create_document;
320    my $el;    my $el;
321    $time1 = time;    my $inner_html_element = $input->{inner_html_element};
322    if (defined $inner_html_element and length $inner_html_element) {    if (defined $inner_html_element and length $inner_html_element) {
323        $input->{charset} ||= 'windows-1252'; ## TODO: for now.
324        my $time1 = time;
325        my $t = Encode::decode ($input->{charset}, $input->{s});
326        $time{decode} = time - $time1;
327        
328      $el = $doc->create_element_ns      $el = $doc->create_element_ns
329          ('http://www.w3.org/1999/xhtml', [undef, $inner_html_element]);          ('http://www.w3.org/1999/xhtml', [undef, $inner_html_element]);
330        $time1 = time;
331      Whatpm::HTML->set_inner_html ($el, $t, $onerror);      Whatpm::HTML->set_inner_html ($el, $t, $onerror);
332        $time{parse} = time - $time1;
333    } else {    } else {
334      Whatpm::HTML->parse_string ($t => $doc, $onerror);      my $time1 = time;
335        Whatpm::HTML->parse_byte_string
336            ($input->{charset}, $input->{s} => $doc, $onerror);
337        $time{parse_html} = time - $time1;
338    }    }
339    $time{parse} = time - $time1;    $doc->manakai_charset ($input->{official_charset})
340          if defined $input->{official_charset};
341      
342    print STDOUT qq[</dl></div>];    print STDOUT qq[</dl></div>];
343    
344    return ($doc, $el);    return ($doc, $el);
# Line 263  sub print_syntax_error_xml_section ($$) Line 350  sub print_syntax_error_xml_section ($$)
350    require Message::DOM::XMLParserTemp;    require Message::DOM::XMLParserTemp;
351        
352    print STDOUT qq[    print STDOUT qq[
353  <div id="parse-errors" class="section">  <div id="$input->{id_prefix}parse-errors" class="section">
354  <h2>Parse Errors</h2>  <h2>Parse Errors</h2>
355    
356  <dl>];  <dl id="$input->{id_prefix}parse-errors-list">];
357    push @nav, ['#parse-errors' => 'Parse Error'];    push @nav, ['#parse-errors' => 'Parse Error'] unless $input->{prefix};
358    
359    my $onerror = sub {    my $onerror = sub {
360      my $err = shift;      my $err = shift;
361      my $line = $err->location->line_number;      my $line = $err->location->line_number;
362      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 ];
363      print STDOUT $err->location->column_number, "</dt><dd>";      print STDOUT $err->location->column_number, "</dt><dd>";
364      print STDOUT htescape $err->text, "</dd>\n";      print STDOUT htescape $err->text, "</dd>\n";
365    
# Line 291  sub print_syntax_error_xml_section ($$) Line 378  sub print_syntax_error_xml_section ($$)
378    my $doc = Message::DOM::XMLParserTemp->parse_byte_stream    my $doc = Message::DOM::XMLParserTemp->parse_byte_stream
379        ($fh => $dom, $onerror, charset => $input->{charset});        ($fh => $dom, $onerror, charset => $input->{charset});
380    $time{parse_xml} = time - $time1;    $time{parse_xml} = time - $time1;
381      $doc->manakai_charset ($input->{official_charset})
382          if defined $input->{official_charset};
383    
384    print STDOUT qq[</dl></div>];    print STDOUT qq[</dl></div>];
385    
386    return ($doc, undef);    return ($doc, undef);
387  } # print_syntax_error_xml_section  } # print_syntax_error_xml_section
388    
389  sub print_source_string_section ($$) {  sub get_css_parser () {
390    require Encode;    our $CSSParser;
391    my $enc = Encode::find_encoding ($_[1]); ## TODO: charset name -> Perl name    return $CSSParser if $CSSParser;
392    return unless $enc;  
393      require Whatpm::CSS::Parser;
394      my $p = Whatpm::CSS::Parser->new;
395    
396      $p->{prop}->{$_} = 1 for qw/
397        alignment-baseline
398        background background-attachment background-color background-image
399        background-position background-position-x background-position-y
400        background-repeat border border-bottom border-bottom-color
401        border-bottom-style border-bottom-width border-collapse border-color
402        border-left border-left-color
403        border-left-style border-left-width border-right border-right-color
404        border-right-style border-right-width
405        border-spacing -manakai-border-spacing-x -manakai-border-spacing-y
406        border-style border-top border-top-color border-top-style border-top-width
407        border-width bottom
408        caption-side clear clip color content counter-increment counter-reset
409        cursor direction display dominant-baseline empty-cells float font
410        font-family font-size font-size-adjust font-stretch
411        font-style font-variant font-weight height left
412        letter-spacing line-height
413        list-style list-style-image list-style-position list-style-type
414        margin margin-bottom margin-left margin-right margin-top marker-offset
415        marks max-height max-width min-height min-width opacity -moz-opacity
416        orphans outline outline-color outline-style outline-width overflow
417        overflow-x overflow-y
418        padding padding-bottom padding-left padding-right padding-top
419        page page-break-after page-break-before page-break-inside
420        position quotes right size table-layout
421        text-align text-anchor text-decoration text-indent text-transform
422        top unicode-bidi vertical-align visibility white-space width widows
423        word-spacing writing-mode z-index
424      /;
425      $p->{prop_value}->{display}->{$_} = 1 for qw/
426        block clip inline inline-block inline-table list-item none
427        table table-caption table-cell table-column table-column-group
428        table-header-group table-footer-group table-row table-row-group
429        compact marker
430      /;
431      $p->{prop_value}->{position}->{$_} = 1 for qw/
432        absolute fixed relative static
433      /;
434      $p->{prop_value}->{float}->{$_} = 1 for qw/
435        left right none
436      /;
437      $p->{prop_value}->{clear}->{$_} = 1 for qw/
438        left right none both
439      /;
440      $p->{prop_value}->{direction}->{ltr} = 1;
441      $p->{prop_value}->{direction}->{rtl} = 1;
442      $p->{prop_value}->{marks}->{crop} = 1;
443      $p->{prop_value}->{marks}->{cross} = 1;
444      $p->{prop_value}->{'unicode-bidi'}->{$_} = 1 for qw/
445        normal bidi-override embed
446      /;
447      for my $prop_name (qw/overflow overflow-x overflow-y/) {
448        $p->{prop_value}->{$prop_name}->{$_} = 1 for qw/
449          visible hidden scroll auto -webkit-marquee -moz-hidden-unscrollable
450        /;
451      }
452      $p->{prop_value}->{visibility}->{$_} = 1 for qw/
453        visible hidden collapse
454      /;
455      $p->{prop_value}->{'list-style-type'}->{$_} = 1 for qw/
456        disc circle square decimal decimal-leading-zero
457        lower-roman upper-roman lower-greek lower-latin
458        upper-latin armenian georgian lower-alpha upper-alpha none
459        hebrew cjk-ideographic hiragana katakana hiragana-iroha
460        katakana-iroha
461      /;
462      $p->{prop_value}->{'list-style-position'}->{outside} = 1;
463      $p->{prop_value}->{'list-style-position'}->{inside} = 1;
464      $p->{prop_value}->{'page-break-before'}->{$_} = 1 for qw/
465        auto always avoid left right
466      /;
467      $p->{prop_value}->{'page-break-after'}->{$_} = 1 for qw/
468        auto always avoid left right
469      /;
470      $p->{prop_value}->{'page-break-inside'}->{auto} = 1;
471      $p->{prop_value}->{'page-break-inside'}->{avoid} = 1;
472      $p->{prop_value}->{'background-repeat'}->{$_} = 1 for qw/
473        repeat repeat-x repeat-y no-repeat
474      /;
475      $p->{prop_value}->{'background-attachment'}->{scroll} = 1;
476      $p->{prop_value}->{'background-attachment'}->{fixed} = 1;
477      $p->{prop_value}->{'font-size'}->{$_} = 1 for qw/
478        xx-small x-small small medium large x-large xx-large
479        -manakai-xxx-large -webkit-xxx-large
480        larger smaller
481      /;
482      $p->{prop_value}->{'font-style'}->{normal} = 1;
483      $p->{prop_value}->{'font-style'}->{italic} = 1;
484      $p->{prop_value}->{'font-style'}->{oblique} = 1;
485      $p->{prop_value}->{'font-variant'}->{normal} = 1;
486      $p->{prop_value}->{'font-variant'}->{'small-caps'} = 1;
487      $p->{prop_value}->{'font-stretch'}->{$_} = 1 for
488          qw/normal wider narrower ultra-condensed extra-condensed
489            condensed semi-condensed semi-expanded expanded
490            extra-expanded ultra-expanded/;
491      $p->{prop_value}->{'text-align'}->{$_} = 1 for qw/
492        left right center justify begin end
493      /;
494      $p->{prop_value}->{'text-transform'}->{$_} = 1 for qw/
495        capitalize uppercase lowercase none
496      /;
497      $p->{prop_value}->{'white-space'}->{$_} = 1 for qw/
498        normal pre nowrap pre-line pre-wrap -moz-pre-wrap
499      /;
500      $p->{prop_value}->{'writing-mode'}->{$_} = 1 for qw/
501        lr rl tb lr-tb rl-tb tb-rl
502      /;
503      $p->{prop_value}->{'text-anchor'}->{$_} = 1 for qw/
504        start middle end
505      /;
506      $p->{prop_value}->{'dominant-baseline'}->{$_} = 1 for qw/
507        auto use-script no-change reset-size ideographic alphabetic
508        hanging mathematical central middle text-after-edge text-before-edge
509      /;
510      $p->{prop_value}->{'alignment-baseline'}->{$_} = 1 for qw/
511        auto baseline before-edge text-before-edge middle central
512        after-edge text-after-edge ideographic alphabetic hanging
513        mathematical
514      /;
515      $p->{prop_value}->{'text-decoration'}->{$_} = 1 for qw/
516        none blink underline overline line-through
517      /;
518      $p->{prop_value}->{'caption-side'}->{$_} = 1 for qw/
519        top bottom left right
520      /;
521      $p->{prop_value}->{'table-layout'}->{auto} = 1;
522      $p->{prop_value}->{'table-layout'}->{fixed} = 1;
523      $p->{prop_value}->{'border-collapse'}->{collapse} = 1;
524      $p->{prop_value}->{'border-collapse'}->{separate} = 1;
525      $p->{prop_value}->{'empty-cells'}->{show} = 1;
526      $p->{prop_value}->{'empty-cells'}->{hide} = 1;
527      $p->{prop_value}->{cursor}->{$_} = 1 for qw/
528        auto crosshair default pointer move e-resize ne-resize nw-resize n-resize
529        se-resize sw-resize s-resize w-resize text wait help progress
530      /;
531      for my $prop (qw/border-top-style border-left-style
532                       border-bottom-style border-right-style outline-style/) {
533        $p->{prop_value}->{$prop}->{$_} = 1 for qw/
534          none hidden dotted dashed solid double groove ridge inset outset
535        /;
536      }
537      for my $prop (qw/color background-color
538                       border-bottom-color border-left-color border-right-color
539                       border-top-color border-color/) {
540        $p->{prop_value}->{$prop}->{transparent} = 1;
541        $p->{prop_value}->{$prop}->{flavor} = 1;
542        $p->{prop_value}->{$prop}->{'-manakai-default'} = 1;
543      }
544      $p->{prop_value}->{'outline-color'}->{invert} = 1;
545      $p->{prop_value}->{'outline-color'}->{'-manakai-invert-or-currentcolor'} = 1;
546      $p->{pseudo_class}->{$_} = 1 for qw/
547        active checked disabled empty enabled first-child first-of-type
548        focus hover indeterminate last-child last-of-type link only-child
549        only-of-type root target visited
550        lang nth-child nth-last-child nth-of-type nth-last-of-type not
551        -manakai-contains -manakai-current
552      /;
553      $p->{pseudo_element}->{$_} = 1 for qw/
554        after before first-letter first-line
555      /;
556    
557      return $CSSParser = $p;
558    } # get_css_parser
559    
560    sub print_syntax_error_css_section ($$) {
561      my ($input, $result) = @_;
562    
563      print STDOUT qq[
564    <div id="$input->{id_prefix}parse-errors" class="section">
565    <h2>Parse Errors</h2>
566    
567    <dl id="$input->{id_prefix}parse-errors-list">];
568      push @nav, ['#parse-errors' => 'Parse Error'] unless $input->{nested};
569    
570      my $p = get_css_parser ();
571      $p->init;
572      $p->{onerror} = sub {
573        my (%opt) = @_;
574        my ($type, $cls, $msg) = get_text ($opt{type}, $opt{level});
575        if ($opt{token}) {
576          print STDOUT qq[<dt class="$cls"><a href="#$input->{id_prefix}line-$opt{token}->{line}">Line $opt{token}->{line}</a> column $opt{token}->{column}];
577        } else {
578          print STDOUT qq[<dt class="$cls">Unknown location];
579        }
580        if (defined $opt{value}) {
581          print STDOUT qq[ (<code>@{[htescape ($opt{value})]}</code>)];
582        } elsif (defined $opt{token}) {
583          print STDOUT qq[ (<code>@{[htescape (Whatpm::CSS::Tokenizer->serialize_token ($opt{token}))]}</code>)];
584        }
585        $type =~ tr/ /-/;
586        $type =~ s/\|/%7C/g;
587        $msg .= qq[ [<a href="../error-description#@{[htescape ($type)]}">Description</a>]];
588        print STDOUT qq[<dd class="$cls">], get_error_level_label (\%opt);
589        print STDOUT qq[$msg</dd>\n];
590    
591        add_error ('syntax', \%opt => $result);
592      };
593      $p->{href} = $input->{uri};
594      $p->{base_uri} = $input->{base_uri};
595    
596    #  if ($parse_mode eq 'q') {
597    #    $p->{unitless_px} = 1;
598    #    $p->{hashless_color} = 1;
599    #  }
600    
601    ## TODO: Make $input->{s} a ref.
602    
603      my $s = \$input->{s};
604      my $charset;
605      unless ($input->{is_char_string}) {
606        require Encode;
607        if (defined $input->{charset}) {## TODO: IANA->Perl
608          $charset = $input->{charset};
609          $s = \(Encode::decode ($input->{charset}, $$s));
610        } else {
611          ## TODO: charset detection
612          $s = \(Encode::decode ($charset = 'utf-8', $$s));
613        }
614      }
615      
616      my $cssom = $p->parse_char_string ($$s);
617      $cssom->manakai_input_encoding ($charset) if defined $charset;
618    
619      print STDOUT qq[</dl></div>];
620    
621      return $cssom;
622    } # print_syntax_error_css_section
623    
624    sub print_syntax_error_manifest_section ($$) {
625      my ($input, $result) = @_;
626    
627      require Whatpm::CacheManifest;
628    
629      print STDOUT qq[
630    <div id="$input->{id_prefix}parse-errors" class="section">
631    <h2>Parse Errors</h2>
632    
633    <dl id="$input->{id_prefix}parse-errors-list">];
634      push @nav, ['#parse-errors' => 'Parse Error'] unless $input->{nested};
635    
636      my $onerror = sub {
637        my (%opt) = @_;
638        my ($type, $cls, $msg) = get_text ($opt{type}, $opt{level});
639        print STDOUT qq[<dt class="$cls">], get_error_label ($input, \%opt),
640            qq[</dt>];
641        $type =~ tr/ /-/;
642        $type =~ s/\|/%7C/g;
643        $msg .= qq[ [<a href="../error-description#@{[htescape ($type)]}">Description</a>]];
644        print STDOUT qq[<dd class="$cls">], get_error_level_label (\%opt);
645        print STDOUT qq[$msg</dd>\n];
646    
647        add_error ('syntax', \%opt => $result);
648      };
649    
650      my $time1 = time;
651      my $manifest = Whatpm::CacheManifest->parse_byte_string
652          ($input->{s}, $input->{uri}, $input->{base_uri}, $onerror);
653      $time{parse_manifest} = time - $time1;
654    
655      print STDOUT qq[</dl></div>];
656    
657      return $manifest;
658    } # print_syntax_error_manifest_section
659    
660    sub print_source_string_section ($$$) {
661      my $input = shift;
662      my $s;
663      unless ($input->{is_char_string}) {
664        require Encode;
665        my $enc = Encode::find_encoding ($_[1]); ## TODO: charset name -> Perl name
666        return unless $enc;
667    
668        $s = \($enc->decode (${$_[0]}));
669      } else {
670        $s = $_[0];
671      }
672    
   my $s = \($enc->decode (${$_[0]}));  
673    my $i = 1;                                my $i = 1;                            
674    push @nav, ['#source-string' => 'Source'];    push @nav, ['#source-string' => 'Source'] unless $input->{nested};
675    print STDOUT qq[<div id="source-string" class="section">    print STDOUT qq[<div id="$input->{id_prefix}source-string" class="section">
676  <h2>Document Source</h2>  <h2>Document Source</h2>
677  <ol lang="">\n];  <ol lang="">\n];
678    if (length $$s) {    if (length $$s) {
679      while ($$s =~ /\G([^\x0A]*?)\x0D?\x0A/gc) {      while ($$s =~ /\G([^\x0D\x0A]*?)(?>\x0D\x0A?|\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        $i++;        $i++;
683      }      }
684      if ($$s =~ /\G([^\x0A]+)/gc) {      if ($$s =~ /\G([^\x0D\x0A]+)/gc) {
685        print STDOUT qq[<li id="line-$i">], htescape $1, "</li>\n";        print STDOUT qq[<li id="$input->{id_prefix}line-$i">], htescape $1,
686              "</li>\n";
687      }      }
688    } else {    } else {
689      print STDOUT q[<li id="line-1"></li>];      print STDOUT q[<li id="$input->{id_prefix}line-1"></li>];
690    }    }
691    print STDOUT "</ol></div>";    print STDOUT "</ol></div>
692    <script>
693      addSourceToParseErrorList ('$input->{id_prefix}', 'parse-errors-list');
694    </script>";
695  } # print_input_string_section  } # print_input_string_section
696    
697  sub print_document_tree ($) {  sub print_document_tree ($$) {
698    my $node = shift;    my ($input, $node) = @_;
699    
700    my $r = '<ol class="xoxo">';    my $r = '<ol class="xoxo">';
701    
702    my @node = ($node);    my @node = ($node);
# Line 334  sub print_document_tree ($) { Line 707  sub print_document_tree ($) {
707        next;        next;
708      }      }
709    
710      my $node_id = 'node-'.refaddr $child;      my $node_id = $input->{id_prefix} . 'node-'.refaddr $child;
711      my $nt = $child->node_type;      my $nt = $child->node_type;
712      if ($nt == $child->ELEMENT_NODE) {      if ($nt == $child->ELEMENT_NODE) {
713        my $child_nsuri = $child->namespace_uri;        my $child_nsuri = $child->namespace_uri;
# Line 345  sub print_document_tree ($) { Line 718  sub print_document_tree ($) {
718          $r .= '<ul class="attributes">';          $r .= '<ul class="attributes">';
719          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 $_] }
720                        @{$child->attributes}) {                        @{$child->attributes}) {
721            $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?
722            $r .= '<q>' . htescape ($attr->[1]) . '</q></li>'; ## TODO: children            $r .= '<q>' . htescape ($attr->[1]) . '</q></li>'; ## TODO: children
723          }          }
724          $r .= '</ul>';          $r .= '</ul>';
# Line 366  sub print_document_tree ($) { Line 739  sub print_document_tree ($) {
739      } elsif ($nt == $child->DOCUMENT_NODE) {      } elsif ($nt == $child->DOCUMENT_NODE) {
740        $r .= qq'<li id="$node_id" class="tree-document">Document';        $r .= qq'<li id="$node_id" class="tree-document">Document';
741        $r .= qq[<ul class="attributes">];        $r .= qq[<ul class="attributes">];
742          my $cp = $child->manakai_charset;
743          if (defined $cp) {
744            $r .= qq[<li><code>charset</code> parameter = <code>];
745            $r .= htescape ($cp) . qq[</code></li>];
746          }
747          $r .= qq[<li><code>inputEncoding</code> = ];
748          my $ie = $child->input_encoding;
749          if (defined $ie) {
750            $r .= qq[<code>@{[htescape ($ie)]}</code>];
751            if ($child->manakai_has_bom) {
752              $r .= qq[ (with <code class=charname><abbr>BOM</abbr></code>)];
753            }
754          } else {
755            $r .= qq[(<code>null</code>)];
756          }
757        $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>];
758        $r .= qq[<li>@{[scalar get_text ('manakaiCompatMode:'.$child->manakai_compat_mode)]}</li>];        $r .= qq[<li>@{[scalar get_text ('manakaiCompatMode:'.$child->manakai_compat_mode)]}</li>];
759        unless ($child->manakai_is_html) {        unless ($child->manakai_is_html) {
# Line 399  sub print_document_tree ($) { Line 787  sub print_document_tree ($) {
787    print STDOUT $r;    print STDOUT $r;
788  } # print_document_tree  } # print_document_tree
789    
790  sub print_structure_dump_section ($$) {  sub print_structure_dump_dom_section ($$$) {
791    my ($doc, $el) = @_;    my ($input, $doc, $el) = @_;
792    
793      print STDOUT qq[
794    <div id="$input->{id_prefix}document-tree" class="section">
795    <h2>Document Tree</h2>
796    ];
797      push @nav, [qq[#$input->{id_prefix}document-tree] => 'Tree']
798          unless $input->{nested};
799    
800      print_document_tree ($input, $el || $doc);
801    
802      print STDOUT qq[</div>];
803    } # print_structure_dump_dom_section
804    
805    sub print_structure_dump_cssom_section ($$) {
806      my ($input, $cssom) = @_;
807    
808    print STDOUT qq[    print STDOUT qq[
809  <div id="document-tree" class="section">  <div id="$input->{id_prefix}document-tree" class="section">
810  <h2>Document Tree</h2>  <h2>Document Tree</h2>
811  ];  ];
812    push @nav, ['#document-tree' => 'Tree'];    push @nav, [qq[#$input->{id_prefix}document-tree] => 'Tree']
813          unless $input->{nested};
814    
815    print_document_tree ($el || $doc);    ## TODO:
816      print STDOUT "<pre>".htescape ($cssom->css_text)."</pre>";
817    
818    print STDOUT qq[</div>];    print STDOUT qq[</div>];
819  } # print_structure_dump_section  } # print_structure_dump_cssom_section
820    
821  sub print_structure_error_section ($$$) {  sub print_structure_dump_manifest_section ($$) {
822    my ($doc, $el, $result) = @_;    my ($input, $manifest) = @_;
823    
824    print STDOUT qq[<div id="document-errors" class="section">    print STDOUT qq[
825    <div id="$input->{id_prefix}dump-manifest" class="section">
826    <h2>Cache Manifest</h2>
827    ];
828      push @nav, [qq[#$input->{id_prefix}dump-manifest] => 'Cache Manifest']
829          unless $input->{nested};
830    
831      print STDOUT qq[<dl><dt>Explicit entries</dt>];
832      my $i = 0;
833      for my $uri (@{$manifest->[0]}) {
834        my $euri = htescape ($uri);
835        print STDOUT qq[<dd id="$input->{id_prefix}index-@{[$i++]}"><code class=uri>&lt;<a href="$euri">$euri</a>></code></dd>];
836      }
837    
838      print STDOUT qq[<dt>Fallback entries</dt><dd>
839          <table><thead><tr><th scope=row>Oppotunistic Caching Namespace</th>
840          <th scope=row>Fallback Entry</tr><tbody>];
841      for my $uri (sort {$a cmp $b} keys %{$manifest->[1]}) {
842        my $euri = htescape ($uri);
843        my $euri2 = htescape ($manifest->[1]->{$uri});
844        print STDOUT qq[<tr><td id="$input->{id_prefix}index-@{[$i++]}"><code class=uri>&lt;<a href="$euri">$euri</a>></code></td>
845            <td id="$input->{id_prefix}index-@{[$i++]}"><code class=uri>&lt;<a href="$euri2">$euri2</a>></code></td>];
846      }
847    
848      print STDOUT qq[</table><dt>Online whitelist</dt>];
849      for my $uri (@{$manifest->[2]}) {
850        my $euri = htescape ($uri);
851        print STDOUT qq[<dd id="$input->{id_prefix}index-@{[$i++]}"><code class=uri>&lt;<a href="$euri">$euri</a>></code></dd>];
852      }
853    
854      print STDOUT qq[</dl></div>];
855    } # print_structure_dump_manifest_section
856    
857    sub print_structure_error_dom_section ($$$$$) {
858      my ($input, $doc, $el, $result, $onsubdoc) = @_;
859    
860      print STDOUT qq[<div id="$input->{id_prefix}document-errors" class="section">
861  <h2>Document Errors</h2>  <h2>Document Errors</h2>
862    
863  <dl>];  <dl id=document-errors-list>];
864    push @nav, ['#document-errors' => 'Document Error'];    push @nav, [qq[#$input->{id_prefix}document-errors] => 'Document Error']
865          unless $input->{nested};
866    
867    require Whatpm::ContentChecker;    require Whatpm::ContentChecker;
868    my $onerror = sub {    my $onerror = sub {
# Line 429  sub print_structure_error_section ($$$) Line 871  sub print_structure_error_section ($$$)
871      $type =~ tr/ /-/;      $type =~ tr/ /-/;
872      $type =~ s/\|/%7C/g;      $type =~ s/\|/%7C/g;
873      $msg .= qq[ [<a href="../error-description#@{[htescape ($type)]}">Description</a>]];      $msg .= qq[ [<a href="../error-description#@{[htescape ($type)]}">Description</a>]];
874      print STDOUT qq[<dt class="$cls">] . get_node_link ($opt{node}) .      print STDOUT qq[<dt class="$cls">] . get_error_label ($input, \%opt) .
875          qq[</dt>\n<dd class="$cls">], $msg, "</dd>\n";          qq[</dt>\n<dd class="$cls">], get_error_level_label (\%opt);
876        print STDOUT $msg, "</dd>\n";
877      add_error ('structure', \%opt => $result);      add_error ('structure', \%opt => $result);
878    };    };
879    
880    my $elements;    my $elements;
881    my $time1 = time;    my $time1 = time;
882    if ($el) {    if ($el) {
883      $elements = Whatpm::ContentChecker->check_element ($el, $onerror);      $elements = Whatpm::ContentChecker->check_element
884            ($el, $onerror, $onsubdoc);
885    } else {    } else {
886      $elements = Whatpm::ContentChecker->check_document ($doc, $onerror);      $elements = Whatpm::ContentChecker->check_document
887            ($doc, $onerror, $onsubdoc);
888    }    }
889    $time{check} = time - $time1;    $time{check} = time - $time1;
890    
891    print STDOUT qq[</dl></div>];    print STDOUT qq[</dl>
892    <script>
893      addSourceToParseErrorList ('$input->{id_prefix}', 'document-errors-list');
894    </script></div>];
895    
896    return $elements;    return $elements;
897  } # print_structure_error_section  } # print_structure_error_dom_section
898    
899    sub print_structure_error_manifest_section ($$$) {
900      my ($input, $manifest, $result) = @_;
901    
902      print STDOUT qq[<div id="$input->{id_prefix}document-errors" class="section">
903    <h2>Document Errors</h2>
904    
905    <dl>];
906      push @nav, [qq[#$input->{id_prefix}document-errors] => 'Document Error']
907          unless $input->{nested};
908    
909      require Whatpm::CacheManifest;
910      Whatpm::CacheManifest->check_manifest ($manifest, sub {
911        my %opt = @_;
912        my ($type, $cls, $msg) = get_text ($opt{type}, $opt{level}, $opt{node});
913        $type =~ tr/ /-/;
914        $type =~ s/\|/%7C/g;
915        $msg .= qq[ [<a href="../error-description#@{[htescape ($type)]}">Description</a>]];
916        print STDOUT qq[<dt class="$cls">] . get_error_label ($input, \%opt) .
917            qq[</dt>\n<dd class="$cls">], $msg, "</dd>\n";
918        add_error ('structure', \%opt => $result);
919      });
920    
921  sub print_table_section ($) {    print STDOUT qq[</div>];
922    my $tables = shift;  } # print_structure_error_manifest_section
923    
924    sub print_table_section ($$) {
925      my ($input, $tables) = @_;
926        
927    push @nav, ['#tables' => 'Tables'];    push @nav, [qq[#$input->{id_prefix}tables] => 'Tables']
928          unless $input->{nested};
929    print STDOUT qq[    print STDOUT qq[
930  <div id="tables" class="section">  <div id="$input->{id_prefix}tables" class="section">
931  <h2>Tables</h2>  <h2>Tables</h2>
932    
933  <!--[if IE]><script type="text/javascript" src="../excanvas.js"></script><![endif]-->  <!--[if IE]><script type="text/javascript" src="../excanvas.js"></script><![endif]-->
# Line 468  sub print_table_section ($) { Line 942  sub print_table_section ($) {
942    my $i = 0;    my $i = 0;
943    for my $table_el (@$tables) {    for my $table_el (@$tables) {
944      $i++;      $i++;
945      print STDOUT qq[<div class="section" id="table-$i"><h3>] .      print STDOUT qq[<div class="section" id="$input->{id_prefix}table-$i"><h3>] .
946          get_node_link ($table_el) . q[</h3>];          get_node_link ($input, $table_el) . q[</h3>];
947    
948      ## TODO: Make |ContentChecker| return |form_table| result      ## TODO: Make |ContentChecker| return |form_table| result
949      ## so that this script don't have to run the algorithm twice.      ## so that this script don't have to run the algorithm twice.
# Line 501  sub print_table_section ($) { Line 975  sub print_table_section ($) {
975                    
976      print STDOUT '</div><script type="text/javascript">tableToCanvas (';      print STDOUT '</div><script type="text/javascript">tableToCanvas (';
977      print STDOUT JSON::objToJson ($table);      print STDOUT JSON::objToJson ($table);
978      print STDOUT qq[, document.getElementById ('table-$i'));</script>];      print STDOUT qq[, document.getElementById ('$input->{id_prefix}table-$i')];
979        print STDOUT qq[, '$input->{id_prefix}');</script>];
980    }    }
981        
982    print STDOUT qq[</div>];    print STDOUT qq[</div>];
983  } # print_table_section  } # print_table_section
984    
985  sub print_id_section ($) {  sub print_listing_section ($$$) {
986    my $ids = shift;    my ($opt, $input, $ids) = @_;
987        
988    push @nav, ['#identifiers' => 'IDs'];    push @nav, ['#' . $input->{id_prefix} . $opt->{id} => $opt->{label}]
989          unless $input->{nested};
990    print STDOUT qq[    print STDOUT qq[
991  <div id="identifiers" class="section">  <div id="$input->{id_prefix}$opt->{id}" class="section">
992  <h2>Identifiers</h2>  <h2>$opt->{heading}</h2>
993    
994  <dl>  <dl>
995  ];  ];
996    for my $id (sort {$a cmp $b} keys %$ids) {    for my $id (sort {$a cmp $b} keys %$ids) {
997      print STDOUT qq[<dt><code>@{[htescape $id]}</code></dt>];      print STDOUT qq[<dt><code>@{[htescape $id]}</code></dt>];
998      for (@{$ids->{$id}}) {      for (@{$ids->{$id}}) {
999        print STDOUT qq[<dd>].get_node_link ($_).qq[</dd>];        print STDOUT qq[<dd>].get_node_link ($input, $_).qq[</dd>];
1000      }      }
1001    }    }
1002    print STDOUT qq[</dl></div>];    print STDOUT qq[</dl></div>];
1003  } # print_id_section  } # print_listing_section
1004    
1005  sub print_term_section ($) {  sub print_rdf_section ($$$) {
1006    my $terms = shift;    my ($input, $rdfs) = @_;
1007        
1008    push @nav, ['#terms' => 'Terms'];    push @nav, ['#' . $input->{id_prefix} . 'rdf' => 'RDF']
1009          unless $input->{nested};
1010    print STDOUT qq[    print STDOUT qq[
1011  <div id="terms" class="section">  <div id="$input->{id_prefix}rdf" class="section">
1012  <h2>Terms</h2>  <h2>RDF Triples</h2>
1013    
1014  <dl>  <dl>];
1015  ];    my $i = 0;
1016    for my $term (sort {$a cmp $b} keys %$terms) {    for my $rdf (@$rdfs) {
1017      print STDOUT qq[<dt>@{[htescape $term]}</dt>];      print STDOUT qq[<dt id="$input->{id_prefix}rdf-@{[$i++]}">];
1018      for (@{$terms->{$term}}) {      print STDOUT get_node_link ($input, $rdf->[0]);
1019        print STDOUT qq[<dd>].get_node_link ($_).qq[</dd>];      print STDOUT qq[<dd><dl>];
1020        for my $triple (@{$rdf->[1]}) {
1021          print STDOUT '<dt>' . get_node_link ($input, $triple->[0]) . '<dd>';
1022          print STDOUT get_rdf_resource_html ($triple->[1]);
1023          print STDOUT ' ';
1024          print STDOUT get_rdf_resource_html ($triple->[2]);
1025          print STDOUT ' ';
1026          print STDOUT get_rdf_resource_html ($triple->[3]);
1027      }      }
1028        print STDOUT qq[</dl>];
1029    }    }
1030    print STDOUT qq[</dl></div>];    print STDOUT qq[</dl></div>];
1031  } # print_term_section  } # print_rdf_section
1032    
1033  sub print_class_section ($) {  sub get_rdf_resource_html ($) {
1034    my $classes = shift;    my $resource = shift;
1035        if ($resource->{uri}) {
1036    push @nav, ['#classes' => 'Classes'];      my $euri = htescape ($resource->{uri});
1037    print STDOUT qq[      return '<code class=uri>&lt;<a href="' . $euri . '">' . $euri .
1038  <div id="classes" class="section">          '</a>></code>';
1039  <h2>Classes</h2>    } elsif ($resource->{bnodeid}) {
1040        return htescape ('_:' . $resource->{bnodeid});
1041  <dl>    } elsif ($resource->{nodes}) {
1042  ];      return '(rdf:XMLLiteral)';
1043    for my $class (sort {$a cmp $b} keys %$classes) {    } elsif (defined $resource->{value}) {
1044      print STDOUT qq[<dt><code>@{[htescape $class]}</code></dt>];      my $elang = htescape (defined $resource->{language}
1045      for (@{$classes->{$class}}) {                                ? $resource->{language} : '');
1046        print STDOUT qq[<dd>].get_node_link ($_).qq[</dd>];      my $r = qq[<q lang="$elang">] . htescape ($resource->{value}) . '</q>';
1047        if (defined $resource->{datatype}) {
1048          my $euri = htescape ($resource->{datatype});
1049          $r .= '^^<code class=uri>&lt;<a href="' . $euri . '">' . $euri .
1050              '</a>></code>';
1051        } elsif (length $resource->{language}) {
1052          $r .= '@' . htescape ($resource->{language});
1053      }      }
1054        return $r;
1055      } else {
1056        return '??';
1057    }    }
1058    print STDOUT qq[</dl></div>];  } # get_rdf_resource_html
 } # print_class_section  
1059    
1060  sub print_result_section ($) {  sub print_result_section ($) {
1061    my $result = shift;    my $result = shift;
# Line 571  sub print_result_section ($) { Line 1064  sub print_result_section ($) {
1064  <div id="result-summary" class="section">  <div id="result-summary" class="section">
1065  <h2>Result</h2>];  <h2>Result</h2>];
1066    
1067    if ($result->{unsupported}) {      if ($result->{unsupported} and $result->{conforming_max}) {  
1068      print STDOUT qq[<p class=uncertain id=result-para>The conformance      print STDOUT qq[<p class=uncertain id=result-para>The conformance
1069          checker cannot decide whether the document is conforming or          checker cannot decide whether the document is conforming or
1070          not, since the document contains one or more unsupported          not, since the document contains one or more unsupported
1071          features.</p>];          features.  The document might or might not be conforming.</p>];
1072    } elsif ($result->{conforming_min}) {    } elsif ($result->{conforming_min}) {
1073      print STDOUT qq[<p class=PASS id=result-para>No conformance-error is      print STDOUT qq[<p class=PASS id=result-para>No conformance-error is
1074          found in this document.</p>];          found in this document.</p>];
# Line 591  sub print_result_section ($) { Line 1084  sub print_result_section ($) {
1084    print STDOUT qq[<table>    print STDOUT qq[<table>
1085  <colgroup><col><colgroup><col><col><col><colgroup><col>  <colgroup><col><colgroup><col><col><col><colgroup><col>
1086  <thead>  <thead>
1087  <tr><th scope=col></th><th scope=col><em class=rfc2119>MUST</em>-level  <tr><th scope=col></th>
1088  Errors</th><th scope=col><em class=rfc2119>SHOULD</em>-level  <th scope=col><a href="../error-description#level-m"><em class=rfc2119>MUST</em>‐level
1089  Errors</th><th scope=col>Warnings</th><th scope=col>Score</th></tr>  Errors</a></th>
1090  </thead><tbody>];  <th scope=col><a href="../error-description#level-s"><em class=rfc2119>SHOULD</em>‐level
1091    Errors</a></th>
1092    <th scope=col><a href="../error-description#level-w">Warnings</a></th>
1093    <th scope=col>Score</th></tr></thead><tbody>];
1094    
1095    my $must_error = 0;    my $must_error = 0;
1096    my $should_error = 0;    my $should_error = 0;
# Line 602  Errors</th><th scope=col>Warnings</th><t Line 1098  Errors</th><th scope=col>Warnings</th><t
1098    my $score_min = 0;    my $score_min = 0;
1099    my $score_max = 0;    my $score_max = 0;
1100    my $score_base = 20;    my $score_base = 20;
1101      my $score_unit = $score_base / 100;
1102    for (    for (
1103      [Transfer => 'transfer', ''],      [Transfer => 'transfer', ''],
1104      [Character => 'char', ''],      [Character => 'char', ''],
# Line 611  Errors</th><th scope=col>Warnings</th><t Line 1108  Errors</th><th scope=col>Warnings</th><t
1108      $must_error += ($result->{$_->[1]}->{must} += 0);      $must_error += ($result->{$_->[1]}->{must} += 0);
1109      $should_error += ($result->{$_->[1]}->{should} += 0);      $should_error += ($result->{$_->[1]}->{should} += 0);
1110      $warning += ($result->{$_->[1]}->{warning} += 0);      $warning += ($result->{$_->[1]}->{warning} += 0);
1111      $score_min += ($result->{$_->[1]}->{score_min} += $score_base);      $score_min += (($result->{$_->[1]}->{score_min} *= $score_unit) += $score_base);
1112      $score_max += ($result->{$_->[1]}->{score_max} += $score_base);      $score_max += (($result->{$_->[1]}->{score_max} *= $score_unit) += $score_base);
1113    
1114      my $uncertain = $result->{$_->[1]}->{unsupported} ? '?' : '';      my $uncertain = $result->{$_->[1]}->{unsupported} ? '?' : '';
1115      my $label = $_->[0];      my $label = $_->[0];
# Line 625  Errors</th><th scope=col>Warnings</th><t Line 1122  Errors</th><th scope=col>Warnings</th><t
1122    
1123      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>];      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>];
1124      if ($uncertain) {      if ($uncertain) {
1125        print qq[<td class="@{[$score_max < $score_base ? $score_min < $score_max ? 'FAIL' : 'SEE-RESULT' : '']}">&#x2212;&#x221E;..$result->{$_->[1]}->{score_max}</td>];        print qq[<td class="@{[$result->{$_->[1]}->{must} ? 'FAIL' : $result->{$_->[1]}->{should} ? 'SEE-RESULT' : '']}">&#x2212;&#x221E;..$result->{$_->[1]}->{score_max}</td>];
1126      } elsif ($result->{$_->[1]}->{score_min} != $result->{$_->[1]}->{score_max}) {      } elsif ($result->{$_->[1]}->{score_min} != $result->{$_->[1]}->{score_max}) {
1127        print qq[<td class="@{[$score_max < $score_base ? 'FAIL' : 'SEE-RESULT']}">$result->{$_->[1]}->{score_min}..$result->{$_->[1]}->{score_max} + $score_base</td></tr>];        print qq[<td class="@{[$result->{$_->[1]}->{must} ? 'FAIL' : 'SEE-RESULT']}">$result->{$_->[1]}->{score_min}..$result->{$_->[1]}->{score_max}</td></tr>];
1128      } else {      } else {
1129        print qq[<td class="@{[$score_max < $score_base ? 'FAIL' : '']}">$result->{$_->[1]}->{score_min}</td></tr>];        print qq[<td class="@{[$result->{$_->[1]}->{must} ? 'FAIL' : '']}">$result->{$_->[1]}->{score_min}</td></tr>];
1130      }      }
1131    }    }
1132    
# Line 638  Errors</th><th scope=col>Warnings</th><t Line 1135  Errors</th><th scope=col>Warnings</th><t
1135    print STDOUT qq[    print STDOUT qq[
1136  <tr class=uncertain><th scope=row>Semantics</th><td>0?</td><td>0?</td><td>0?</td><td>&#x2212;&#x221E;..$score_base</td></tr>  <tr class=uncertain><th scope=row>Semantics</th><td>0?</td><td>0?</td><td>0?</td><td>&#x2212;&#x221E;..$score_base</td></tr>
1137  </tbody>  </tbody>
1138  <tfoot><tr class=uncertain><th scope=row>Total</th><td>$must_error?</td><td>$should_error?</td><td>$warning?</td><td><strong>&#x2212;&#x221E;..$score_max</strong></td></tr></tfoot>  <tfoot><tr class=uncertain><th scope=row>Total</th>
1139    <td class="@{[$must_error ? 'FAIL' : '']}">$must_error?</td>
1140    <td class="@{[$should_error ? 'SEE-RESULT' : '']}">$should_error?</td>
1141    <td>$warning?</td>
1142    <td class="@{[$must_error ? 'FAIL' : $should_error ? 'SEE-RESULT' : '']}"><strong>&#x2212;&#x221E;..$score_max</strong></td></tr></tfoot>
1143  </table>  </table>
1144    
1145  <p><strong>Important</strong>: This conformance checking service  <p><strong>Important</strong>: This conformance checking service
# Line 647  is <em>under development</em>.  The resu Line 1148  is <em>under development</em>.  The resu
1148    push @nav, ['#result-summary' => 'Result'];    push @nav, ['#result-summary' => 'Result'];
1149  } # print_result_section  } # print_result_section
1150    
1151  sub print_result_unknown_type_section ($) {  sub print_result_unknown_type_section ($$) {
1152    my $input = shift;    my ($input, $result) = @_;
1153    
1154      my $euri = htescape ($input->{uri});
1155    print STDOUT qq[    print STDOUT qq[
1156  <div id="result-summary" class="section">  <div id="$input->{id_prefix}parse-errors" class="section">
1157  <p><em>Media type <code class="MIME" lang="en">@{[htescape $input->{media_type}]}</code> is not supported!</em></p>  <h2>Errors</h2>
1158    
1159    <dl>
1160    <dt class=unsupported><code>&lt;<a href="$euri">$euri</a>&gt;</code></dt>
1161        <dd class=unsupported><strong><a href="../error-description#level-u">Not
1162            supported</a></strong>:
1163        Media type
1164        <code class="MIME" lang="en">@{[htescape $input->{media_type}]}</code>
1165        is not supported.</dd>
1166    </dl>
1167  </div>  </div>
1168  ];  ];
1169    push @nav, ['#result-summary' => 'Result'];    push @nav, [qq[#$input->{id_prefix}parse-errors] => 'Errors']
1170          unless $input->{nested};
1171      add_error (char => {level => 'u'} => $result);
1172      add_error (syntax => {level => 'u'} => $result);
1173      add_error (structure => {level => 'u'} => $result);
1174  } # print_result_unknown_type_section  } # print_result_unknown_type_section
1175    
1176  sub print_result_input_error_section ($) {  sub print_result_input_error_section ($) {
# Line 664  sub print_result_input_error_section ($) Line 1179  sub print_result_input_error_section ($)
1179  <p><em><strong>Input Error</strong>: @{[htescape ($input->{error_status_text})]}</em></p>  <p><em><strong>Input Error</strong>: @{[htescape ($input->{error_status_text})]}</em></p>
1180  </div>];  </div>];
1181    push @nav, ['#result-summary' => 'Result'];    push @nav, ['#result-summary' => 'Result'];
1182  } # print_Result_input_error_section  } # print_result_input_error_section
1183    
1184    sub get_error_label ($$) {
1185      my ($input, $err) = @_;
1186    
1187      my $r = '';
1188    
1189      my $line;
1190      my $column;
1191        
1192      if (defined $err->{node}) {
1193        $line = $err->{node}->get_user_data ('manakai_source_line');
1194        if (defined $line) {
1195          $column = $err->{node}->get_user_data ('manakai_source_column');
1196        } else {
1197          if ($err->{node}->node_type == $err->{node}->ATTRIBUTE_NODE) {
1198            my $owner = $err->{node}->owner_element;
1199            $line = $owner->get_user_data ('manakai_source_line');
1200            $column = $owner->get_user_data ('manakai_source_column');
1201          } else {
1202            my $parent = $err->{node}->parent_node;
1203            if ($parent) {
1204              $line = $parent->get_user_data ('manakai_source_line');
1205              $column = $parent->get_user_data ('manakai_source_column');
1206            }
1207          }
1208        }
1209      }
1210      unless (defined $line) {
1211        if (defined $err->{token} and defined $err->{token}->{line}) {
1212          $line = $err->{token}->{line};
1213          $column = $err->{token}->{column};
1214        } elsif (defined $err->{line}) {
1215          $line = $err->{line};
1216          $column = $err->{column};
1217        }
1218      }
1219    
1220      if (defined $line) {
1221        if (defined $column and $column > 0) {
1222          $r = qq[<a href="#$input->{id_prefix}line-$line">Line $line</a> column $column];
1223        } else {
1224          $line = $line - 1 || 1;
1225          $r = qq[<a href="#$input->{id_prefix}line-$line">Line $line</a>];
1226        }
1227      }
1228    
1229      if (defined $err->{node}) {
1230        $r .= ' ' if length $r;
1231        $r .= get_node_link ($input, $err->{node});
1232      }
1233    
1234      if (defined $err->{index}) {
1235        if (length $r) {
1236          $r .= ', Index ' . (0+$err->{index});
1237        } else {
1238          $r .= "<a href='#$input->{id_prefix}index-@{[0+$err->{index}]}'>Index "
1239              . (0+$err->{index}) . '</a>';
1240        }
1241      }
1242    
1243      if (defined $err->{value}) {
1244        $r .= ' ' if length $r;
1245        $r .= '<q><code>' . htescape ($err->{value}) . '</code></q>';
1246      }
1247    
1248      return $r;
1249    } # get_error_label
1250    
1251    sub get_error_level_label ($) {
1252      my $err = shift;
1253    
1254      my $r = '';
1255    
1256      if (not defined $err->{level} or $err->{level} eq 'm') {
1257        $r = qq[<strong><a href="../error-description#level-m"><em class=rfc2119>MUST</em>‐level
1258            error</a></strong>: ];
1259      } elsif ($err->{level} eq 's') {
1260        $r = qq[<strong><a href="../error-description#level-s"><em class=rfc2119>SHOULD</em>‐level
1261            error</a></strong>: ];
1262      } elsif ($err->{level} eq 'w') {
1263        $r = qq[<strong><a href="../error-description#level-w">Warning</a></strong>:
1264            ];
1265      } elsif ($err->{level} eq 'u' or $err->{level} eq 'unsupported') {
1266        $r = qq[<strong><a href="../error-description#level-u">Not
1267            supported</a></strong>: ];
1268      } elsif ($err->{level} eq 'i') {
1269        $r = qq[<strong><a href="../error-description#level-i">Information</a></strong>: ];
1270      } else {
1271        my $elevel = htescape ($err->{level});
1272        $r = qq[<strong><a href="../error-description#level-$elevel">$elevel</a></strong>:
1273            ];
1274      }
1275    
1276      return $r;
1277    } # get_error_level_label
1278    
1279  sub get_node_path ($) {  sub get_node_path ($) {
1280    my $node = shift;    my $node = shift;
# Line 693  sub get_node_path ($) { Line 1303  sub get_node_path ($) {
1303    return join '/', @r;    return join '/', @r;
1304  } # get_node_path  } # get_node_path
1305    
1306  sub get_node_link ($) {  sub get_node_link ($$) {
1307    return qq[<a href="#node-@{[refaddr $_[0]]}">] .    return qq[<a href="#$_[0]->{id_prefix}node-@{[refaddr $_[1]]}">] .
1308        htescape (get_node_path ($_[0])) . qq[</a>];        htescape (get_node_path ($_[1])) . qq[</a>];
1309  } # get_node_link  } # get_node_link
1310    
1311  {  {
# Line 703  sub get_node_link ($) { Line 1313  sub get_node_link ($) {
1313    
1314  sub load_text_catalog ($) {  sub load_text_catalog ($) {
1315    my $lang = shift; # MUST be a canonical lang name    my $lang = shift; # MUST be a canonical lang name
1316    open my $file, '<', "cc-msg.$lang.txt" or die "$0: cc-msg.$lang.txt: $!";    open my $file, '<:utf8', "cc-msg.$lang.txt"
1317          or die "$0: cc-msg.$lang.txt: $!";
1318    while (<$file>) {    while (<$file>) {
1319      if (s/^([^;]+);([^;]*);//) {      if (s/^([^;]+);([^;]*);//) {
1320        my ($type, $cls, $msg) = ($1, $2, $_);        my ($type, $cls, $msg) = ($1, $2, $_);
# Line 716  sub load_text_catalog ($) { Line 1327  sub load_text_catalog ($) {
1327  sub get_text ($) {  sub get_text ($) {
1328    my ($type, $level, $node) = @_;    my ($type, $level, $node) = @_;
1329    $type = $level . ':' . $type if defined $level;    $type = $level . ':' . $type if defined $level;
1330      $level = 'm' unless defined $level;
1331    my @arg;    my @arg;
1332    {    {
1333      if (defined $Msg->{$type}) {      if (defined $Msg->{$type}) {
# Line 740  sub get_text ($) { Line 1352  sub get_text ($) {
1352            ? htescape ($node->owner_element->manakai_local_name)            ? htescape ($node->owner_element->manakai_local_name)
1353            : ''            : ''
1354        }ge;        }ge;
1355        return ($type, $Msg->{$type}->[0], $msg);        return ($type, 'level-' . $level . ' ' . $Msg->{$type}->[0], $msg);
1356      } elsif ($type =~ s/:([^:]*)$//) {      } elsif ($type =~ s/:([^:]*)$//) {
1357        unshift @arg, $1;        unshift @arg, $1;
1358        redo;        redo;
1359      }      }
1360    }    }
1361    return ($type, '', htescape ($_[0]));    return ($type, 'level-'.$level, htescape ($_[0]));
1362  } # get_text  } # get_text
1363    
1364  }  }
# Line 802  EOH Line 1414  EOH
1414      $ua->protocols_allowed ([qw/http/]);      $ua->protocols_allowed ([qw/http/]);
1415      $ua->max_size (1000_000);      $ua->max_size (1000_000);
1416      my $req = HTTP::Request->new (GET => $request_uri);      my $req = HTTP::Request->new (GET => $request_uri);
1417        $req->header ('Accept-Encoding' => 'identity, *; q=0');
1418      my $res = $ua->request ($req);      my $res = $ua->request ($req);
1419      ## TODO: 401 sets |is_success| true.      ## TODO: 401 sets |is_success| true.
1420      if ($res->is_success or $http->get_parameter ('error-page')) {      if ($res->is_success or $http->get_parameter ('error-page')) {
# Line 811  EOH Line 1424  EOH
1424    
1425        ## TODO: More strict parsing...        ## TODO: More strict parsing...
1426        my $ct = $res->header ('Content-Type');        my $ct = $res->header ('Content-Type');
1427        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) {  
1428          $r->{charset} = lc $1;          $r->{charset} = lc $1;
1429          $r->{charset} =~ tr/\\//d;          $r->{charset} =~ tr/\\//d;
1430            $r->{official_charset} = $r->{charset};
1431        }        }
1432    
1433        my $input_charset = $http->get_parameter ('charset');        my $input_charset = $http->get_parameter ('charset');
# Line 824  EOH Line 1435  EOH
1435          $r->{charset_overridden}          $r->{charset_overridden}
1436              = (not defined $r->{charset} or $r->{charset} ne $input_charset);              = (not defined $r->{charset} or $r->{charset} ne $input_charset);
1437          $r->{charset} = $input_charset;          $r->{charset} = $input_charset;
1438        }        }
1439    
1440          ## TODO: Support for HTTP Content-Encoding
1441    
1442        $r->{s} = ''.$res->content;        $r->{s} = ''.$res->content;
1443    
1444          require Whatpm::ContentType;
1445          ($r->{official_type}, $r->{media_type})
1446              = Whatpm::ContentType->get_sniffed_type
1447                  (get_file_head => sub {
1448                     return substr $r->{s}, 0, shift;
1449                   },
1450                   http_content_type_byte => $ct,
1451                   has_http_content_encoding =>
1452                       defined $res->header ('Content-Encoding'),
1453                   supported_image_types => {});
1454      } else {      } else {
1455        $r->{uri} = $res->request->uri;        $r->{uri} = $res->request->uri;
1456        $r->{request_uri} = $request_uri;        $r->{request_uri} = $request_uri;
# Line 847  EOH Line 1471  EOH
1471      $r->{charset} = ''.$http->get_parameter ('_charset_');      $r->{charset} = ''.$http->get_parameter ('_charset_');
1472      $r->{charset} =~ s/\s+//g;      $r->{charset} =~ s/\s+//g;
1473      $r->{charset} = 'utf-8' if $r->{charset} eq '';      $r->{charset} = 'utf-8' if $r->{charset} eq '';
1474        $r->{official_charset} = $r->{charset};
1475      $r->{header_field} = [];      $r->{header_field} = [];
1476    
1477        require Whatpm::ContentType;
1478        ($r->{official_type}, $r->{media_type})
1479            = Whatpm::ContentType->get_sniffed_type
1480                (get_file_head => sub {
1481                   return substr $r->{s}, 0, shift;
1482                 },
1483                 http_content_type_byte => undef,
1484                 has_http_content_encoding => 0,
1485                 supported_image_types => {});
1486    }    }
1487    
1488    my $input_format = $http->get_parameter ('i');    my $input_format = $http->get_parameter ('i');
# Line 864  EOH Line 1499  EOH
1499    if ($r->{media_type} eq 'text/xml') {    if ($r->{media_type} eq 'text/xml') {
1500      unless (defined $r->{charset}) {      unless (defined $r->{charset}) {
1501        $r->{charset} = 'us-ascii';        $r->{charset} = 'us-ascii';
1502          $r->{official_charset} = $r->{charset};
1503      } elsif ($r->{charset_overridden} and $r->{charset} eq 'us-ascii') {      } elsif ($r->{charset_overridden} and $r->{charset} eq 'us-ascii') {
1504        $r->{charset_overridden} = 0;        $r->{charset_overridden} = 0;
1505      }      }
# Line 875  EOH Line 1511  EOH
1511      return $r;      return $r;
1512    }    }
1513    
1514      $r->{inner_html_element} = $http->get_parameter ('e');
1515    
1516    return $r;    return $r;
1517  } # get_input_document  } # get_input_document
1518    
# Line 907  Wakaba <w@suika.fam.cx>. Line 1545  Wakaba <w@suika.fam.cx>.
1545    
1546  =head1 LICENSE  =head1 LICENSE
1547    
1548  Copyright 2007 Wakaba <w@suika.fam.cx>  Copyright 2007-2008 Wakaba <w@suika.fam.cx>
1549    
1550  This library is free software; you can redistribute it  This library is free software; you can redistribute it
1551  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.19  
changed lines
  Added in v.1.45
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24