/[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.32 by wakaba, Sun Feb 10 02:30:14 2008 UTC revision 1.34 by wakaba, Sun Feb 10 03:11:06 2008 UTC
# Line 155  sub check_and_print ($$) { Line 155  sub check_and_print ($$) {
155    my $doc;    my $doc;
156    my $el;    my $el;
157    my $manifest;    my $manifest;
158      my @subdoc;
159    
160    if ($input->{media_type} eq 'text/html') {    if ($input->{media_type} eq 'text/html') {
161      ($doc, $el) = print_syntax_error_html_section ($input, $result);      ($doc, $el) = print_syntax_error_html_section ($input, $result);
# Line 180  sub check_and_print ($$) { Line 181  sub check_and_print ($$) {
181    }    }
182    
183    if (defined $doc or defined $el) {    if (defined $doc or defined $el) {
184        $doc->document_uri ($input->{uri});
185        $doc->manakai_entity_base_uri ($input->{base_uri});
186      print_structure_dump_dom_section ($input, $doc, $el);      print_structure_dump_dom_section ($input, $doc, $el);
187      my $elements = print_structure_error_dom_section      my $elements = print_structure_error_dom_section
188          ($input, $doc, $el, $result);          ($input, $doc, $el, $result, sub {
189              push @subdoc, shift;
190            });
191      print_table_section ($input, $elements->{table}) if @{$elements->{table}};      print_table_section ($input, $elements->{table}) if @{$elements->{table}};
192      print_id_section ($input, $elements->{id}) if keys %{$elements->{id}};      print_listing_section ({
193      print_term_section ($input, $elements->{term}) if keys %{$elements->{term}};        id => 'identifiers', label => 'IDs', heading => 'Identifiers',
194      print_class_section ($input, $elements->{class}) if keys %{$elements->{class}};      }, $input, $elements->{id}) if keys %{$elements->{id}};
195        print_listing_section ({
196          id => 'terms', label => 'Terms', heading => 'Terms',
197        }, $input, $elements->{term}) if keys %{$elements->{term}};
198        print_listing_section ({
199          id => 'classes', label => 'Classes', heading => 'Classes',
200        }, $input, $elements->{class}) if keys %{$elements->{class}};
201    } elsif (defined $manifest) {    } elsif (defined $manifest) {
202      print_structure_dump_manifest_section ($input, $manifest);      print_structure_dump_manifest_section ($input, $manifest);
203      print_structure_error_manifest_section ($input, $manifest, $result);      print_structure_error_manifest_section ($input, $manifest, $result);
204    }    }
205    
206      my $id_prefix = 0;
207      for my $subinput (@subdoc) {
208        $subinput->{id_prefix} = 'subdoc-' . ++$id_prefix;
209        $subinput->{nested} = 1;
210        $subinput->{base_uri} = $subinput->{container_node}->base_uri
211            unless defined $subinput->{base_uri};
212        my $ebaseuri = htescape ($subinput->{base_uri});
213        push @nav, ['#' . $subinput->{id_prefix} => 'Sub #' . $id_prefix];
214        print STDOUT qq[<div id="$subinput->{id_prefix}" class=section>
215          <h2>Subdocument #$id_prefix</h2>
216    
217          <dl>
218          <dt>Internet Media Type</dt>
219            <dd><code class="MIME" lang="en">@{[htescape $subinput->{media_type}]}</code>
220          <dt>Container Node</dt>
221            <dd>@{[get_node_link ($input, $subinput->{container_node})]}</dd>
222          <dt>Base <abbr title="Uniform Resource Identifiers">URI</abbr></dt>
223            <dd><code class=URI>&lt;<a href="$ebaseuri">$ebaseuri</a>></code></dd>
224          </dl>];              
225    
226        check_and_print ($subinput => $result);
227    
228        print STDOUT qq[</div>];
229      }
230  } # check_and_print  } # check_and_print
231    
232  sub print_http_header_section ($$) {  sub print_http_header_section ($$) {
233    my ($input, $result) = @_;    my ($input, $result) = @_;
234    return unless defined $input->{header_status_code} or    return unless defined $input->{header_status_code} or
235        defined $input->{header_status_text} or        defined $input->{header_status_text} or
236        @{$input->{header_field}};        @{$input->{header_field} or []};
237        
238    push @nav, ['#source-header' => 'HTTP Header'] unless $input->{nested};    push @nav, ['#source-header' => 'HTTP Header'] unless $input->{nested};
239    print STDOUT qq[<div id="$input->{id_prefix}source-header" class="section">    print STDOUT qq[<div id="$input->{id_prefix}source-header" class="section">
# Line 531  sub print_structure_dump_manifest_sectio Line 567  sub print_structure_dump_manifest_sectio
567    print STDOUT qq[</dl></div>];    print STDOUT qq[</dl></div>];
568  } # print_structure_dump_manifest_section  } # print_structure_dump_manifest_section
569    
570  sub print_structure_error_dom_section ($$$$) {  sub print_structure_error_dom_section ($$$$$) {
571    my ($input, $doc, $el, $result) = @_;    my ($input, $doc, $el, $result, $onsubdoc) = @_;
572    
573    print STDOUT qq[<div id="$input->{id_prefix}document-errors" class="section">    print STDOUT qq[<div id="$input->{id_prefix}document-errors" class="section">
574  <h2>Document Errors</h2>  <h2>Document Errors</h2>
# Line 556  sub print_structure_error_dom_section ($ Line 592  sub print_structure_error_dom_section ($
592    my $elements;    my $elements;
593    my $time1 = time;    my $time1 = time;
594    if ($el) {    if ($el) {
595      $elements = Whatpm::ContentChecker->check_element ($el, $onerror);      $elements = Whatpm::ContentChecker->check_element
596            ($el, $onerror, $onsubdoc);
597    } else {    } else {
598      $elements = Whatpm::ContentChecker->check_document ($doc, $onerror);      $elements = Whatpm::ContentChecker->check_document
599            ($doc, $onerror, $onsubdoc);
600    }    }
601    $time{check} = time - $time1;    $time{check} = time - $time1;
602    
# Line 651  sub print_table_section ($$) { Line 689  sub print_table_section ($$) {
689    print STDOUT qq[</div>];    print STDOUT qq[</div>];
690  } # print_table_section  } # print_table_section
691    
692  sub print_id_section ($$) {  sub print_listing_section ($$$) {
693    my ($input, $ids) = @_;    my ($opt, $input, $ids) = @_;
694        
695    push @nav, ['#identifiers' => 'IDs'] unless $input->{nested};    push @nav, ['#' . $opt->{id} => $opt->{label}] unless $input->{nested};
696    print STDOUT qq[    print STDOUT qq[
697  <div id="$input->{id_prefix}identifiers" class="section">  <div id="$input->{id_prefix}$opt->{id}" class="section">
698  <h2>Identifiers</h2>  <h2>$opt->{heading}</h2>
699    
700  <dl>  <dl>
701  ];  ];
# Line 668  sub print_id_section ($$) { Line 706  sub print_id_section ($$) {
706      }      }
707    }    }
708    print STDOUT qq[</dl></div>];    print STDOUT qq[</dl></div>];
709  } # print_id_section  } # print_listing_section
   
 sub print_term_section ($$) {  
   my ($input, $terms) = @_;  
     
   push @nav, ['#terms' => 'Terms'] unless $input->{nested};  
   print STDOUT qq[  
 <div id="$input->{id_prefix}terms" class="section">  
 <h2>Terms</h2>  
   
 <dl>  
 ];  
   for my $term (sort {$a cmp $b} keys %$terms) {  
     print STDOUT qq[<dt>@{[htescape $term]}</dt>];  
     for (@{$terms->{$term}}) {  
       print STDOUT qq[<dd>].get_node_link ($input, $_).qq[</dd>];  
     }  
   }  
   print STDOUT qq[</dl></div>];  
 } # print_term_section  
   
 sub print_class_section ($$) {  
   my ($input, $classes) = @_;  
     
   push @nav, ['#classes' => 'Classes'] unless $input->{nested};  
   print STDOUT qq[  
 <div id="$input->{id_prefix}classes" class="section">  
 <h2>Classes</h2>  
   
 <dl>  
 ];  
   for my $class (sort {$a cmp $b} keys %$classes) {  
     print STDOUT qq[<dt><code>@{[htescape $class]}</code></dt>];  
     for (@{$classes->{$class}}) {  
       print STDOUT qq[<dd>].get_node_link ($input, $_).qq[</dd>];  
     }  
   }  
   print STDOUT qq[</dl></div>];  
 } # print_class_section  
710    
711  sub print_result_section ($) {  sub print_result_section ($) {
712    my $result = shift;    my $result = shift;
Legend:
Removed from v.1.32  
changed lines
  Added in v.1.34
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24