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

Diff of /test/html-webhacc/WebHACC/Output.pm

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

revision 1.2 by wakaba, Sun Jul 20 16:53:10 2008 UTC revision 1.6 by wakaba, Mon Jul 21 09:54:59 2008 UTC
# Line 1  Line 1 
1  package WebHACC::Output;  package WebHACC::Output;
2  use strict;  use strict;
3    
4  require IO::Handle;  require IO::Handle;
5    use Scalar::Util qw/refaddr/;
6    
7  my $htescape = sub ($) {  my $htescape = sub ($) {
8    my $s = $_[0];    my $s = $_[0];
# Line 15  my $htescape = sub ($) { Line 17  my $htescape = sub ($) {
17  };  };
18    
19  sub new ($) {  sub new ($) {
20    return bless {nav => []}, shift;    return bless {nav => [], section_rank => 1}, shift;
21  } # new  } # new
22    
23  sub input ($;$) {  sub input ($;$) {
# Line 89  sub end_tag ($$) { Line 91  sub end_tag ($$) {
91    
92  sub start_section ($%) {  sub start_section ($%) {
93    my ($self, %opt) = @_;    my ($self, %opt) = @_;
94    
95      if (defined $opt{role}) {
96        if ($opt{role} eq 'parse-errors') {
97          $opt{id} ||= 'parse-errors';
98          $opt{title} ||= 'Parse Errors';
99          delete $opt{role};
100        } elsif ($opt{role} eq 'structure-errors') {
101          $opt{id} ||= 'document-errors';
102          $opt{title} ||= 'Structural Errors';
103          $opt{short_title} ||= 'Struct. Errors';
104          delete $opt{role};
105        } elsif ($opt{role} eq 'reformatted') {
106          $opt{id} ||= 'document-tree';
107          $opt{title} ||= 'Reformatted Document Source';
108          $opt{short_title} ||= 'Reformatted';
109          delete $opt{role}
110        } elsif ($opt{role} eq 'tree') {
111          $opt{id} ||= 'document-tree';
112          $opt{title} ||= 'Document Tree';
113          $opt{short_title} ||= 'Tree';
114          delete $opt{role};
115        } elsif ($opt{role} eq 'structure') {
116          $opt{id} ||= 'document-structure';
117          $opt{title} ||= 'Document Structure';
118          $opt{short_title} ||= 'Structure';
119          delete $opt{role};
120        }
121      }
122    
123      $self->{section_rank}++;
124    $self->html ('<div class=section');    $self->html ('<div class=section');
125    if (defined $opt{id}) {    if (defined $opt{id}) {
126      my $id = $self->input->id_prefix . $opt{id};      my $id = $self->input->id_prefix . $opt{id};
127      $self->html (' id="' . $htescape->($id) . '"');      $self->html (' id="' . $htescape->($id) . '"');
128      push @{$self->{nav}}, [$id => $opt{short_title} || $opt{title}]      push @{$self->{nav}}, [$id => $opt{short_title} || $opt{title}]
129          unless $self->input->nested;          if $self->{section_rank} == 2;
130    }    }
131    $self->html ('><h2>' . $htescape->($opt{title}) . '</h2>');    my $section_rank = $self->{section_rank};
132      $section_rank = 6 if $section_rank > 6;
133      $self->html ('><h' . $section_rank . '>' .
134                   $htescape->($opt{title}) .
135                   '</h' . $section_rank . '>');
136  } # start_section  } # start_section
137    
138  sub end_section ($) {  sub end_section ($) {
139    my $self = shift;    my $self = shift;
140    $self->html ('</div>');    $self->html ('</div>');
141    $self->{handle}->flush;    $self->{handle}->flush;
142      $self->{section_rank}--;
143  } # end_section  } # end_section
144    
145    sub start_error_list ($%) {
146      my ($self, %opt) = @_;
147    
148      if (defined $opt{role}) {
149        if ($opt{role} eq 'parse-errors') {
150          $opt{id} ||= 'parse-errors-list';
151          delete $opt{role};
152        } elsif ($opt{role} eq 'structure-errors') {
153          $opt{id} ||= 'document-errors-list';
154          delete $opt{role};
155        }
156      }
157    
158      $self->start_tag ('dl', %opt);
159    } # start_error_list
160    
161    sub end_error_list ($%) {
162      my ($self, %opt) = @_;
163    
164      if (defined $opt{role}) {
165        if ($opt{role} eq 'parse-errors') {
166          delete $opt{role};
167          $self->end_tag ('dl');
168          ## NOTE: For parse error list, the |add_source_to_parse_error_list|
169          ## method is invoked at the end of |generate_source_string_section|,
170          ## since that generation method is invoked after the error list
171          ## is generated.
172        } elsif ($opt{role} eq 'structure-errors') {
173          delete $opt{role};
174          $self->end_tag ('dl');
175          $self->add_source_to_parse_error_list ('document-errors-list');
176        } else {
177          $self->end_tag ('dl');
178        }
179      } else {
180        $self->end_tag ('dl');
181      }
182    } # end_error_list
183    
184    sub add_source_to_parse_error_list ($$) {
185      my $self = shift;
186    
187      $self->script (q[addSourceToParseErrorList ('] . $self->input->id_prefix .
188                     q[', '] . shift . q[')]);
189    } # add_source_to_parse_error_list
190    
191  sub start_code_block ($) {  sub start_code_block ($) {
192    shift->html ('<pre><code>');    shift->html ('<pre><code>');
193  } # start_code_block  } # start_code_block
# Line 113  sub end_code_block ($) { Line 196  sub end_code_block ($) {
196    shift->html ('</code></pre>');    shift->html ('</code></pre>');
197  } # end_code_block  } # end_code_block
198    
199  sub code ($$) {  sub code ($$;%) {
200    shift->html ('<code>' . $htescape->(shift) . '</code>');    my ($self, $content, %opt) = @_;
201      $self->start_tag ('code', %opt);
202      $self->text ($content);
203      $self->html ('</code>');
204  } # code  } # code
205    
206    sub script ($$;%) {
207      my ($self, $content, %opt) = @_;
208      $self->start_tag ('script', %opt);
209      $self->html ($content);
210      $self->html ('</script>');
211    } # script
212    
213    sub dt ($$;%) {
214      my ($self, $content, %opt) = @_;
215      $self->start_tag ('dt', %opt);
216      $self->text ($content);
217    } # dt
218    
219  sub link ($$%) {  sub link ($$%) {
220    my ($self, $content, %opt) = @_;    my ($self, $content, %opt) = @_;
221    $self->start_tag ('a', %opt, href => $opt{url});    $self->start_tag ('a', %opt, href => $opt{url});
# Line 137  sub link_to_webhacc ($$%) { Line 236  sub link_to_webhacc ($$%) {
236    $self->link ($content, %opt);    $self->link ($content, %opt);
237  } # link_to_webhacc  } # link_to_webhacc
238    
239    
240    my $get_node_path = sub ($) {
241      my $node = shift;
242      my @r;
243      while (defined $node) {
244        my $rs;
245        if ($node->node_type == 1) {
246          $rs = $node->node_name;
247          $node = $node->parent_node;
248        } elsif ($node->node_type == 2) {
249          $rs = '@' . $node->node_name;
250          $node = $node->owner_element;
251        } elsif ($node->node_type == 3) {
252          $rs = '"' . $node->data . '"';
253          $node = $node->parent_node;
254        } elsif ($node->node_type == 9) {
255          @r = ('') unless @r;
256          $rs = '';
257          $node = $node->parent_node;
258        } else {
259          $rs = '#' . $node->node_type;
260          $node = $node->parent_node;
261        }
262        unshift @r, $rs;
263      }
264      return join '/', @r;
265    }; # $get_node_path
266    
267    sub node_link ($$) {
268      my ($self, $node) = @_;
269      $self->xref ($get_node_path->($node), target => 'node-' . refaddr $node);
270    } # node_link
271    
272  sub nav_list ($) {  sub nav_list ($) {
273    my $self = shift;    my $self = shift;
274    $self->html (q[<ul class="navigation" id="nav-items">]);    $self->html (q[<ul class="navigation" id="nav-items">]);
275    for (@{$self->{nav}}) {    for (@{$self->{nav}}) {
276      $self->html (qq[<li><a href="@{[$htescape->($_->[0])]}">@{[$htescape->($_->[1])]}</a>]);      $self->html (qq[<li><a href="#@{[$htescape->($_->[0])]}">@{[$htescape->($_->[1])]}</a>]);
277    }    }
278    $self->html ('</ul>');    $self->html ('</ul>');
279  } # nav_list  } # nav_list
280    
281    sub http_header ($) {
282      shift->html (qq[Content-Type: text/html; charset=utf-8\n\n]);
283    } # http_header
284    
285    sub http_error ($$) {
286      my $self = shift;
287      my $code = 0+shift;
288      my $text = {
289        404 => 'Not Found',
290      }->{$code};
291      $self->html (qq[Status: $code $text\nContent-Type: text/html ; charset=us-ascii\n\n$code $text]);
292    } # http_error
293    
294    sub html_header ($) {
295      my $self = shift;
296      $self->html (q[<!DOCTYPE html>
297    <html lang="en">
298    <head>
299    <title>WebHACC (BETA) Result</title>
300    <link rel="stylesheet" href="../cc-style.css" type="text/css">
301    </head>
302    <body>
303    <h1><a href="../cc-interface"><abbr title="Web Hypertext Application Conformance Checker (BETA)"><img src="../icons/title" alt="WebHACC"></abbr></a></h1>
304    ]);
305    } # html_header
306    
307  sub encode_url_component ($$) {  sub encode_url_component ($$) {
308    shift;    shift;
Legend:
Removed from v.1.2  
changed lines
  Added in v.1.6
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24