/[suikacvs]/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.22 by wakaba, Sun Nov 4 09:15:02 2007 UTC revision 1.23 by wakaba, Mon Nov 5 09:33:52 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 243  sub print_syntax_error_html_section ($$) Line 244  sub print_syntax_error_html_section ($$)
244      $type =~ tr/ /-/;      $type =~ tr/ /-/;
245      $type =~ s/\|/%7C/g;      $type =~ s/\|/%7C/g;
246      $msg .= qq[ [<a href="../error-description#@{[htescape ($type)]}">Description</a>]];      $msg .= qq[ [<a href="../error-description#@{[htescape ($type)]}">Description</a>]];
247      print STDOUT qq[<dd class="$cls">$msg</dd>\n];      print STDOUT qq[<dd class="$cls">], get_error_level_label (\%opt);
248        print STDOUT qq[$msg</dd>\n];
249    
250      add_error ('syntax', \%opt => $result);      add_error ('syntax', \%opt => $result);
251    };    };
# Line 324  sub print_syntax_error_manifest_section Line 326  sub print_syntax_error_manifest_section
326      $type =~ tr/ /-/;      $type =~ tr/ /-/;
327      $type =~ s/\|/%7C/g;      $type =~ s/\|/%7C/g;
328      $msg .= qq[ [<a href="../error-description#@{[htescape ($type)]}">Description</a>]];      $msg .= qq[ [<a href="../error-description#@{[htescape ($type)]}">Description</a>]];
329      print STDOUT qq[<dd class="$cls">$msg</dd>\n];      print STDOUT qq[<dd class="$cls">], get_error_level_label (\%opt);
330        print STDOUT qq[$msg</dd>\n];
331    
332      add_error ('syntax', \%opt => $result);      add_error ('syntax', \%opt => $result);
333    };    };
# Line 506  sub print_structure_error_dom_section ($ Line 509  sub print_structure_error_dom_section ($
509      $type =~ s/\|/%7C/g;      $type =~ s/\|/%7C/g;
510      $msg .= qq[ [<a href="../error-description#@{[htescape ($type)]}">Description</a>]];      $msg .= qq[ [<a href="../error-description#@{[htescape ($type)]}">Description</a>]];
511      print STDOUT qq[<dt class="$cls">] . get_error_label (\%opt) .      print STDOUT qq[<dt class="$cls">] . get_error_label (\%opt) .
512          qq[</dt>\n<dd class="$cls">], $msg, "</dd>\n";          qq[</dt>\n<dd class="$cls">], get_error_level_label (\%opt);
513        print STDOUT $msg, "</dd>\n";
514      add_error ('structure', \%opt => $result);      add_error ('structure', \%opt => $result);
515    };    };
516    
# Line 691  sub print_result_section ($) { Line 695  sub print_result_section ($) {
695    print STDOUT qq[<table>    print STDOUT qq[<table>
696  <colgroup><col><colgroup><col><col><col><colgroup><col>  <colgroup><col><colgroup><col><col><col><colgroup><col>
697  <thead>  <thead>
698  <tr><th scope=col></th><th scope=col><em class=rfc2119>MUST</em>-level  <tr><th scope=col></th>
699  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
700  Errors</th><th scope=col>Warnings</th><th scope=col>Score</th></tr>  Errors</a></th>
701  </thead><tbody>];  <th scope=col><a href="../error-description#level-s"><em class=rfc2119>SHOULD</em>‐level
702    Errors</a></th>
703    <th scope=col><a href="../error-description#level-w">Warnings</a></th>
704    <th scope=col>Score</th></tr></thead><tbody>];
705    
706    my $must_error = 0;    my $must_error = 0;
707    my $should_error = 0;    my $should_error = 0;
# Line 787  sub get_error_label ($) { Line 794  sub get_error_label ($) {
794    
795    if (defined $err->{node}) {    if (defined $err->{node}) {
796      $r .= ' ' if length $r;      $r .= ' ' if length $r;
797      $r = get_node_path ($err->{node});      $r = get_node_link ($err->{node});
798    }    }
799    
800    if (defined $err->{index}) {    if (defined $err->{index}) {
# Line 803  sub get_error_label ($) { Line 810  sub get_error_label ($) {
810    return $r;    return $r;
811  } # get_error_label  } # get_error_label
812    
813    sub get_error_level_label ($) {
814      my $err = shift;
815    
816      my $r = '';
817    
818      if (not defined $err->{level} or $err->{level} eq 'm') {
819        $r = qq[<strong><a href="../error-description#level-m"><em class=rfc2119>MUST</em>‐level
820            error</a></strong>: ];
821      } elsif ($err->{level} eq 's') {
822        $r = qq[<strong><a href="../error-description#level-s"><em class=rfc2119>SHOULD</em>‐level
823            error</a></strong>: ];
824      } elsif ($err->{level} eq 'w') {
825        $r = qq[<strong><a href="../error-description#level-w">Warning</a></strong>:
826            ];
827      } elsif ($err->{level} eq 'unsupported') {
828        $r = qq[<strong><a href="../error-description#level-u">Not
829            supported</a></strong>: ];
830      } else {
831        my $elevel = htescape ($err->{level});
832        $r = qq[<strong><a href="../error-description#level-$elevel">$elevel</a></strong>:
833            ];
834      }
835    
836      return $r;
837    } # get_error_level_label
838    
839  sub get_node_path ($) {  sub get_node_path ($) {
840    my $node = shift;    my $node = shift;
841    my @r;    my @r;

Legend:
Removed from v.1.22  
changed lines
  Added in v.1.23

admin@suikawiki.org
ViewVC Help
Powered by ViewVC 1.1.24