/[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.54 by wakaba, Sun Jul 20 16:53:10 2008 UTC revision 1.55 by wakaba, Mon Jul 21 05:24:32 2008 UTC
# Line 44  my $out; Line 44  my $out;
44  ]);  ]);
45    
46    my $input = get_input_document ($http, $dom);    my $input = get_input_document ($http, $dom);
47    
48    $out->input ($input);    $out->input ($input);
49    $out->unset_flush;    $out->unset_flush;
50    
51    my $char_length = 0;    my $result = WebHACC::Result->new;
52      $result->output ($out);
53    $out->start_section (id => 'document-info', title => 'Information');    $result->{conforming_min} = 1;
54    $out->html (qq[<dl>    $result->{conforming_max} = 1;
55  <dt>Request URL</dt>  
56      <dd>]);    $out->html ('<script src="../cc-script.js"></script>');
57    $out->url ($input->{request_uri});  
58    $out->html (q[<dt>Document URL<!-- HTML5 document's address? -->    check_and_print ($input => $result => $out);
59      <dd>]);    
60    $out->url ($input->{uri}, id => 'anchor-document-url');    $result->generate_result_section;
   $out->html (q[  
     <script>  
       document.title = '<'  
           + document.getElementById ('anchor-document-url').href + '> \\u2014 '  
           + document.title;  
     </script>]);  
   ## NOTE: no </dl> yet  
   
   if (defined $input->{s}) {  
     $char_length = length $input->{s};  
   
     $out->html (qq[<dt>Base URI<dd>]);  
     $out->url ($input->{base_uri});  
     $out->html (qq[<dt>Internet Media Type</dt>  
     <dd><code class="MIME" lang="en">]);  
     $out->text ($input->{media_type});  
     $out->html (qq[</code> ]);  
     if ($input->{media_type_overridden}) {  
       $out->html ('<em>(overridden)</em>');  
     } elsif (defined $input->{official_type}) {  
       if ($input->{media_type} eq $input->{official_type}) {  
         #  
       } else {  
         $out->html ('<em>(sniffed; official type is: <code class=MIME lang=en>');  
         $out->text ($input->{official_type});  
         $out->html ('</code>)');  
       }  
     } else {  
       $out->html ('<em>(sniffed)</em>');  
     }  
     $out->html (q[<dt>Character Encoding<dd>]);  
     if (defined $input->{charset}) {  
       $out->html ('<code class="charset" lang="en">');  
       $out->text ($input->{charset});  
       $out->html ('</code>');  
     } else {  
       $out->text ('(none)');  
     }  
     $out->html (' <em>overridden</em>') if $input->{charset_overridden};  
     $out->html (qq[  
 <dt>Length</dt>  
     <dd>$char_length byte@{[$char_length == 1 ? '' : 's']}</dd>  
 </dl>  
   
 <script src="../cc-script.js"></script>  
 ]);  
     $out->end_section;  
   
     my $result = WebHACC::Result->new;  
     $result->output ($out);  
     $result->{conforming_min} = 1;  
     $result->{conforming_max} = 1;  
     check_and_print ($input => $result => $out);  
     $result->generate_result_section;  
   } else {  
     $out->html ('</dl>');  
     $out->end_section;  
   
     my $result = WebHACC::Result->new;  
     $result->output ($out);  
     $result->{conforming_min} = 0;  
     $result->{conforming_max} = 1;  
   
     $input->generate_transfer_sections ($result);  
     $result->generate_result_section;  
   }  
61    
62    $out->nav_list;    $out->nav_list;
63    
# Line 134  sub check_and_print ($$$) { Line 69  sub check_and_print ($$$) {
69    my $original_input = $out->input;    my $original_input = $out->input;
70    $out->input ($input);    $out->input ($input);
71    
72      $input->generate_info_section ($result);
73    
74    $input->generate_transfer_sections ($result);    $input->generate_transfer_sections ($result);
75    
76    my @subdoc;    unless (defined $input->{s}) {
77        $result->{conforming_min} = 0;
78        return;
79      }
80    
81    my $checker_class = {    my $checker_class = {
82      'text/cache-manifest' => 'WebHACC::Language::CacheManifest',      'text/cache-manifest' => 'WebHACC::Language::CacheManifest',
# Line 169  sub check_and_print ($$$) { Line 109  sub check_and_print ($$$) {
109    $checker->generate_syntax_error_section;    $checker->generate_syntax_error_section;
110    $checker->generate_source_string_section;    $checker->generate_source_string_section;
111    
112      my @subdoc;
113    $checker->onsubdoc (sub {    $checker->onsubdoc (sub {
114      push @subdoc, shift;      push @subdoc, shift;
115    });    });
# Line 199  sub check_and_print ($$$) { Line 140  sub check_and_print ($$$) {
140    
141    my $id_prefix = 0;    my $id_prefix = 0;
142    for my $_subinput (@subdoc) {    for my $_subinput (@subdoc) {
143      my $subinput = WebHACC::Input->new;      my $subinput = WebHACC::Input::Subdocument->new (++$id_prefix);
144      $subinput->{$_} = $_subinput->{$_} for keys %$_subinput;      $subinput->{$_} = $_subinput->{$_} for keys %$_subinput;
     $subinput->id_prefix ('subdoc-' . ++$id_prefix);  
     $subinput->nested (1);  
145      $subinput->{base_uri} = $subinput->{container_node}->base_uri      $subinput->{base_uri} = $subinput->{container_node}->base_uri
146          unless defined $subinput->{base_uri};          unless defined $subinput->{base_uri};
147      my $ebaseuri = htescape ($subinput->{base_uri});      $subinput->{parent_input} = $input;
     $out->start_section (id => $subinput->id_prefix,  
                          title => qq[Subdocument #$id_prefix]);  
     print STDOUT qq[  
       <dl>  
       <dt>Internet Media Type</dt>  
         <dd><code class="MIME" lang="en">@{[htescape $subinput->{media_type}]}</code>  
       <dt>Container Node</dt>  
         <dd>@{[get_node_link ($input, $subinput->{container_node})]}</dd>  
       <dt>Base <abbr title="Uniform Resource Identifiers">URI</abbr></dt>  
         <dd><code class=URI>&lt;<a href="$ebaseuri">$ebaseuri</a>></code></dd>  
       </dl>];                
148    
149      $subinput->{id_prefix} .= '-';      $subinput->start_section ($result);
150      check_and_print ($subinput => $result => $out);      check_and_print ($subinput => $result => $out);
151        $subinput->end_section ($result);
     $out->end_section;  
152    }    }
153    
154    $out->input ($original_input);    $out->input ($original_input);
Legend:
Removed from v.1.54  
changed lines
  Added in v.1.55
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24