/[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.36 by wakaba, Sun Feb 10 07:35:23 2008 UTC revision 1.41 by wakaba, Sun Mar 16 11:38:47 2008 UTC
# Line 86  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>
89    
90    <script src="../cc-script.js"></script>
91  ];  ];
92    
93    $input->{id_prefix} = '';    $input->{id_prefix} = '';
# Line 132  sub add_error ($$$) { Line 134  sub add_error ($$$) {
134      } elsif ($err->{level} eq 'u' or $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 290  sub print_syntax_error_html_section ($$) Line 294  sub print_syntax_error_html_section ($$)
294  <div id="$input->{id_prefix}parse-errors" class="section">  <div id="$input->{id_prefix}parse-errors" class="section">
295  <h2>Parse Errors</h2>  <h2>Parse Errors</h2>
296    
297  <dl>];  <dl id="$input->{id_prefix}parse-errors-list">];
298    push @nav, ['#parse-errors' => 'Parse Error'] unless $input->{nested};    push @nav, ['#parse-errors' => 'Parse Error'] unless $input->{nested};
299    
300    my $onerror = sub {    my $onerror = sub {
301      my (%opt) = @_;      my (%opt) = @_;
302      my ($type, $cls, $msg) = get_text ($opt{type}, $opt{level});      my ($type, $cls, $msg) = get_text ($opt{type}, $opt{level});
303      if ($opt{column} > 0) {      print STDOUT qq[<dt class="$cls">], get_error_label ($input, \%opt),
304        print STDOUT qq[<dt class="$cls"><a href="#$input->{id_prefix}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="#$input->{id_prefix}line-$opt{line}">Line $opt{line}</a></dt>\n];  
     }  
305      $type =~ tr/ /-/;      $type =~ tr/ /-/;
306      $type =~ s/\|/%7C/g;      $type =~ s/\|/%7C/g;
307      $msg .= qq[ [<a href="../error-description#@{[htescape ($type)]}">Description</a>]];      $msg .= qq[ [<a href="../error-description#@{[htescape ($type)]}">Description</a>]];
# Line 348  sub print_syntax_error_xml_section ($$) Line 348  sub print_syntax_error_xml_section ($$)
348  <div id="$input->{id_prefix}parse-errors" class="section">  <div id="$input->{id_prefix}parse-errors" class="section">
349  <h2>Parse Errors</h2>  <h2>Parse Errors</h2>
350    
351  <dl>];  <dl id="$input->{id_prefix}parse-errors-list">];
352    push @nav, ['#parse-errors' => 'Parse Error'] unless $input->{prefix};    push @nav, ['#parse-errors' => 'Parse Error'] unless $input->{prefix};
353    
354    my $onerror = sub {    my $onerror = sub {
# Line 388  sub get_css_parser () { Line 388  sub get_css_parser () {
388    require Whatpm::CSS::Parser;    require Whatpm::CSS::Parser;
389    my $p = Whatpm::CSS::Parser->new;    my $p = Whatpm::CSS::Parser->new;
390    
 #  if ($parse_mode eq 'q') {  
 #    $p->{unitless_px} = 1;  
 #    $p->{hashless_color} = 1;  
 #  }  
   
391    $p->{prop}->{$_} = 1 for qw/    $p->{prop}->{$_} = 1 for qw/
392        alignment-baseline
393      background background-attachment background-color background-image      background background-attachment background-color background-image
394      background-position background-position-x background-position-y      background-position background-position-x background-position-y
395      background-repeat border border-bottom border-bottom-color      background-repeat border border-bottom border-bottom-color
# Line 405  sub get_css_parser () { Line 401  sub get_css_parser () {
401      border-style border-top border-top-color border-top-style border-top-width      border-style border-top border-top-color border-top-style border-top-width
402      border-width bottom      border-width bottom
403      caption-side clear clip color content counter-increment counter-reset      caption-side clear clip color content counter-increment counter-reset
404      cursor direction display empty-cells float font      cursor direction display dominant-baseline empty-cells float font
405      font-family font-size font-size-adjust font-stretch      font-family font-size font-size-adjust font-stretch
406      font-style font-variant font-weight height left      font-style font-variant font-weight height left
407      letter-spacing line-height      letter-spacing line-height
# Line 417  sub get_css_parser () { Line 413  sub get_css_parser () {
413      padding padding-bottom padding-left padding-right padding-top      padding padding-bottom padding-left padding-right padding-top
414      page page-break-after page-break-before page-break-inside      page page-break-after page-break-before page-break-inside
415      position quotes right size table-layout      position quotes right size table-layout
416      text-align text-decoration text-indent text-transform      text-align text-anchor text-decoration text-indent text-transform
417      top unicode-bidi vertical-align visibility white-space width widows      top unicode-bidi vertical-align visibility white-space width widows
418      word-spacing z-index      word-spacing writing-mode z-index
419    /;    /;
420    $p->{prop_value}->{display}->{$_} = 1 for qw/    $p->{prop_value}->{display}->{$_} = 1 for qw/
421      block clip inline inline-block inline-table list-item none      block clip inline inline-block inline-table list-item none
# Line 496  sub get_css_parser () { Line 492  sub get_css_parser () {
492    $p->{prop_value}->{'white-space'}->{$_} = 1 for qw/    $p->{prop_value}->{'white-space'}->{$_} = 1 for qw/
493      normal pre nowrap pre-line pre-wrap -moz-pre-wrap      normal pre nowrap pre-line pre-wrap -moz-pre-wrap
494    /;    /;
495      $p->{prop_value}->{'writing-mode'}->{$_} = 1 for qw/
496        lr rl tb lr-tb rl-tb tb-rl
497      /;
498      $p->{prop_value}->{'text-anchor'}->{$_} = 1 for qw/
499        start middle end
500      /;
501      $p->{prop_value}->{'dominant-baseline'}->{$_} = 1 for qw/
502        auto use-script no-change reset-size ideographic alphabetic
503        hanging mathematical central middle text-after-edge text-before-edge
504      /;
505      $p->{prop_value}->{'alignment-baseline'}->{$_} = 1 for qw/
506        auto baseline before-edge text-before-edge middle central
507        after-edge text-after-edge ideographic alphabetic hanging
508        mathematical
509      /;
510    $p->{prop_value}->{'text-decoration'}->{$_} = 1 for qw/    $p->{prop_value}->{'text-decoration'}->{$_} = 1 for qw/
511      none blink underline overline line-through      none blink underline overline line-through
512    /;    /;
# Line 548  sub print_syntax_error_css_section ($$) Line 559  sub print_syntax_error_css_section ($$)
559  <div id="$input->{id_prefix}parse-errors" class="section">  <div id="$input->{id_prefix}parse-errors" class="section">
560  <h2>Parse Errors</h2>  <h2>Parse Errors</h2>
561    
562  <dl>];  <dl id="$input->{id_prefix}parse-errors-list">];
563    push @nav, ['#parse-errors' => 'Parse Error'] unless $input->{nested};    push @nav, ['#parse-errors' => 'Parse Error'] unless $input->{nested};
564    
565    my $p = get_css_parser ();    my $p = get_css_parser ();
566      $p->init;
567    $p->{onerror} = sub {    $p->{onerror} = sub {
568      my (%opt) = @_;      my (%opt) = @_;
569      my ($type, $cls, $msg) = get_text ($opt{type}, $opt{level});      my ($type, $cls, $msg) = get_text ($opt{type}, $opt{level});
# Line 576  sub print_syntax_error_css_section ($$) Line 588  sub print_syntax_error_css_section ($$)
588    $p->{href} = $input->{uri};    $p->{href} = $input->{uri};
589    $p->{base_uri} = $input->{base_uri};    $p->{base_uri} = $input->{base_uri};
590    
591    #  if ($parse_mode eq 'q') {
592    #    $p->{unitless_px} = 1;
593    #    $p->{hashless_color} = 1;
594    #  }
595    
596    ## TODO: Make $input->{s} a ref.
597    
598    my $s = \$input->{s};    my $s = \$input->{s};
599    my $charset;    my $charset;
600    unless ($input->{is_char_string}) {    unless ($input->{is_char_string}) {
# Line 606  sub print_syntax_error_manifest_section Line 625  sub print_syntax_error_manifest_section
625  <div id="$input->{id_prefix}parse-errors" class="section">  <div id="$input->{id_prefix}parse-errors" class="section">
626  <h2>Parse Errors</h2>  <h2>Parse Errors</h2>
627    
628  <dl>];  <dl id="$input->{id_prefix}parse-errors-list">];
629    push @nav, ['#parse-errors' => 'Parse Error'] unless $input->{nested};    push @nav, ['#parse-errors' => 'Parse Error'] unless $input->{nested};
630    
631    my $onerror = sub {    my $onerror = sub {
# Line 652  sub print_source_string_section ($$$) { Line 671  sub print_source_string_section ($$$) {
671  <h2>Document Source</h2>  <h2>Document Source</h2>
672  <ol lang="">\n];  <ol lang="">\n];
673    if (length $$s) {    if (length $$s) {
674      while ($$s =~ /\G([^\x0A]*?)\x0D?\x0A/gc) {      while ($$s =~ /\G([^\x0D\x0A]*?)(?>\x0D\x0A?|\x0A)/gc) {
675        print STDOUT qq[<li id="$input->{id_prefix}line-$i">], htescape $1,        print STDOUT qq[<li id="$input->{id_prefix}line-$i">], htescape $1,
676            "</li>\n";            "</li>\n";
677        $i++;        $i++;
678      }      }
679      if ($$s =~ /\G([^\x0A]+)/gc) {      if ($$s =~ /\G([^\x0D\x0A]+)/gc) {
680        print STDOUT qq[<li id="$input->{id_prefix}line-$i">], htescape $1,        print STDOUT qq[<li id="$input->{id_prefix}line-$i">], htescape $1,
681            "</li>\n";            "</li>\n";
682      }      }
683    } else {    } else {
684      print STDOUT q[<li id="$input->{id_prefix}line-1"></li>];      print STDOUT q[<li id="$input->{id_prefix}line-1"></li>];
685    }    }
686    print STDOUT "</ol></div>";    print STDOUT "</ol></div>
687    <script> addSourceToParseErrorList ('$input->{id_prefix}'); </script>";
688  } # print_input_string_section  } # print_input_string_section
689    
690  sub print_document_tree ($$) {  sub print_document_tree ($$) {
# Line 802  sub print_structure_dump_manifest_sectio Line 822  sub print_structure_dump_manifest_sectio
822        unless $input->{nested};        unless $input->{nested};
823    
824    print STDOUT qq[<dl><dt>Explicit entries</dt>];    print STDOUT qq[<dl><dt>Explicit entries</dt>];
825      my $i = 0;
826    for my $uri (@{$manifest->[0]}) {    for my $uri (@{$manifest->[0]}) {
827      my $euri = htescape ($uri);      my $euri = htescape ($uri);
828      print STDOUT qq[<dd><code class=uri>&lt;<a href="$euri">$euri</a>></code></dd>];      print STDOUT qq[<dd id="$input->{id_prefix}index-@{[$i++]}"><code class=uri>&lt;<a href="$euri">$euri</a>></code></dd>];
829    }    }
830    
831    print STDOUT qq[<dt>Fallback entries</dt><dd>    print STDOUT qq[<dt>Fallback entries</dt><dd>
# Line 813  sub print_structure_dump_manifest_sectio Line 834  sub print_structure_dump_manifest_sectio
834    for my $uri (sort {$a cmp $b} keys %{$manifest->[1]}) {    for my $uri (sort {$a cmp $b} keys %{$manifest->[1]}) {
835      my $euri = htescape ($uri);      my $euri = htescape ($uri);
836      my $euri2 = htescape ($manifest->[1]->{$uri});      my $euri2 = htescape ($manifest->[1]->{$uri});
837      print STDOUT qq[<tr><td><code class=uri>&lt;<a href="$euri">$euri</a>></code></td>      print STDOUT qq[<tr><td id="$input->{id_prefix}index-@{[$i++]}"><code class=uri>&lt;<a href="$euri">$euri</a>></code></td>
838          <td><code class=uri>&lt;<a href="$euri2">$euri2</a>></code></td>];          <td id="$input->{id_prefix}index-@{[$i++]}"><code class=uri>&lt;<a href="$euri2">$euri2</a>></code></td>];
839    }    }
840    
841    print STDOUT qq[</table><dt>Online whitelist</dt>];    print STDOUT qq[</table><dt>Online whitelist</dt>];
842    for my $uri (@{$manifest->[2]}) {    for my $uri (@{$manifest->[2]}) {
843      my $euri = htescape ($uri);      my $euri = htescape ($uri);
844      print STDOUT qq[<dd><code class=uri>&lt;<a href="$euri">$euri</a>></code></dd>];      print STDOUT qq[<dd id="$input->{id_prefix}index-@{[$i++]}"><code class=uri>&lt;<a href="$euri">$euri</a>></code></dd>];
845    }    }
846    
847    print STDOUT qq[</dl></div>];    print STDOUT qq[</dl></div>];
# Line 1100  sub get_error_label ($$) { Line 1121  sub get_error_label ($$) {
1121    
1122    my $r = '';    my $r = '';
1123    
1124    if (defined $err->{line}) {    if (defined $err->{token} and defined $err->{token}->{line}) {
1125        if ($err->{token}->{column} > 0) {
1126          $r = qq[<a href="#$input->{id_prefix}line-$err->{token}->{line}">Line $err->{token}->{line}</a> column $err->{token}->{column}];
1127        } else {
1128          $err->{token}->{line} = $err->{token}->{line} - 1 || 1;
1129          $r = qq[<a href="#$input->{id_prefix}line-$err->{token}->{line}">Line $err->{token}->{line}</a>];
1130        }
1131      } elsif (defined $err->{line}) {
1132      if ($err->{column} > 0) {      if ($err->{column} > 0) {
1133        $r = qq[<a href="#$input->{id_prefix}line-$err->{line}">Line $err->{line}</a> column $err->{column}];        $r = qq[<a href="#$input->{id_prefix}line-$err->{line}">Line $err->{line}</a> column $err->{column}];
1134      } else {      } else {
# Line 1115  sub get_error_label ($$) { Line 1143  sub get_error_label ($$) {
1143    }    }
1144    
1145    if (defined $err->{index}) {    if (defined $err->{index}) {
1146      $r .= ' ' if length $r;      if (length $r) {
1147      $r .= 'Index ' . (0+$err->{index});        $r .= ', Index ' . (0+$err->{index});
1148        } else {
1149          $r .= "<a href='#$input->{id_prefix}index-@{[0+$err->{index}]}'>Index "
1150              . (0+$err->{index}) . '</a>';
1151        }
1152    }    }
1153    
1154    if (defined $err->{value}) {    if (defined $err->{value}) {
# Line 1144  sub get_error_level_label ($) { Line 1176  sub get_error_level_label ($) {
1176    } elsif ($err->{level} eq 'u' or $err->{level} eq 'unsupported') {    } elsif ($err->{level} eq 'u' or $err->{level} eq 'unsupported') {
1177      $r = qq[<strong><a href="../error-description#level-u">Not      $r = qq[<strong><a href="../error-description#level-u">Not
1178          supported</a></strong>: ];          supported</a></strong>: ];
1179      } elsif ($err->{level} eq 'i') {
1180        $r = qq[<strong><a href="../error-description#level-i">Information</a></strong>: ];
1181    } else {    } else {
1182      my $elevel = htescape ($err->{level});      my $elevel = htescape ($err->{level});
1183      $r = qq[<strong><a href="../error-description#level-$elevel">$elevel</a></strong>:      $r = qq[<strong><a href="../error-description#level-$elevel">$elevel</a></strong>:

Legend:
Removed from v.1.36  
changed lines
  Added in v.1.41

admin@suikawiki.org
ViewVC Help
Powered by ViewVC 1.1.24