Commit | Line | Data |
69473a20 |
1 | =pod |
2 | |
3 | =head1 NAME |
4 | |
5 | Pod::Simple::XHTML -- format Pod as validating XHTML |
6 | |
7 | =head1 SYNOPSIS |
8 | |
9 | use Pod::Simple::XHTML; |
10 | |
11 | my $parser = Pod::Simple::XHTML->new(); |
12 | |
13 | ... |
14 | |
15 | $parser->parse_file('path/to/file.pod'); |
16 | |
17 | =head1 DESCRIPTION |
18 | |
19 | This class is a formatter that takes Pod and renders it as XHTML |
20 | validating HTML. |
21 | |
22 | This is a subclass of L<Pod::Simple::Methody> and inherits all its |
23 | methods. The implementation is entirely different than |
24 | L<Pod::Simple::HTML>, but it largely preserves the same interface. |
25 | |
26 | =cut |
27 | |
28 | package Pod::Simple::XHTML; |
29 | use strict; |
30 | use vars qw( $VERSION @ISA ); |
31 | $VERSION = '3.04'; |
32 | use Carp (); |
33 | use Pod::Simple::Methody (); |
34 | @ISA = ('Pod::Simple::Methody'); |
35 | |
36 | use HTML::Entities 'encode_entities'; |
37 | |
38 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
39 | |
40 | =head1 METHODS |
41 | |
42 | Pod::Simple::XHTML offers a number of methods that modify the format of |
43 | the HTML output. Call these after creating the parser object, but before |
44 | the call to C<parse_file>: |
45 | |
46 | my $parser = Pod::PseudoPod::HTML->new(); |
47 | $parser->set_optional_param("value"); |
48 | $parser->parse_file($file); |
49 | |
50 | =head2 perldoc_url_prefix |
51 | |
52 | In turning L<Foo::Bar> into http://whatever/Foo%3a%3aBar, what |
53 | to put before the "Foo%3a%3aBar". The default value is |
54 | "http://search.cpan.org/perldoc?". |
55 | |
56 | =head2 perldoc_url_postfix |
57 | |
58 | What to put after "Foo%3a%3aBar" in the URL. This option is not set by |
59 | default. |
60 | |
61 | =head2 title_prefix, title_postfix |
62 | |
63 | What to put before and after the title in the head. The values should |
64 | already be &-escaped. |
65 | |
66 | =head2 html_css |
67 | |
68 | $parser->html_css('path/to/style.css'); |
69 | |
70 | The URL or relative path of a CSS file to include. This option is not |
71 | set by default. |
72 | |
73 | =head2 html_javascript |
74 | |
75 | The URL or relative path of a JavaScript file to pull in. This option is |
76 | not set by default. |
77 | |
78 | =head2 html_doctype |
79 | |
80 | A document type tag for the file. This option is not set by default. |
81 | |
82 | =head2 html_header_tags |
83 | |
84 | Additional arbitrary HTML tags for the header of the document. The |
85 | default value is just a content type header tag: |
86 | |
87 | <meta http-equiv="Content-Type" content="text/html; charset=ISO-8859-1"> |
88 | |
89 | Add additional meta tags here, or blocks of inline CSS or JavaScript |
90 | (wrapped in the appropriate tags). |
91 | |
92 | =head2 default_title |
93 | |
94 | Set a default title for the page if no title can be determined from the |
95 | content. The value of this string should already be &-escaped. |
96 | |
97 | =head2 force_title |
98 | |
99 | Force a title for the page (don't try to determine it from the content). |
100 | The value of this string should already be &-escaped. |
101 | |
102 | =head2 html_header, html_footer |
103 | |
104 | Set the HTML output at the beginning and end of each file. The default |
105 | header includes a title, a doctype tag (if C<html_doctype> is set), a |
106 | content tag (customized by C<html_header_tags>), a tag for a CSS file |
107 | (if C<html_css> is set), and a tag for a Javascript file (if |
108 | C<html_javascript> is set). The default footer simply closes the C<html> |
109 | and C<body> tags. |
110 | |
111 | The options listed above customize parts of the default header, but |
112 | setting C<html_header> or C<html_footer> completely overrides the |
113 | built-in header or footer. These may be useful if you want to use |
114 | template tags instead of literal HTML headers and footers or are |
115 | integrating converted POD pages in a larger website. |
116 | |
117 | If you want no headers or footers output in the HTML, set these options |
118 | to the empty string. |
119 | |
120 | =head2 index |
121 | |
122 | TODO -- Not implemented. |
123 | |
124 | Whether to add a table-of-contents at the top of each page (called an |
125 | index for the sake of tradition). |
126 | |
127 | |
128 | =cut |
129 | |
130 | __PACKAGE__->_accessorize( |
131 | 'perldoc_url_prefix', |
132 | 'perldoc_url_postfix', |
133 | 'title_prefix', 'title_postfix', |
134 | 'html_css', |
135 | 'html_javascript', |
136 | 'html_doctype', |
137 | 'html_header_tags', |
138 | 'title', # Used internally for the title extracted from the content |
139 | 'default_title', |
140 | 'force_title', |
141 | 'html_header', |
142 | 'html_footer', |
143 | 'index', |
144 | 'batch_mode', # whether we're in batch mode |
145 | 'batch_mode_current_level', |
146 | # When in batch mode, how deep the current module is: 1 for "LWP", |
147 | # 2 for "LWP::Procotol", 3 for "LWP::Protocol::GHTTP", etc |
148 | ); |
149 | |
150 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
151 | |
152 | =head1 SUBCLASSING |
153 | |
154 | If the standard options aren't enough, you may want to subclass |
155 | Pod::Simple::XHMTL. These are the most likely candidates for methods |
156 | you'll want to override when subclassing. |
157 | |
158 | =cut |
159 | |
160 | sub new { |
161 | my $self = shift; |
162 | my $new = $self->SUPER::new(@_); |
163 | $new->{'output_fh'} ||= *STDOUT{IO}; |
164 | $new->accept_targets( 'html', 'HTML' ); |
165 | $new->perldoc_url_prefix('http://search.cpan.org/perldoc?'); |
166 | $new->html_header_tags('<meta http-equiv="Content-Type" content="text/html; charset=ISO-8859-1">'); |
167 | $new->nix_X_codes(1); |
168 | $new->codes_in_verbatim(1); |
169 | $new->{'scratch'} = ''; |
170 | return $new; |
171 | } |
172 | |
173 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
174 | |
175 | =head2 handle_text |
176 | |
177 | This method handles the body of text within any element: it's the body |
178 | of a paragraph, or everything between a "=begin" tag and the |
179 | corresponding "=end" tag, or the text within an L entity, etc. You would |
180 | want to override this if you are adding a custom element type that does |
181 | more than just display formatted text. Perhaps adding a way to generate |
182 | HTML tables from an extended version of POD. |
183 | |
184 | So, let's say you want add a custom element called 'foo'. In your |
185 | subclass's C<new> method, after calling C<SUPER::new> you'd call: |
186 | |
187 | $new->accept_targets_as_text( 'foo' ); |
188 | |
189 | Then override the C<start_for> method in the subclass to check for when |
190 | "$flags->{'target'}" is equal to 'foo' and set a flag that marks that |
191 | you're in a foo block (maybe "$self->{'in_foo'} = 1"). Then override the |
192 | C<handle_text> method to check for the flag, and pass $text to your |
193 | custom subroutine to construct the HTML output for 'foo' elements, |
194 | something like: |
195 | |
196 | sub handle_text { |
197 | my ($self, $text) = @_; |
198 | if ($self->{'in_foo'}) { |
199 | $self->{'scratch'} .= build_foo_html($text); |
200 | } else { |
201 | $self->{'scratch'} .= $text; |
202 | } |
203 | } |
204 | |
205 | =cut |
206 | |
207 | sub handle_text { |
208 | # escape special characters in HTML (<, >, &, etc) |
209 | $_[0]{'scratch'} .= $_[0]{'in_verbatim'} ? encode_entities( $_[1] ) : $_[1] |
210 | } |
211 | |
212 | sub start_Para { $_[0]{'scratch'} = '<p>' } |
213 | sub start_Verbatim { $_[0]{'scratch'} = '<pre><code>'; $_[0]{'in_verbatim'} = 1} |
214 | |
215 | sub start_head1 { $_[0]{'scratch'} = '<h1>' } |
216 | sub start_head2 { $_[0]{'scratch'} = '<h2>' } |
217 | sub start_head3 { $_[0]{'scratch'} = '<h3>' } |
218 | sub start_head4 { $_[0]{'scratch'} = '<h4>' } |
219 | |
220 | sub start_item_bullet { $_[0]{'scratch'} = '<li>' } |
221 | sub start_item_number { $_[0]{'scratch'} = "<li>$_[1]{'number'}. " } |
222 | sub start_item_text { $_[0]{'scratch'} = '<li>' } |
223 | |
224 | sub start_over_bullet { $_[0]{'scratch'} = '<ul>'; $_[0]->emit } |
225 | sub start_over_text { $_[0]{'scratch'} = '<ul>'; $_[0]->emit } |
226 | sub start_over_block { $_[0]{'scratch'} = '<ul>'; $_[0]->emit } |
227 | sub start_over_number { $_[0]{'scratch'} = '<ol>'; $_[0]->emit } |
228 | |
229 | sub end_over_bullet { $_[0]{'scratch'} .= '</ul>'; $_[0]->emit } |
230 | sub end_over_text { $_[0]{'scratch'} .= '</ul>'; $_[0]->emit } |
231 | sub end_over_block { $_[0]{'scratch'} .= '</ul>'; $_[0]->emit } |
232 | sub end_over_number { $_[0]{'scratch'} .= '</ol>'; $_[0]->emit } |
233 | |
234 | # . . . . . Now the actual formatters: |
235 | |
236 | sub end_Para { $_[0]{'scratch'} .= '</p>'; $_[0]->emit } |
237 | sub end_Verbatim { |
238 | $_[0]{'scratch'} .= '</code></pre>'; |
239 | $_[0]{'in_verbatim'} = 0; |
240 | $_[0]->emit; |
241 | } |
242 | |
243 | sub end_head1 { $_[0]{'scratch'} .= '</h1>'; $_[0]->emit } |
244 | sub end_head2 { $_[0]{'scratch'} .= '</h2>'; $_[0]->emit } |
245 | sub end_head3 { $_[0]{'scratch'} .= '</h3>'; $_[0]->emit } |
246 | sub end_head4 { $_[0]{'scratch'} .= '</h4>'; $_[0]->emit } |
247 | |
248 | sub end_item_bullet { $_[0]{'scratch'} .= '</li>'; $_[0]->emit } |
249 | sub end_item_number { $_[0]{'scratch'} .= '</li>'; $_[0]->emit } |
250 | sub end_item_text { $_[0]->emit } |
251 | |
252 | # This handles =begin and =for blocks of all kinds. |
253 | sub start_for { |
254 | my ($self, $flags) = @_; |
255 | $self->{'scratch'} .= '<div'; |
256 | $self->{'scratch'} .= ' class="'.$flags->{'target'}.'"' if ($flags->{'target'}); |
257 | $self->{'scratch'} .= '>'; |
258 | $self->emit; |
259 | |
260 | } |
261 | sub end_for { |
262 | my ($self) = @_; |
263 | $self->{'scratch'} .= '</div>'; |
264 | $self->emit; |
265 | } |
266 | |
267 | sub start_Document { |
268 | my ($self) = @_; |
269 | if (defined $self->html_header) { |
270 | $self->{'scratch'} .= $self->html_header; |
271 | $self->emit unless $self->html_header eq ""; |
272 | } else { |
273 | my ($doctype, $title, $metatags); |
274 | $doctype = $self->html_doctype || ''; |
275 | $title = $self->force_title || $self->title || $self->default_title || ''; |
276 | $metatags = $self->html_header_tags || ''; |
277 | if ($self->html_css) { |
278 | $metatags .= "\n<link rel='stylesheet' href='" . |
279 | $self->html_css . "' type='text/css'>"; |
280 | } |
281 | if ($self->html_javascript) { |
282 | $metatags .= "\n<script type='text/javascript' src='" . |
283 | $self->html_javascript . "'></script>"; |
284 | } |
285 | $self->{'scratch'} .= <<"HTML"; |
286 | $doctype |
287 | <html> |
288 | <head> |
289 | <title>$title</title> |
290 | $metatags |
291 | </head> |
292 | <body> |
293 | HTML |
294 | $self->emit; |
295 | } |
296 | } |
297 | |
298 | sub end_Document { |
299 | my ($self) = @_; |
300 | if (defined $self->html_footer) { |
301 | $self->{'scratch'} .= $self->html_footer; |
302 | $self->emit unless $self->html_footer eq ""; |
303 | } else { |
304 | $self->{'scratch'} .= "</body>\n</html>"; |
305 | $self->emit; |
306 | } |
307 | } |
308 | |
309 | # Handling code tags |
310 | sub start_B { $_[0]{'scratch'} .= '<b>' } |
311 | sub end_B { $_[0]{'scratch'} .= '</b>' } |
312 | |
313 | sub start_C { $_[0]{'scratch'} .= '<code>' } |
314 | sub end_C { $_[0]{'scratch'} .= '</code>' } |
315 | |
316 | sub start_E { $_[0]{'scratch'} .= '&' } |
317 | sub end_E { $_[0]{'scratch'} .= ';' } |
318 | |
319 | sub start_F { $_[0]{'scratch'} .= '<i>' } |
320 | sub end_F { $_[0]{'scratch'} .= '</i>' } |
321 | |
322 | sub start_I { $_[0]{'scratch'} .= '<i>' } |
323 | sub end_I { $_[0]{'scratch'} .= '</i>' } |
324 | |
325 | sub start_L { |
326 | my ($self, $flags) = @_; |
327 | my $url; |
328 | if ($flags->{'type'} eq 'url') { |
329 | $url = $flags->{'to'}; |
330 | } elsif ($flags->{'type'} eq 'pod') { |
331 | $url .= $self->perldoc_url_prefix || ''; |
332 | $url .= $flags->{'to'} || ''; |
333 | $url .= '/' . $flags->{'section'} if ($flags->{'section'}); |
334 | $url .= $self->perldoc_url_postfix || ''; |
335 | # require Data::Dumper; |
336 | # print STDERR Data::Dumper->Dump([$flags]); |
337 | } |
338 | |
339 | $self->{'scratch'} .= '<a href="'. $url . '">'; |
340 | } |
341 | sub end_L { $_[0]{'scratch'} .= '</a>' } |
342 | |
343 | sub start_S { $_[0]{'scratch'} .= '<nobr>' } |
344 | sub end_S { $_[0]{'scratch'} .= '</nobr>' } |
345 | |
346 | sub emit { |
347 | my($self) = @_; |
348 | my $out = $self->{'scratch'} . "\n"; |
349 | print {$self->{'output_fh'}} $out, "\n"; |
350 | $self->{'scratch'} = ''; |
351 | return; |
352 | } |
353 | |
354 | # Bypass built-in E<> handling to preserve entity encoding |
355 | sub _treat_Es {} |
356 | |
357 | 1; |
358 | |
359 | __END__ |
360 | |
361 | =head1 SEE ALSO |
362 | |
363 | L<Pod::Simple>, L<Pod::Simple::Methody> |
364 | |
365 | =head1 COPYRIGHT |
366 | |
367 | Copyright (c) 2003-2005 Allison Randal. |
368 | |
369 | This library is free software; you can redistribute it and/or modify |
370 | it under the same terms as Perl itself. The full text of the license |
371 | can be found in the LICENSE file included with this module. |
372 | |
373 | This library is distributed in the hope that it will be useful, but |
374 | without any warranty; without even the implied warranty of |
375 | merchantability or fitness for a particular purpose. |
376 | |
377 | =head1 AUTHOR |
378 | |
379 | Allison Randal <allison@perl.org> |
380 | |
381 | =cut |
382 | |