/[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.24 by wakaba, Sun Nov 11 06:57:16 2007 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 83  if (defined $input->{s}) { Line 84  if (defined $input->{s}) {
84  </div>  </div>
85  ];  ];
86    
87    my $result = {};    my $result = {conforming_min => 1, conforming_max => 1};
88    print_http_header_section ($input, $result);    print_http_header_section ($input, $result);
89    
90    my $doc;    my $doc;
91    my $el;    my $el;
92      my $manifest;
93    
94    if ($input->{media_type} eq 'text/html') {    if ($input->{media_type} eq 'text/html') {
95      ($doc, $el) = print_syntax_error_html_section ($input, $result);      ($doc, $el) = print_syntax_error_html_section ($input, $result);
# Line 102  if (defined $input->{s}) { Line 104  if (defined $input->{s}) {
104             }->{$input->{media_type}}) {             }->{$input->{media_type}}) {
105      ($doc, $el) = print_syntax_error_xml_section ($input, $result);      ($doc, $el) = print_syntax_error_xml_section ($input, $result);
106      print_source_string_section (\($input->{s}), $doc->input_encoding);      print_source_string_section (\($input->{s}), $doc->input_encoding);
107      } elsif ($input->{media_type} eq 'text/cache-manifest') {
108    ## TODO: MUST be text/cache-manifest
109        $manifest = print_syntax_error_manifest_section ($input, $result);
110        print_source_string_section (\($input->{s}), 'utf-8');
111    } else {    } else {
112      ## TODO: Change HTTP status code??      ## TODO: Change HTTP status code??
113      print_result_unknown_type_section ($input);      print_result_unknown_type_section ($input, $result);
114    }    }
115    
116    if (defined $doc or defined $el) {    if (defined $doc or defined $el) {
117      print_structure_dump_section ($doc, $el);      print_structure_dump_dom_section ($doc, $el);
118      my $elements = print_structure_error_section ($doc, $el, $result);      my $elements = print_structure_error_dom_section ($doc, $el, $result);
119      print_table_section ($elements->{table}) if @{$elements->{table}};      print_table_section ($elements->{table}) if @{$elements->{table}};
120      print_id_section ($elements->{id}) if keys %{$elements->{id}};      print_id_section ($elements->{id}) if keys %{$elements->{id}};
121      print_term_section ($elements->{term}) if keys %{$elements->{term}};      print_term_section ($elements->{term}) if keys %{$elements->{term}};
122      print_class_section ($elements->{class}) if keys %{$elements->{class}};      print_class_section ($elements->{class}) if keys %{$elements->{class}};
123      } elsif (defined $manifest) {
124        print_structure_dump_manifest_section ($manifest);
125        print_structure_error_manifest_section ($manifest, $result);
126    }    }
127    
128    print_result_section ($result);    print_result_section ($result);
# Line 134  if (defined $input->{s}) { Line 143  if (defined $input->{s}) {
143  </html>  </html>
144  ];  ];
145    
146    for (qw/decode parse parse_xml check/) {    for (qw/decode parse parse_html parse_xml parse_manifest
147              check check_manifest/) {
148      next unless defined $time{$_};      next unless defined $time{$_};
149      open my $file, '>>', ".cc-$_.txt" or die ".cc-$_.txt: $!";      open my $file, '>>', ".cc-$_.txt" or die ".cc-$_.txt: $!";
150      print $file $char_length, "\t", $time{$_}, "\n";      print $file $char_length, "\t", $time{$_}, "\n";
# Line 209  sub print_syntax_error_html_section ($$) Line 219  sub print_syntax_error_html_section ($$)
219        
220    require Encode;    require Encode;
221    require Whatpm::HTML;    require Whatpm::HTML;
   
   $input->{charset} ||= 'ISO-8859-1'; ## TODO: for now.  
222        
   my $time1 = time;  
   my $t = Encode::decode ($input->{charset}, $input->{s});  
   $time{decode} = time - $time1;  
   
223    print STDOUT qq[    print STDOUT qq[
224  <div id="parse-errors" class="section">  <div id="parse-errors" class="section">
225  <h2>Parse Errors</h2>  <h2>Parse Errors</h2>
# Line 235  sub print_syntax_error_html_section ($$) Line 239  sub print_syntax_error_html_section ($$)
239      $type =~ tr/ /-/;      $type =~ tr/ /-/;
240      $type =~ s/\|/%7C/g;      $type =~ s/\|/%7C/g;
241      $msg .= qq[ [<a href="../error-description#@{[htescape ($type)]}">Description</a>]];      $msg .= qq[ [<a href="../error-description#@{[htescape ($type)]}">Description</a>]];
242      print STDOUT qq[<dd class="$cls">$msg</dd>\n];      print STDOUT qq[<dd class="$cls">], get_error_level_label (\%opt);
243        print STDOUT qq[$msg</dd>\n];
244    
245      add_error ('syntax', \%opt => $result);      add_error ('syntax', \%opt => $result);
246    };    };
247    
248    my $doc = $dom->create_document;    my $doc = $dom->create_document;
249    my $el;    my $el;
   $time1 = time;  
250    if (defined $inner_html_element and length $inner_html_element) {    if (defined $inner_html_element and length $inner_html_element) {
251        $input->{charset} ||= 'ISO-8859-1'; ## TODO: for now.
252        my $time1 = time;
253        my $t = Encode::decode ($input->{charset}, $input->{s});
254        $time{decode} = time - $time1;
255        
256      $el = $doc->create_element_ns      $el = $doc->create_element_ns
257          ('http://www.w3.org/1999/xhtml', [undef, $inner_html_element]);          ('http://www.w3.org/1999/xhtml', [undef, $inner_html_element]);
258        $time1 = time;
259      Whatpm::HTML->set_inner_html ($el, $t, $onerror);      Whatpm::HTML->set_inner_html ($el, $t, $onerror);
260        $time{parse} = time - $time1;
261    } else {    } else {
262      Whatpm::HTML->parse_string ($t => $doc, $onerror);      my $time1 = time;
263        Whatpm::HTML->parse_byte_string
264            ($input->{charset}, $input->{s} => $doc, $onerror);
265        $time{parse_html} = time - $time1;
266    }    }
267    $time{parse} = time - $time1;    
   
268    print STDOUT qq[</dl></div>];    print STDOUT qq[</dl></div>];
269    
270    return ($doc, $el);    return ($doc, $el);
# Line 297  sub print_syntax_error_xml_section ($$) Line 310  sub print_syntax_error_xml_section ($$)
310    return ($doc, undef);    return ($doc, undef);
311  } # print_syntax_error_xml_section  } # print_syntax_error_xml_section
312    
313    sub print_syntax_error_manifest_section ($$) {
314      my ($input, $result) = @_;
315    
316      require Whatpm::CacheManifest;
317    
318      print STDOUT qq[
319    <div id="parse-errors" class="section">
320    <h2>Parse Errors</h2>
321    
322    <dl>];
323      push @nav, ['#parse-errors' => 'Parse Error'];
324    
325      my $onerror = sub {
326        my (%opt) = @_;
327        my ($type, $cls, $msg) = get_text ($opt{type}, $opt{level});
328        print STDOUT qq[<dt class="$cls">], get_error_label (\%opt), qq[</dt>];
329        $type =~ tr/ /-/;
330        $type =~ s/\|/%7C/g;
331        $msg .= qq[ [<a href="../error-description#@{[htescape ($type)]}">Description</a>]];
332        print STDOUT qq[<dd class="$cls">], get_error_level_label (\%opt);
333        print STDOUT qq[$msg</dd>\n];
334    
335        add_error ('syntax', \%opt => $result);
336      };
337    
338      my $time1 = time;
339      my $manifest = Whatpm::CacheManifest->parse_byte_string
340          ($input->{s}, $input->{uri}, $input->{base_uri}, $onerror);
341      $time{parse_manifest} = time - $time1;
342    
343      print STDOUT qq[</dl></div>];
344    
345      return $manifest;
346    } # print_syntax_error_manifest_section
347    
348  sub print_source_string_section ($$) {  sub print_source_string_section ($$) {
349    require Encode;    require Encode;
350    my $enc = Encode::find_encoding ($_[1]); ## TODO: charset name -> Perl name    my $enc = Encode::find_encoding ($_[1]); ## TODO: charset name -> Perl name
# Line 399  sub print_document_tree ($) { Line 447  sub print_document_tree ($) {
447    print STDOUT $r;    print STDOUT $r;
448  } # print_document_tree  } # print_document_tree
449    
450  sub print_structure_dump_section ($$) {  sub print_structure_dump_dom_section ($$) {
451    my ($doc, $el) = @_;    my ($doc, $el) = @_;
452    
453    print STDOUT qq[    print STDOUT qq[
# Line 411  sub print_structure_dump_section ($$) { Line 459  sub print_structure_dump_section ($$) {
459    print_document_tree ($el || $doc);    print_document_tree ($el || $doc);
460    
461    print STDOUT qq[</div>];    print STDOUT qq[</div>];
462  } # print_structure_dump_section  } # print_structure_dump_dom_section
463    
464    sub print_structure_dump_manifest_section ($) {
465      my $manifest = shift;
466    
467      print STDOUT qq[
468    <div id="dump-manifest" class="section">
469    <h2>Cache Manifest</h2>
470    ];
471      push @nav, ['#dump-manifest' => 'Caceh Manifest'];
472    
473      print STDOUT qq[<dl><dt>Explicit entries</dt>];
474      for my $uri (@{$manifest->[0]}) {
475        my $euri = htescape ($uri);
476        print STDOUT qq[<dd><code class=uri>&lt;<a href="$euri">$euri</a>></code></dd>];
477      }
478    
479      print STDOUT qq[<dt>Fallback entries</dt><dd>
480          <table><thead><tr><th scope=row>Oppotunistic Caching Namespace</th>
481          <th scope=row>Fallback Entry</tr><tbody>];
482      for my $uri (sort {$a cmp $b} keys %{$manifest->[1]}) {
483        my $euri = htescape ($uri);
484        my $euri2 = htescape ($manifest->[1]->{$uri});
485        print STDOUT qq[<tr><td><code class=uri>&lt;<a href="$euri">$euri</a>></code></td>
486            <td><code class=uri>&lt;<a href="$euri2">$euri2</a>></code></td>];
487      }
488    
489  sub print_structure_error_section ($$$) {    print STDOUT qq[</table><dt>Online whitelist</dt>];
490      for my $uri (@{$manifest->[2]}) {
491        my $euri = htescape ($uri);
492        print STDOUT qq[<dd><code class=uri>&lt;<a href="$euri">$euri</a>></code></dd>];
493      }
494    
495      print STDOUT qq[</dl></div>];
496    } # print_structure_dump_manifest_section
497    
498    sub print_structure_error_dom_section ($$$) {
499    my ($doc, $el, $result) = @_;    my ($doc, $el, $result) = @_;
500    
501    print STDOUT qq[<div id="document-errors" class="section">    print STDOUT qq[<div id="document-errors" class="section">
# Line 429  sub print_structure_error_section ($$$) Line 511  sub print_structure_error_section ($$$)
511      $type =~ tr/ /-/;      $type =~ tr/ /-/;
512      $type =~ s/\|/%7C/g;      $type =~ s/\|/%7C/g;
513      $msg .= qq[ [<a href="../error-description#@{[htescape ($type)]}">Description</a>]];      $msg .= qq[ [<a href="../error-description#@{[htescape ($type)]}">Description</a>]];
514      print STDOUT qq[<dt class="$cls">] . get_node_link ($opt{node}) .      print STDOUT qq[<dt class="$cls">] . get_error_label (\%opt) .
515          qq[</dt>\n<dd class="$cls">], $msg, "</dd>\n";          qq[</dt>\n<dd class="$cls">], get_error_level_label (\%opt);
516        print STDOUT $msg, "</dd>\n";
517      add_error ('structure', \%opt => $result);      add_error ('structure', \%opt => $result);
518    };    };
519    
# Line 446  sub print_structure_error_section ($$$) Line 529  sub print_structure_error_section ($$$)
529    print STDOUT qq[</dl></div>];    print STDOUT qq[</dl></div>];
530    
531    return $elements;    return $elements;
532  } # print_structure_error_section  } # print_structure_error_dom_section
533    
534    sub print_structure_error_manifest_section ($$$) {
535      my ($manifest, $result) = @_;
536    
537      print STDOUT qq[<div id="document-errors" class="section">
538    <h2>Document Errors</h2>
539    
540    <dl>];
541      push @nav, ['#document-errors' => 'Document Error'];
542    
543      require Whatpm::CacheManifest;
544      Whatpm::CacheManifest->check_manifest ($manifest, sub {
545        my %opt = @_;
546        my ($type, $cls, $msg) = get_text ($opt{type}, $opt{level}, $opt{node});
547        $type =~ tr/ /-/;
548        $type =~ s/\|/%7C/g;
549        $msg .= qq[ [<a href="../error-description#@{[htescape ($type)]}">Description</a>]];
550        print STDOUT qq[<dt class="$cls">] . get_error_label (\%opt) .
551            qq[</dt>\n<dd class="$cls">], $msg, "</dd>\n";
552        add_error ('structure', \%opt => $result);
553      });
554    
555      print STDOUT qq[</div>];
556    } # print_structure_error_manifest_section
557    
558  sub print_table_section ($) {  sub print_table_section ($) {
559    my $tables = shift;    my $tables = shift;
# Line 571  sub print_result_section ($) { Line 678  sub print_result_section ($) {
678  <div id="result-summary" class="section">  <div id="result-summary" class="section">
679  <h2>Result</h2>];  <h2>Result</h2>];
680    
681    if ($result->{unsupported}) {      if ($result->{unsupported} and $result->{conforming_max}) {  
682      print STDOUT qq[<p class=uncertain id=result-para>The conformance      print STDOUT qq[<p class=uncertain id=result-para>The conformance
683          checker cannot decide whether the document is conforming or          checker cannot decide whether the document is conforming or
684          not, since the document contains one or more unsupported          not, since the document contains one or more unsupported
685          features.</p>];          features.  The document might or might not be conforming.</p>];
686    } elsif ($result->{conforming_min}) {    } elsif ($result->{conforming_min}) {
687      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
688          found in this document.</p>];          found in this document.</p>];
# Line 591  sub print_result_section ($) { Line 698  sub print_result_section ($) {
698    print STDOUT qq[<table>    print STDOUT qq[<table>
699  <colgroup><col><colgroup><col><col><col><colgroup><col>  <colgroup><col><colgroup><col><col><col><colgroup><col>
700  <thead>  <thead>
701  <tr><th scope=col></th><th scope=col><em class=rfc2119>MUST</em>-level  <tr><th scope=col></th>
702  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
703  Errors</th><th scope=col>Warnings</th><th scope=col>Score</th></tr>  Errors</a></th>
704  </thead><tbody>];  <th scope=col><a href="../error-description#level-s"><em class=rfc2119>SHOULD</em>‐level
705    Errors</a></th>
706    <th scope=col><a href="../error-description#level-w">Warnings</a></th>
707    <th scope=col>Score</th></tr></thead><tbody>];
708    
709    my $must_error = 0;    my $must_error = 0;
710    my $should_error = 0;    my $should_error = 0;
# Line 602  Errors</th><th scope=col>Warnings</th><t Line 712  Errors</th><th scope=col>Warnings</th><t
712    my $score_min = 0;    my $score_min = 0;
713    my $score_max = 0;    my $score_max = 0;
714    my $score_base = 20;    my $score_base = 20;
715      my $score_unit = $score_base / 100;
716    for (    for (
717      [Transfer => 'transfer', ''],      [Transfer => 'transfer', ''],
718      [Character => 'char', ''],      [Character => 'char', ''],
# Line 611  Errors</th><th scope=col>Warnings</th><t Line 722  Errors</th><th scope=col>Warnings</th><t
722      $must_error += ($result->{$_->[1]}->{must} += 0);      $must_error += ($result->{$_->[1]}->{must} += 0);
723      $should_error += ($result->{$_->[1]}->{should} += 0);      $should_error += ($result->{$_->[1]}->{should} += 0);
724      $warning += ($result->{$_->[1]}->{warning} += 0);      $warning += ($result->{$_->[1]}->{warning} += 0);
725      $score_min += ($result->{$_->[1]}->{score_min} += $score_base);      $score_min += (($result->{$_->[1]}->{score_min} *= $score_unit) += $score_base);
726      $score_max += ($result->{$_->[1]}->{score_max} += $score_base);      $score_max += (($result->{$_->[1]}->{score_max} *= $score_unit) += $score_base);
727    
728      my $uncertain = $result->{$_->[1]}->{unsupported} ? '?' : '';      my $uncertain = $result->{$_->[1]}->{unsupported} ? '?' : '';
729      my $label = $_->[0];      my $label = $_->[0];
# Line 625  Errors</th><th scope=col>Warnings</th><t Line 736  Errors</th><th scope=col>Warnings</th><t
736    
737      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>];
738      if ($uncertain) {      if ($uncertain) {
739        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>];
740      } elsif ($result->{$_->[1]}->{score_min} != $result->{$_->[1]}->{score_max}) {      } elsif ($result->{$_->[1]}->{score_min} != $result->{$_->[1]}->{score_max}) {
741        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>];
742      } else {      } else {
743        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>];
744      }      }
745    }    }
746    
# Line 638  Errors</th><th scope=col>Warnings</th><t Line 749  Errors</th><th scope=col>Warnings</th><t
749    print STDOUT qq[    print STDOUT qq[
750  <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>
751  </tbody>  </tbody>
752  <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>
753    <td class="@{[$must_error ? 'FAIL' : '']}">$must_error?</td>
754    <td class="@{[$should_error ? 'SEE-RESULT' : '']}">$should_error?</td>
755    <td>$warning?</td>
756    <td class="@{[$must_error ? 'FAIL' : $should_error ? 'SEE-RESULT' : '']}"><strong>&#x2212;&#x221E;..$score_max</strong></td></tr></tfoot>
757  </table>  </table>
758    
759  <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 762  is <em>under development</em>.  The resu
762    push @nav, ['#result-summary' => 'Result'];    push @nav, ['#result-summary' => 'Result'];
763  } # print_result_section  } # print_result_section
764    
765  sub print_result_unknown_type_section ($) {  sub print_result_unknown_type_section ($$) {
766    my $input = shift;    my ($input, $result) = @_;
767    
768      my $euri = htescape ($input->{uri});
769    print STDOUT qq[    print STDOUT qq[
770  <div id="result-summary" class="section">  <div id="parse-errors" class="section">
771  <p><em>Media type <code class="MIME" lang="en">@{[htescape $input->{media_type}]}</code> is not supported!</em></p>  <h2>Errors</h2>
772    
773    <dl>
774    <dt class=unsupported><code>&lt;<a href="$euri">$euri</a>&gt;</code></dt>
775        <dd class=unsupported><strong><a href="../error-description#level-u">Not
776            supported</a></strong>:
777        Media type
778        <code class="MIME" lang="en">@{[htescape $input->{media_type}]}</code>
779        is not supported.</dd>
780    </dl>
781  </div>  </div>
782  ];  ];
783    push @nav, ['#result-summary' => 'Result'];    push @nav, ['#parse-errors' => 'Errors'];
784      add_error (char => {level => 'unsupported'} => $result);
785      add_error (syntax => {level => 'unsupported'} => $result);
786      add_error (structure => {level => 'unsupported'} => $result);
787  } # print_result_unknown_type_section  } # print_result_unknown_type_section
788    
789  sub print_result_input_error_section ($) {  sub print_result_input_error_section ($) {
# Line 666  sub print_result_input_error_section ($) Line 794  sub print_result_input_error_section ($)
794    push @nav, ['#result-summary' => 'Result'];    push @nav, ['#result-summary' => 'Result'];
795  } # print_Result_input_error_section  } # print_Result_input_error_section
796    
797    sub get_error_label ($) {
798      my $err = shift;
799    
800      my $r = '';
801    
802      if (defined $err->{line}) {
803        if ($err->{column} > 0) {
804          $r = qq[<a href="#line-$err->{line}">Line $err->{line}</a> column $err->{column}];
805        } else {
806          $err->{line} = $err->{line} - 1 || 1;
807          $r = qq[<a href="#line-$err->{line}">Line $err->{line}</a>];
808        }
809      }
810    
811      if (defined $err->{node}) {
812        $r .= ' ' if length $r;
813        $r = get_node_link ($err->{node});
814      }
815    
816      if (defined $err->{index}) {
817        $r .= ' ' if length $r;
818        $r .= 'Index ' . (0+$err->{index});
819      }
820    
821      if (defined $err->{value}) {
822        $r .= ' ' if length $r;
823        $r .= '<q><code>' . htescape ($err->{value}) . '</code></q>';
824      }
825    
826      return $r;
827    } # get_error_label
828    
829    sub get_error_level_label ($) {
830      my $err = shift;
831    
832      my $r = '';
833    
834      if (not defined $err->{level} or $err->{level} eq 'm') {
835        $r = qq[<strong><a href="../error-description#level-m"><em class=rfc2119>MUST</em>‐level
836            error</a></strong>: ];
837      } elsif ($err->{level} eq 's') {
838        $r = qq[<strong><a href="../error-description#level-s"><em class=rfc2119>SHOULD</em>‐level
839            error</a></strong>: ];
840      } elsif ($err->{level} eq 'w') {
841        $r = qq[<strong><a href="../error-description#level-w">Warning</a></strong>:
842            ];
843      } elsif ($err->{level} eq 'unsupported') {
844        $r = qq[<strong><a href="../error-description#level-u">Not
845            supported</a></strong>: ];
846      } else {
847        my $elevel = htescape ($err->{level});
848        $r = qq[<strong><a href="../error-description#level-$elevel">$elevel</a></strong>:
849            ];
850      }
851    
852      return $r;
853    } # get_error_level_label
854    
855  sub get_node_path ($) {  sub get_node_path ($) {
856    my $node = shift;    my $node = shift;
857    my @r;    my @r;
# Line 814  EOH Line 1000  EOH
1000        if (defined $ct and $ct =~ m#^([0-9A-Za-z._+-]+/[0-9A-Za-z._+-]+)#) {        if (defined $ct and $ct =~ m#^([0-9A-Za-z._+-]+/[0-9A-Za-z._+-]+)#) {
1001          $r->{media_type} = lc $1;          $r->{media_type} = lc $1;
1002        }        }
1003        if (defined $ct and $ct =~ /;\s*charset\s*=\s*"?(\S+)"?/i) {        if (defined $ct and $ct =~ /;\s*charset\s*=\s*"?([^\s;"]+)"?/i) {
1004          $r->{charset} = lc $1;          $r->{charset} = lc $1;
1005          $r->{charset} =~ tr/\\//d;          $r->{charset} =~ tr/\\//d;
1006        }        }
Legend:
Removed from v.1.19  
changed lines
  Added in v.1.24
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24