/[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.1 by wakaba, Sun Jul 20 14:58:24 2008 UTC revision 1.4 by wakaba, Mon Jul 21 08:39:12 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->html ('<a href="' . $htescape->($opt{url}) . '">');    $self->start_tag ('a', %opt, href => $opt{url});
222    $self->text ($content);    $self->text ($content);
223    $self->html ('</a>');    $self->html ('</a>');
224  } # link  } # link
# Line 131  sub xref ($$%) { Line 230  sub xref ($$%) {
230    $self->html ('</a>');    $self->html ('</a>');
231  } # xref  } # xref
232    
233    sub link_to_webhacc ($$%) {
234      my ($self, $content, %opt) = @_;
235      $opt{url} = './?uri=' . $self->encode_url_component ($opt{url});
236      $self->link ($content, %opt);
237    } # 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    
282    sub encode_url_component ($$) {
283      shift;
284      require Encode;
285      my $s = Encode::encode ('utf8', shift);
286      $s =~ s/([^0-9A-Za-z_.~-])/sprintf '%%%02X', ord $1/ge;
287      return $s;
288    } # encode_url_component
289    
290  1;  1;
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.4
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24