5 Pod::Simple::XHTML -- format Pod as validating XHTML
9 use Pod::Simple::XHTML;
11 my $parser = Pod::Simple::XHTML->new();
15 $parser->parse_file('path/to/file.pod');
19 This class is a formatter that takes Pod and renders it as XHTML
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.
28 package Pod::Simple::XHTML;
30 use vars qw( $VERSION @ISA $HAS_HTML_ENTITIES );
33 use Pod::Simple::Methody ();
34 @ISA = ('Pod::Simple::Methody');
37 $HAS_HTML_ENTITIES = eval "require HTML::Entities; 1";
49 return HTML::Entities::encode_entities( $_[0] ) if $HAS_HTML_ENTITIES;
51 my $ents = join '', keys %entities;
52 $str =~ s/([$ents])/'&' . $entities{$1} . ';'/ge;
56 #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
60 Pod::Simple::XHTML offers a number of methods that modify the format of
61 the HTML output. Call these after creating the parser object, but before
62 the call to C<parse_file>:
64 my $parser = Pod::PseudoPod::HTML->new();
65 $parser->set_optional_param("value");
66 $parser->parse_file($file);
68 =head2 perldoc_url_prefix
70 In turning L<Foo::Bar> into http://whatever/Foo%3a%3aBar, what
71 to put before the "Foo%3a%3aBar". The default value is
72 "http://search.cpan.org/perldoc?".
74 =head2 perldoc_url_postfix
76 What to put after "Foo%3a%3aBar" in the URL. This option is not set by
79 =head2 title_prefix, title_postfix
81 What to put before and after the title in the head. The values should
86 $parser->html_css('path/to/style.css');
88 The URL or relative path of a CSS file to include. This option is not
91 =head2 html_javascript
93 The URL or relative path of a JavaScript file to pull in. This option is
98 A document type tag for the file. This option is not set by default.
100 =head2 html_header_tags
102 Additional arbitrary HTML tags for the header of the document. The
103 default value is just a content type header tag:
105 <meta http-equiv="Content-Type" content="text/html; charset=ISO-8859-1">
107 Add additional meta tags here, or blocks of inline CSS or JavaScript
108 (wrapped in the appropriate tags).
112 Set a default title for the page if no title can be determined from the
113 content. The value of this string should already be &-escaped.
117 Force a title for the page (don't try to determine it from the content).
118 The value of this string should already be &-escaped.
120 =head2 html_header, html_footer
122 Set the HTML output at the beginning and end of each file. The default
123 header includes a title, a doctype tag (if C<html_doctype> is set), a
124 content tag (customized by C<html_header_tags>), a tag for a CSS file
125 (if C<html_css> is set), and a tag for a Javascript file (if
126 C<html_javascript> is set). The default footer simply closes the C<html>
129 The options listed above customize parts of the default header, but
130 setting C<html_header> or C<html_footer> completely overrides the
131 built-in header or footer. These may be useful if you want to use
132 template tags instead of literal HTML headers and footers or are
133 integrating converted POD pages in a larger website.
135 If you want no headers or footers output in the HTML, set these options
140 TODO -- Not implemented.
142 Whether to add a table-of-contents at the top of each page (called an
143 index for the sake of tradition).
148 __PACKAGE__->_accessorize(
149 'perldoc_url_prefix',
150 'perldoc_url_postfix',
151 'title_prefix', 'title_postfix',
156 'title', # Used internally for the title extracted from the content
162 'batch_mode', # whether we're in batch mode
163 'batch_mode_current_level',
164 # When in batch mode, how deep the current module is: 1 for "LWP",
165 # 2 for "LWP::Procotol", 3 for "LWP::Protocol::GHTTP", etc
168 #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
172 If the standard options aren't enough, you may want to subclass
173 Pod::Simple::XHMTL. These are the most likely candidates for methods
174 you'll want to override when subclassing.
180 my $new = $self->SUPER::new(@_);
181 $new->{'output_fh'} ||= *STDOUT{IO};
182 $new->accept_targets( 'html', 'HTML' );
183 $new->perldoc_url_prefix('http://search.cpan.org/perldoc?');
184 $new->html_header_tags('<meta http-equiv="Content-Type" content="text/html; charset=ISO-8859-1">');
185 $new->nix_X_codes(1);
186 $new->codes_in_verbatim(1);
187 $new->{'scratch'} = '';
191 #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
195 This method handles the body of text within any element: it's the body
196 of a paragraph, or everything between a "=begin" tag and the
197 corresponding "=end" tag, or the text within an L entity, etc. You would
198 want to override this if you are adding a custom element type that does
199 more than just display formatted text. Perhaps adding a way to generate
200 HTML tables from an extended version of POD.
202 So, let's say you want add a custom element called 'foo'. In your
203 subclass's C<new> method, after calling C<SUPER::new> you'd call:
205 $new->accept_targets_as_text( 'foo' );
207 Then override the C<start_for> method in the subclass to check for when
208 "$flags->{'target'}" is equal to 'foo' and set a flag that marks that
209 you're in a foo block (maybe "$self->{'in_foo'} = 1"). Then override the
210 C<handle_text> method to check for the flag, and pass $text to your
211 custom subroutine to construct the HTML output for 'foo' elements,
215 my ($self, $text) = @_;
216 if ($self->{'in_foo'}) {
217 $self->{'scratch'} .= build_foo_html($text);
219 $self->{'scratch'} .= $text;
226 # escape special characters in HTML (<, >, &, etc)
227 $_[0]{'scratch'} .= $_[0]{'in_verbatim'} ? encode_entities( $_[1] ) : $_[1]
230 sub start_Para { $_[0]{'scratch'} = '<p>' }
231 sub start_Verbatim { $_[0]{'scratch'} = '<pre><code>'; $_[0]{'in_verbatim'} = 1}
233 sub start_head1 { $_[0]{'scratch'} = '<h1>' }
234 sub start_head2 { $_[0]{'scratch'} = '<h2>' }
235 sub start_head3 { $_[0]{'scratch'} = '<h3>' }
236 sub start_head4 { $_[0]{'scratch'} = '<h4>' }
238 sub start_item_bullet { $_[0]{'scratch'} = '<li>' }
239 sub start_item_number { $_[0]{'scratch'} = "<li>$_[1]{'number'}. " }
240 sub start_item_text { $_[0]{'scratch'} = '<li>' }
242 sub start_over_bullet { $_[0]{'scratch'} = '<ul>'; $_[0]->emit }
243 sub start_over_text { $_[0]{'scratch'} = '<ul>'; $_[0]->emit }
244 sub start_over_block { $_[0]{'scratch'} = '<ul>'; $_[0]->emit }
245 sub start_over_number { $_[0]{'scratch'} = '<ol>'; $_[0]->emit }
247 sub end_over_bullet { $_[0]{'scratch'} .= '</ul>'; $_[0]->emit }
248 sub end_over_text { $_[0]{'scratch'} .= '</ul>'; $_[0]->emit }
249 sub end_over_block { $_[0]{'scratch'} .= '</ul>'; $_[0]->emit }
250 sub end_over_number { $_[0]{'scratch'} .= '</ol>'; $_[0]->emit }
252 # . . . . . Now the actual formatters:
254 sub end_Para { $_[0]{'scratch'} .= '</p>'; $_[0]->emit }
256 $_[0]{'scratch'} .= '</code></pre>';
257 $_[0]{'in_verbatim'} = 0;
261 sub end_head1 { $_[0]{'scratch'} .= '</h1>'; $_[0]->emit }
262 sub end_head2 { $_[0]{'scratch'} .= '</h2>'; $_[0]->emit }
263 sub end_head3 { $_[0]{'scratch'} .= '</h3>'; $_[0]->emit }
264 sub end_head4 { $_[0]{'scratch'} .= '</h4>'; $_[0]->emit }
266 sub end_item_bullet { $_[0]{'scratch'} .= '</li>'; $_[0]->emit }
267 sub end_item_number { $_[0]{'scratch'} .= '</li>'; $_[0]->emit }
268 sub end_item_text { $_[0]->emit }
270 # This handles =begin and =for blocks of all kinds.
272 my ($self, $flags) = @_;
273 $self->{'scratch'} .= '<div';
274 $self->{'scratch'} .= ' class="'.$flags->{'target'}.'"' if ($flags->{'target'});
275 $self->{'scratch'} .= '>';
281 $self->{'scratch'} .= '</div>';
287 if (defined $self->html_header) {
288 $self->{'scratch'} .= $self->html_header;
289 $self->emit unless $self->html_header eq "";
291 my ($doctype, $title, $metatags);
292 $doctype = $self->html_doctype || '';
293 $title = $self->force_title || $self->title || $self->default_title || '';
294 $metatags = $self->html_header_tags || '';
295 if ($self->html_css) {
296 $metatags .= "\n<link rel='stylesheet' href='" .
297 $self->html_css . "' type='text/css'>";
299 if ($self->html_javascript) {
300 $metatags .= "\n<script type='text/javascript' src='" .
301 $self->html_javascript . "'></script>";
303 $self->{'scratch'} .= <<"HTML";
307 <title>$title</title>
318 if (defined $self->html_footer) {
319 $self->{'scratch'} .= $self->html_footer;
320 $self->emit unless $self->html_footer eq "";
322 $self->{'scratch'} .= "</body>\n</html>";
328 sub start_B { $_[0]{'scratch'} .= '<b>' }
329 sub end_B { $_[0]{'scratch'} .= '</b>' }
331 sub start_C { $_[0]{'scratch'} .= '<code>'; $_[0]{'in_verbatim'} = 1; }
332 sub end_C { $_[0]{'scratch'} .= '</code>'; $_[0]{'in_verbatim'} = 0; }
334 sub start_E { $_[0]{'scratch'} .= '&' }
335 sub end_E { $_[0]{'scratch'} .= ';' }
337 sub start_F { $_[0]{'scratch'} .= '<i>' }
338 sub end_F { $_[0]{'scratch'} .= '</i>' }
340 sub start_I { $_[0]{'scratch'} .= '<i>' }
341 sub end_I { $_[0]{'scratch'} .= '</i>' }
344 my ($self, $flags) = @_;
346 if ($flags->{'type'} eq 'url') {
347 $url = $flags->{'to'};
348 } elsif ($flags->{'type'} eq 'pod') {
349 $url .= $self->perldoc_url_prefix || '';
350 $url .= $flags->{'to'} || '';
351 $url .= '/' . $flags->{'section'} if ($flags->{'section'});
352 $url .= $self->perldoc_url_postfix || '';
353 # require Data::Dumper;
354 # print STDERR Data::Dumper->Dump([$flags]);
357 $self->{'scratch'} .= '<a href="'. $url . '">';
359 sub end_L { $_[0]{'scratch'} .= '</a>' }
361 sub start_S { $_[0]{'scratch'} .= '<nobr>' }
362 sub end_S { $_[0]{'scratch'} .= '</nobr>' }
366 my $out = $self->{'scratch'} . "\n";
367 print {$self->{'output_fh'}} $out, "\n";
368 $self->{'scratch'} = '';
372 # Bypass built-in E<> handling to preserve entity encoding
381 L<Pod::Simple>, L<Pod::Simple::Methody>
385 Copyright (c) 2003-2005 Allison Randal.
387 This library is free software; you can redistribute it and/or modify
388 it under the same terms as Perl itself. The full text of the license
389 can be found in the LICENSE file included with this module.
391 This library is distributed in the hope that it will be useful, but
392 without any warranty; without even the implied warranty of
393 merchantability or fitness for a particular purpose.
397 Allison Randal <allison@perl.org>