/[suikacvs]/test/html-webhacc/WebHACC/Language/DOM.pm
Suika

Diff of /test/html-webhacc/WebHACC/Language/DOM.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.1 by wakaba, Sun Jul 20 14:58:24 2008 UTC revision 1.7 by wakaba, Thu Aug 14 15:50:42 2008 UTC
# Line 10  sub generate_structure_dump_section ($) Line 10  sub generate_structure_dump_section ($)
10        
11    my $out = $self->output;    my $out = $self->output;
12    
13    $out->start_section (id => 'document-tree', title => 'Document Tree',    $out->start_section (role => 'tree');
                        short_title => 'Tree');  
14    
15    $out->start_tag ('ol', class => 'xoxo');    $out->start_tag ('ol', class => 'xoxo');
16    
# Line 83  sub generate_structure_dump_section ($) Line 82  sub generate_structure_dump_section ($)
82        $out->end_tag ('code');        $out->end_tag ('code');
83      } elsif ($nt == $child->DOCUMENT_NODE) {      } elsif ($nt == $child->DOCUMENT_NODE) {
84        $out->start_tag ('li', id => $node_id, class => 'tree-document');        $out->start_tag ('li', id => $node_id, class => 'tree-document');
85        $out->text ('Document');        $out->nl_text ('Document');
86    
87        $out->start_tag ('ul', class => 'attributes');        $out->start_tag ('ul', class => 'attributes');
88          
89        my $cp = $child->manakai_charset;        my $cp = $child->manakai_charset;
90        if (defined $cp) {        if (defined $cp) {
91          $out->html (qq[<li><code>charset</code> parameter = <code>]);          $out->start_tag ('li');
92          $out->text ($cp);          $out->nl_text ('manakaiCharset');
93          $out->html ('</code>');          $out->text (' = ');
94            $out->code ($cp);
95        }        }
96        $out->html (qq[<li><code>inputEncoding</code> = ]);        
97          $out->start_tag ('li');
98          $out->nl_text ('inputEncoding');
99          $out->text (' = ');
100        my $ie = $child->input_encoding;        my $ie = $child->input_encoding;
101        if (defined $ie) {        if (defined $ie) {
102          $out->code ($ie);          $out->code ($ie);
103          if ($child->manakai_has_bom) {          if ($child->manakai_has_bom) {
104            $out->html (qq[ (with <code class=charname><abbr>BOM</abbr></code>)]);            $out->nl_text ('... with BOM');
105          }          }
106        } else {        } else {
107          $out->html (qq[(<code>null</code>)]);          $out->html (qq[(<code>null</code>)]);
108        }        }
109        $out->html (qq[<li>@{[scalar main::get_text ('manakaiIsHTML:'.($child->manakai_is_html?1:0))]}</li>]);  
110        $out->html (qq[<li>@{[scalar main::get_text ('manakaiCompatMode:'.$child->manakai_compat_mode)]}</li>]);        $out->start_tag ('li');
111          $out->nl_text ('manakaiIsHTML:'.($child->manakai_is_html?1:0));
112    
113          $out->start_tag ('li');
114          $out->nl_text ('manakaiCompatMode:'.$child->manakai_compat_mode);
115    
116        unless ($child->manakai_is_html) {        unless ($child->manakai_is_html) {
117          $out->html (qq[<li>XML version = ]);          $out->start_tag ('li');
118            $out->nl_text ('xmlVersion');
119            $out->text (' = ');
120          $out->code ($child->xml_version);          $out->code ($child->xml_version);
121            
122            $out->start_tag ('li');
123            $out->nl_text ('xmlEncoding');
124            $out->text (' = ');
125          if (defined $child->xml_encoding) {          if (defined $child->xml_encoding) {
           $out->html (qq[<li>XML encoding = ]);  
126            $out->code ($child->xml_encoding);            $out->code ($child->xml_encoding);
127          } else {          } else {
128            $out->html (qq[<li>XML encoding = (null)</li>]);            $out->html ('(<code>null</code>)');
129          }          }
130          $out->html (qq[<li>XML standalone = @{[$child->xml_standalone ? 'true' : 'false']}</li>]);  
131            $out->start_tag ('li');
132            $out->nl_text ('xmlStandalone');
133            $out->text (' = ');
134            $out->code ($child->xml_standalone ? 'true' : 'false');
135        }        }
136    
137        $out->end_tag ('ul');        $out->end_tag ('ul');
138          
139        if ($child->has_child_nodes) {        if ($child->has_child_nodes) {
140          $out->start_tag ('ol', class => 'children');          $out->start_tag ('ol', class => 'children');
141          unshift @node, @{$child->child_nodes}, '</ol></li>';          unshift @node, @{$child->child_nodes}, '</ol></li>';
# Line 158  sub generate_structure_error_section ($) Line 179  sub generate_structure_error_section ($)
179    my $self = shift;    my $self = shift;
180        
181    my $out = $self->output;    my $out = $self->output;
182    $out->start_section (id => 'document-errors', title => 'Document Errors');    $out->start_section (role => 'structure-errors');
183    $out->start_tag ('dl', class => 'document-errors-list');    $out->start_error_list (role => 'structure-errors');
184      $self->result->layer_applicable ('structure');
185    
186    my $input = $self->input;    my $input = $self->input;
187    my $result = $self->result;    my $result = $self->result;
188    
189    require Whatpm::ContentChecker;    require Whatpm::ContentChecker;
190    my $onerror = sub {    my $onerror = sub {
191      my %opt = @_;      $result->add_error (@_, layer => 'structure');
     my ($type, $cls, $msg) = main::get_text ($opt{type}, $opt{level}, $opt{node});  
     $type =~ tr/ /-/;  
     $type =~ s/\|/%7C/g;  
     $out->html (qq[<dt class="$cls">] . $result->get_error_label ($input, \%opt));  
     $out->html (qq[<dd class="$cls">] . $result->get_error_level_label (\%opt));  
     $out->html ($msg);  
     $out->text (' [');  
     $out->link ('Description', url => '../error-description#' . $type);  
     $out->text (']');  
     main::add_error ('structure', \%opt => $result);  
192    };    };
193    
194    my $onsubdoc = $self->onsubdoc;    my $onsubdoc = $self->onsubdoc;
# Line 188  sub generate_structure_error_section ($) Line 200  sub generate_structure_error_section ($)
200          ($self->{structure}, $onerror, $onsubdoc);          ($self->{structure}, $onerror, $onsubdoc);
201    }    }
202    
203    $out->end_tag ('dl');    $out->end_error_list (role => 'structure-errors');
   $out->html (qq[<script>  
     addSourceToParseErrorList ('@{[$input->id_prefix]}', 'document-errors-list');  
   </script>]);  
204    $out->end_section;    $out->end_section;
205    
206      $self->result->layer_uncertain ('semantics');
207  } # generate_structure_error_section  } # generate_structure_error_section
208    
209    sub generate_additional_sections ($) {
210      my $self = shift;
211      $self->SUPER::generate_additional_sections;
212    
213      $self->generate_table_section;
214    
215      $self->generate_listing_section (
216          key => 'id', id => 'identifiers',
217          short_title => 'IDs', title => 'Identifiers',
218      );
219      $self->generate_listing_section (
220          key => 'term', id => 'terms',
221          short_title => 'Terms', title => 'Terms',
222      );
223      $self->generate_listing_section (
224          key => 'class', id => 'classes',
225          short_title => 'Classes', title => 'Classes',
226      );
227    
228      $self->generate_rdf_section;
229    } # generate_additional_sections
230    
231    sub generate_table_section ($) {
232      my $self = shift;
233    
234      my $tables = $self->{add_info}->{table} || [];
235      return unless @$tables;
236    
237      my $out = $self->output;
238      $out->start_section (id => 'tables', short_title => 'Tables',
239                           title => 'Tables Section');
240    
241      $out->html (q[<!--[if IE]><script type="text/javascript" src="../excanvas.js"></script><![endif]-->
242    <script src="../table-script.js" type="text/javascript"></script>
243    <noscript>
244    <p><em>Structure of tables are visualized here if scripting is enabled.</em></p>
245    </noscript>]);
246      
247      require JSON;
248      
249      my $i = 0;
250      for my $table (@$tables) {
251        $i++;
252        my $index = $out->input->full_subdocument_index;
253        $index = $index ? $index . '.' . $i : $i;
254        $out->start_section (id => 'table-' . $i,
255                             title => 'Table #',
256                             text => $index);
257    
258        $out->start_tag ('dl');
259        $out->dt ('Table Element');
260        $out->start_tag ('dd');
261        $out->node_link ($table->{element});
262        $out->end_tag ('dl');
263        delete $table->{element};
264    
265        for (@{$table->{column_group}}, @{$table->{column}}, $table->{caption},
266             @{$table->{row}}) {
267          next unless $_;
268          delete $_->{element};
269        }
270        
271        for (@{$table->{row_group}}) {
272          next unless $_;
273          next unless $_->{element};
274          $_->{type} = $_->{element}->manakai_local_name;
275          delete $_->{element};
276        }
277        
278        for (@{$table->{cell}}) {
279          next unless $_;
280          for (@{$_}) {
281            next unless $_;
282            for (@$_) {
283              $_->{id} = refaddr $_->{element} if defined $_->{element};
284              delete $_->{element};
285              $_->{is_header} = $_->{is_header} ? 1 : 0;
286            }
287          }
288        }
289    
290        my $id_prefix = $self->input->id_prefix;
291        $out->script (q[tableToCanvas (] .
292            JSON::objToJson ($table) .
293            q[, document.getElementById ('] . $id_prefix . 'table-' . $i . q[')] .
294            q[, '] . $id_prefix . q[');]);
295    
296        $out->end_section;
297      }
298    
299      $out->end_section;
300    } # generate_table_section
301    
302    sub generate_listing_section ($%) {
303      my $self = shift;
304      my %opt = @_;
305    
306      my $list = $self->{add_info}->{$opt{key}} || {};
307      return unless keys %$list;
308    
309      my $out = $self->output;
310    
311      $out->start_section (id => $opt{id},
312                           title => $opt{title},
313                           short_title => $opt{short_title});
314      $out->start_tag ('dl');
315    
316      for my $id (sort {$a cmp $b} keys %$list) {
317        $out->start_tag ('dt');
318        $out->code ($id);
319        for (@{$list->{$id}}) {
320          $out->start_tag ('dd');
321          $out->node_link ($_);
322        }
323      }
324    
325      $out->end_tag ('dl');
326      $out->end_section;
327    } # generate_listing_section
328    
329    my $generate_rdf_resource_html = sub ($$) {
330      my ($resource, $out) = @_;
331    
332      if (defined $resource->{uri}) {
333        $out->url ($resource->{uri});
334      } elsif (defined $resource->{bnodeid}) {
335        $out->text ('_:' . $resource->{bnodeid});
336      } elsif ($resource->{nodes}) {
337        $out->text ('(rdf:XMLLiteral)');
338      } elsif (defined $resource->{value}) {
339        $out->start_tag ('q',
340                         lang => defined $resource->{language}
341                             ? $resource->{language} : '');
342        $out->text ($resource->{value});
343        $out->end_tag ('q');
344    
345        if (defined $resource->{datatype}) {
346          $out->text ('^^');
347          $out->url ($resource->{datatype});
348        } elsif (length $resource->{language}) {
349          $out->text ('@' . $resource->{language});
350        }
351      } else {
352        $out->text ('??'); ## NOTE: An error of the implementation.
353      }
354    }; # $generate_rdf_resource_html
355    
356    ## TODO: Should we move this method to another module,
357    ## such as Base or RDF?
358    sub generate_rdf_section ($) {
359      my $self = shift;
360    
361      my $list = $self->{add_info}->{rdf} || [];
362      return unless @$list;
363    
364      my $out = $self->output;
365      $out->start_section (id => 'rdf', short_title => 'RDF',
366                           title => 'RDF Triples');
367      $out->start_tag ('dl');
368    
369      my $i = 0;
370      for my $rdf (@$list) {
371        $out->start_tag ('dt', id => 'rdf-' . $i++);
372        $out->node_link ($rdf->[0]);
373        $out->start_tag ('dd');
374        $out->start_tag ('dl');
375        for my $triple (@{$rdf->[1]}) {
376          $out->start_tag ('dt');
377          $out->node_link ($triple->[0]);
378          $out->start_tag ('dd');
379          $out->text ('Subject: ');
380          $generate_rdf_resource_html->($triple->[1] => $out);
381          $out->start_tag ('dd');
382          $out->text ('Predicate: ');
383          $generate_rdf_resource_html->($triple->[2] => $out);
384          $out->start_tag ('dd');
385          $out->text ('Object: ');
386          $generate_rdf_resource_html->($triple->[3] => $out);
387        }
388        $out->end_tag ('dl');
389      }
390      $out->end_tag ('dl');
391      $out->end_section;
392    } # generate_rdf_section
393    
394  1;  1;
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.7
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24