/[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.26 by wakaba, Sun Nov 18 11:05:12 2007 UTC revision 1.30 by wakaba, Sat Feb 9 12:22:19 2008 UTC
# Line 166  sub add_error ($$$) { Line 166  sub add_error ($$$) {
166        $result->{conforming_min} = 0;        $result->{conforming_min} = 0;
167      } elsif ($err->{level} eq 'w' or $err->{level} eq 'g') {      } elsif ($err->{level} eq 'w' or $err->{level} eq 'g') {
168        $result->{$layer}->{warning}++;        $result->{$layer}->{warning}++;
169      } elsif ($err->{level} eq 'unsupported') {      } elsif ($err->{level} eq 'u' or $err->{level} eq 'unsupported') {
170        $result->{$layer}->{unsupported}++;        $result->{$layer}->{unsupported}++;
171        $result->{unsupported} = 1;        $result->{unsupported} = 1;
172      } else {      } else {
# Line 403  sub print_document_tree ($) { Line 403  sub print_document_tree ($) {
403          $r .= '<ul class="attributes">';          $r .= '<ul class="attributes">';
404          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 $_] }
405                        @{$child->attributes}) {                        @{$child->attributes}) {
406            $r .= qq[<li id="$attr->[3]" class="tree-attribute"><code title="@{[defined $_->[2] ? $_->[2] : '']}">] . htescape ($attr->[0]) . '</code> = '; ## ISSUE: case?            $r .= qq[<li id="$attr->[3]" class="tree-attribute"><code title="@{[defined $attr->[2] ? htescape ($attr->[2]) : '']}">] . htescape ($attr->[0]) . '</code> = '; ## ISSUE: case?
407            $r .= '<q>' . htescape ($attr->[1]) . '</q></li>'; ## TODO: children            $r .= '<q>' . htescape ($attr->[1]) . '</q></li>'; ## TODO: children
408          }          }
409          $r .= '</ul>';          $r .= '</ul>';
# Line 424  sub print_document_tree ($) { Line 424  sub print_document_tree ($) {
424      } elsif ($nt == $child->DOCUMENT_NODE) {      } elsif ($nt == $child->DOCUMENT_NODE) {
425        $r .= qq'<li id="$node_id" class="tree-document">Document';        $r .= qq'<li id="$node_id" class="tree-document">Document';
426        $r .= qq[<ul class="attributes">];        $r .= qq[<ul class="attributes">];
427          my $cp = $child->manakai_charset;
428          if (defined $cp) {
429            $r .= qq[<li><code>charset</code> parameter = <code>];
430            $r .= htescape ($cp) . qq[</code></li>];
431          }
432          $r .= qq[<li><code>inputEncoding</code> = ];
433          my $ie = $child->input_encoding;
434          if (defined $ie) {
435            $r .= qq[<code>@{[htescape ($ie)]}</code>];
436            if ($child->manakai_has_bom) {
437              $r .= qq[ (with <code class=charname><abbr>BOM</abbr></code>)];
438            }
439          } else {
440            $r .= qq[(<code>null</code>)];
441          }
442        $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>];
443        $r .= qq[<li>@{[scalar get_text ('manakaiCompatMode:'.$child->manakai_compat_mode)]}</li>];        $r .= qq[<li>@{[scalar get_text ('manakaiCompatMode:'.$child->manakai_compat_mode)]}</li>];
444        unless ($child->manakai_is_html) {        unless ($child->manakai_is_html) {
# Line 791  sub print_result_unknown_type_section ($ Line 806  sub print_result_unknown_type_section ($
806  </div>  </div>
807  ];  ];
808    push @nav, ['#parse-errors' => 'Errors'];    push @nav, ['#parse-errors' => 'Errors'];
809    add_error (char => {level => 'unsupported'} => $result);    add_error (char => {level => 'u'} => $result);
810    add_error (syntax => {level => 'unsupported'} => $result);    add_error (syntax => {level => 'u'} => $result);
811    add_error (structure => {level => 'unsupported'} => $result);    add_error (structure => {level => 'u'} => $result);
812  } # print_result_unknown_type_section  } # print_result_unknown_type_section
813    
814  sub print_result_input_error_section ($) {  sub print_result_input_error_section ($) {
# Line 850  sub get_error_level_label ($) { Line 865  sub get_error_level_label ($) {
865    } elsif ($err->{level} eq 'w') {    } elsif ($err->{level} eq 'w') {
866      $r = qq[<strong><a href="../error-description#level-w">Warning</a></strong>:      $r = qq[<strong><a href="../error-description#level-w">Warning</a></strong>:
867          ];          ];
868    } elsif ($err->{level} eq 'unsupported') {    } elsif ($err->{level} eq 'u' or $err->{level} eq 'unsupported') {
869      $r = qq[<strong><a href="../error-description#level-u">Not      $r = qq[<strong><a href="../error-description#level-u">Not
870          supported</a></strong>: ];          supported</a></strong>: ];
871    } else {    } else {
# Line 913  sub load_text_catalog ($) { Line 928  sub load_text_catalog ($) {
928  sub get_text ($) {  sub get_text ($) {
929    my ($type, $level, $node) = @_;    my ($type, $level, $node) = @_;
930    $type = $level . ':' . $type if defined $level;    $type = $level . ':' . $type if defined $level;
931      $level = 'm' unless defined $level;
932    my @arg;    my @arg;
933    {    {
934      if (defined $Msg->{$type}) {      if (defined $Msg->{$type}) {
# Line 937  sub get_text ($) { Line 953  sub get_text ($) {
953            ? htescape ($node->owner_element->manakai_local_name)            ? htescape ($node->owner_element->manakai_local_name)
954            : ''            : ''
955        }ge;        }ge;
956        return ($type, $Msg->{$type}->[0], $msg);        return ($type, 'level-' . $level . ' ' . $Msg->{$type}->[0], $msg);
957      } elsif ($type =~ s/:([^:]*)$//) {      } elsif ($type =~ s/:([^:]*)$//) {
958        unshift @arg, $1;        unshift @arg, $1;
959        redo;        redo;
960      }      }
961    }    }
962    return ($type, '', htescape ($_[0]));    return ($type, 'level-'.$level, htescape ($_[0]));
963  } # get_text  } # get_text
964    
965  }  }
# Line 999  EOH Line 1015  EOH
1015      $ua->protocols_allowed ([qw/http/]);      $ua->protocols_allowed ([qw/http/]);
1016      $ua->max_size (1000_000);      $ua->max_size (1000_000);
1017      my $req = HTTP::Request->new (GET => $request_uri);      my $req = HTTP::Request->new (GET => $request_uri);
1018        $req->header ('Accept-Encoding' => 'identity, *; q=0');
1019      my $res = $ua->request ($req);      my $res = $ua->request ($req);
1020      ## TODO: 401 sets |is_success| true.      ## TODO: 401 sets |is_success| true.
1021      if ($res->is_success or $http->get_parameter ('error-page')) {      if ($res->is_success or $http->get_parameter ('error-page')) {
Legend:
Removed from v.1.26  
changed lines
  Added in v.1.30
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24