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; |
8737ae4d |
30 | use vars qw( $VERSION @ISA $HAS_HTML_ENTITIES ); |
433cf6b4 |
31 | $VERSION = '3.13'; |
69473a20 |
32 | use Carp (); |
33 | use Pod::Simple::Methody (); |
34 | @ISA = ('Pod::Simple::Methody'); |
35 | |
8737ae4d |
36 | BEGIN { |
37 | $HAS_HTML_ENTITIES = eval "require HTML::Entities; 1"; |
38 | } |
39 | |
40 | my %entities = ( |
41 | q{>} => 'gt', |
42 | q{<} => 'lt', |
43 | q{'} => '#39', |
44 | q{"} => 'quot', |
45 | q{&} => 'amp', |
46 | ); |
47 | |
48 | sub encode_entities { |
49 | return HTML::Entities::encode_entities( $_[0] ) if $HAS_HTML_ENTITIES; |
50 | my $str = $_[0]; |
51 | my $ents = join '', keys %entities; |
52 | $str =~ s/([$ents])/'&' . $entities{$1} . ';'/ge; |
53 | return $str; |
54 | } |
69473a20 |
55 | |
56 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
57 | |
58 | =head1 METHODS |
59 | |
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>: |
63 | |
64 | my $parser = Pod::PseudoPod::HTML->new(); |
65 | $parser->set_optional_param("value"); |
66 | $parser->parse_file($file); |
67 | |
68 | =head2 perldoc_url_prefix |
69 | |
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?". |
73 | |
74 | =head2 perldoc_url_postfix |
75 | |
76 | What to put after "Foo%3a%3aBar" in the URL. This option is not set by |
77 | default. |
78 | |
a242eeb4 |
79 | =head2 man_url_prefix |
80 | |
81 | In turning C<< L<crontab(5)> >> into http://whatever/man/1/crontab, what |
82 | to put before the "1/crontab". The default value is |
83 | "http://man.he.net/man". |
84 | |
85 | =head2 man_url_postfix |
86 | |
87 | What to put after "1/crontab" in the URL. This option is not set by default. |
88 | |
69473a20 |
89 | =head2 title_prefix, title_postfix |
90 | |
91 | What to put before and after the title in the head. The values should |
92 | already be &-escaped. |
93 | |
94 | =head2 html_css |
95 | |
96 | $parser->html_css('path/to/style.css'); |
97 | |
98 | The URL or relative path of a CSS file to include. This option is not |
99 | set by default. |
100 | |
101 | =head2 html_javascript |
102 | |
103 | The URL or relative path of a JavaScript file to pull in. This option is |
104 | not set by default. |
105 | |
106 | =head2 html_doctype |
107 | |
108 | A document type tag for the file. This option is not set by default. |
109 | |
110 | =head2 html_header_tags |
111 | |
112 | Additional arbitrary HTML tags for the header of the document. The |
113 | default value is just a content type header tag: |
114 | |
115 | <meta http-equiv="Content-Type" content="text/html; charset=ISO-8859-1"> |
116 | |
117 | Add additional meta tags here, or blocks of inline CSS or JavaScript |
118 | (wrapped in the appropriate tags). |
119 | |
433cf6b4 |
120 | =head2 html_h_level |
121 | |
122 | This is the level of HTML "Hn" element to which a Pod "head1" corresponds. For |
123 | example, if C<html_h_level> is set to 2, a head1 will produce an H2, a head2 |
124 | will produce an H3, and so on. |
125 | |
69473a20 |
126 | =head2 default_title |
127 | |
128 | Set a default title for the page if no title can be determined from the |
129 | content. The value of this string should already be &-escaped. |
130 | |
131 | =head2 force_title |
132 | |
133 | Force a title for the page (don't try to determine it from the content). |
134 | The value of this string should already be &-escaped. |
135 | |
136 | =head2 html_header, html_footer |
137 | |
138 | Set the HTML output at the beginning and end of each file. The default |
139 | header includes a title, a doctype tag (if C<html_doctype> is set), a |
140 | content tag (customized by C<html_header_tags>), a tag for a CSS file |
141 | (if C<html_css> is set), and a tag for a Javascript file (if |
142 | C<html_javascript> is set). The default footer simply closes the C<html> |
143 | and C<body> tags. |
144 | |
145 | The options listed above customize parts of the default header, but |
146 | setting C<html_header> or C<html_footer> completely overrides the |
147 | built-in header or footer. These may be useful if you want to use |
148 | template tags instead of literal HTML headers and footers or are |
149 | integrating converted POD pages in a larger website. |
150 | |
151 | If you want no headers or footers output in the HTML, set these options |
152 | to the empty string. |
153 | |
154 | =head2 index |
155 | |
69473a20 |
156 | Whether to add a table-of-contents at the top of each page (called an |
157 | index for the sake of tradition). |
158 | |
159 | |
160 | =cut |
161 | |
162 | __PACKAGE__->_accessorize( |
163 | 'perldoc_url_prefix', |
164 | 'perldoc_url_postfix', |
a242eeb4 |
165 | 'man_url_prefix', |
166 | 'man_url_postfix', |
69473a20 |
167 | 'title_prefix', 'title_postfix', |
168 | 'html_css', |
169 | 'html_javascript', |
170 | 'html_doctype', |
171 | 'html_header_tags', |
433cf6b4 |
172 | 'html_h_level', |
69473a20 |
173 | 'title', # Used internally for the title extracted from the content |
174 | 'default_title', |
175 | 'force_title', |
176 | 'html_header', |
177 | 'html_footer', |
178 | 'index', |
179 | 'batch_mode', # whether we're in batch mode |
180 | 'batch_mode_current_level', |
181 | # When in batch mode, how deep the current module is: 1 for "LWP", |
182 | # 2 for "LWP::Procotol", 3 for "LWP::Protocol::GHTTP", etc |
183 | ); |
184 | |
185 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
186 | |
187 | =head1 SUBCLASSING |
188 | |
189 | If the standard options aren't enough, you may want to subclass |
190 | Pod::Simple::XHMTL. These are the most likely candidates for methods |
191 | you'll want to override when subclassing. |
192 | |
193 | =cut |
194 | |
195 | sub new { |
196 | my $self = shift; |
197 | my $new = $self->SUPER::new(@_); |
198 | $new->{'output_fh'} ||= *STDOUT{IO}; |
69473a20 |
199 | $new->perldoc_url_prefix('http://search.cpan.org/perldoc?'); |
a242eeb4 |
200 | $new->man_url_prefix('http://man.he.net/man'); |
9d65762f |
201 | $new->html_header_tags('<meta http-equiv="Content-Type" content="text/html; charset=ISO-8859-1" />'); |
69473a20 |
202 | $new->nix_X_codes(1); |
203 | $new->codes_in_verbatim(1); |
204 | $new->{'scratch'} = ''; |
9d65762f |
205 | $new->{'to_index'} = []; |
206 | $new->{'output'} = []; |
207 | $new->{'saved'} = []; |
208 | $new->{'ids'} = {}; |
433cf6b4 |
209 | |
210 | $new->{'__region_targets'} = []; |
211 | $new->{'__literal_targets'} = {}; |
212 | $new->accept_targets_as_html( 'html', 'HTML' ); |
213 | |
69473a20 |
214 | return $new; |
215 | } |
216 | |
217 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
218 | |
219 | =head2 handle_text |
220 | |
221 | This method handles the body of text within any element: it's the body |
222 | of a paragraph, or everything between a "=begin" tag and the |
223 | corresponding "=end" tag, or the text within an L entity, etc. You would |
224 | want to override this if you are adding a custom element type that does |
225 | more than just display formatted text. Perhaps adding a way to generate |
226 | HTML tables from an extended version of POD. |
227 | |
228 | So, let's say you want add a custom element called 'foo'. In your |
229 | subclass's C<new> method, after calling C<SUPER::new> you'd call: |
230 | |
231 | $new->accept_targets_as_text( 'foo' ); |
232 | |
233 | Then override the C<start_for> method in the subclass to check for when |
234 | "$flags->{'target'}" is equal to 'foo' and set a flag that marks that |
235 | you're in a foo block (maybe "$self->{'in_foo'} = 1"). Then override the |
236 | C<handle_text> method to check for the flag, and pass $text to your |
237 | custom subroutine to construct the HTML output for 'foo' elements, |
238 | something like: |
239 | |
240 | sub handle_text { |
241 | my ($self, $text) = @_; |
242 | if ($self->{'in_foo'}) { |
9d65762f |
243 | $self->{'scratch'} .= build_foo_html($text); |
69473a20 |
244 | } else { |
245 | $self->{'scratch'} .= $text; |
246 | } |
247 | } |
248 | |
433cf6b4 |
249 | =head2 accept_targets_as_html |
250 | |
251 | This method behaves like C<accept_targets_as_text>, but also marks the region |
252 | as one whose content should be emitted literally, without HTML entity escaping |
253 | or wrapping in a C<div> element. |
254 | |
69473a20 |
255 | =cut |
256 | |
433cf6b4 |
257 | sub __in_literal_xhtml_region { |
258 | return unless @{ $_[0]{__region_targets} }; |
259 | my $target = $_[0]{__region_targets}[-1]; |
260 | return $_[0]{__literal_targets}{ $target }; |
261 | } |
262 | |
263 | sub accept_targets_as_html { |
264 | my ($self, @targets) = @_; |
265 | $self->accept_targets(@targets); |
266 | $self->{__literal_targets}{$_} = 1 for @targets; |
267 | } |
268 | |
69473a20 |
269 | sub handle_text { |
270 | # escape special characters in HTML (<, >, &, etc) |
433cf6b4 |
271 | $_[0]{'scratch'} .= $_[0]->__in_literal_xhtml_region |
272 | ? $_[1] |
273 | : encode_entities( $_[1] ); |
69473a20 |
274 | } |
275 | |
276 | sub start_Para { $_[0]{'scratch'} = '<p>' } |
9d65762f |
277 | sub start_Verbatim { $_[0]{'scratch'} = '<pre><code>' } |
278 | |
279 | sub start_head1 { $_[0]{'in_head'} = 1 } |
280 | sub start_head2 { $_[0]{'in_head'} = 2 } |
281 | sub start_head3 { $_[0]{'in_head'} = 3 } |
282 | sub start_head4 { $_[0]{'in_head'} = 4 } |
69473a20 |
283 | |
9d65762f |
284 | sub start_item_number { |
285 | $_[0]{'scratch'} = "</li>\n" if $_[0]{'in_li'}; |
286 | $_[0]{'scratch'} .= '<li><p>'; |
287 | $_[0]{'in_li'} = 1 |
288 | } |
69473a20 |
289 | |
9d65762f |
290 | sub start_item_bullet { |
291 | $_[0]{'scratch'} = "</li>\n" if $_[0]{'in_li'}; |
292 | $_[0]{'scratch'} .= '<li><p>'; |
293 | $_[0]{'in_li'} = 1 |
294 | } |
295 | |
296 | sub start_item_text { |
4b6b311b |
297 | if ($_[0]{'in_dd'}[ $_[0]{'dl_level'} ]) { |
298 | $_[0]{'scratch'} = "</dd>\n"; |
299 | $_[0]{'in_dd'}[ $_[0]{'dl_level'} ] = 0; |
300 | } |
9d65762f |
301 | $_[0]{'scratch'} .= '<dt>'; |
302 | } |
69473a20 |
303 | |
304 | sub start_over_bullet { $_[0]{'scratch'} = '<ul>'; $_[0]->emit } |
69473a20 |
305 | sub start_over_block { $_[0]{'scratch'} = '<ul>'; $_[0]->emit } |
306 | sub start_over_number { $_[0]{'scratch'} = '<ol>'; $_[0]->emit } |
4b6b311b |
307 | sub start_over_text { |
308 | $_[0]{'scratch'} = '<dl>'; |
309 | $_[0]{'dl_level'}++; |
310 | $_[0]{'in_dd'} ||= []; |
311 | $_[0]->emit |
312 | } |
69473a20 |
313 | |
69473a20 |
314 | sub end_over_block { $_[0]{'scratch'} .= '</ul>'; $_[0]->emit } |
9d65762f |
315 | |
316 | sub end_over_number { |
317 | $_[0]{'scratch'} = "</li>\n" if delete $_[0]{'in_li'}; |
318 | $_[0]{'scratch'} .= '</ol>'; |
319 | $_[0]->emit; |
320 | } |
321 | |
322 | sub end_over_bullet { |
323 | $_[0]{'scratch'} = "</li>\n" if delete $_[0]{'in_li'}; |
324 | $_[0]{'scratch'} .= '</ul>'; |
325 | $_[0]->emit; |
326 | } |
327 | |
328 | sub end_over_text { |
4b6b311b |
329 | if ($_[0]{'in_dd'}[ $_[0]{'dl_level'} ]) { |
330 | $_[0]{'scratch'} = "</dd>\n"; |
331 | $_[0]{'in_dd'}[ $_[0]{'dl_level'} ] = 0; |
332 | } |
9d65762f |
333 | $_[0]{'scratch'} .= '</dl>'; |
4b6b311b |
334 | $_[0]{'dl_level'}--; |
9d65762f |
335 | $_[0]->emit; |
336 | } |
69473a20 |
337 | |
338 | # . . . . . Now the actual formatters: |
339 | |
340 | sub end_Para { $_[0]{'scratch'} .= '</p>'; $_[0]->emit } |
341 | sub end_Verbatim { |
342 | $_[0]{'scratch'} .= '</code></pre>'; |
69473a20 |
343 | $_[0]->emit; |
344 | } |
345 | |
9d65762f |
346 | sub _end_head { |
347 | my $h = delete $_[0]{in_head}; |
433cf6b4 |
348 | |
349 | my $add = $_[0]->html_h_level; |
350 | $add = 1 unless defined $add; |
351 | $h += $add - 1; |
352 | |
9d65762f |
353 | my $id = $_[0]->idify($_[0]{scratch}); |
354 | my $text = $_[0]{scratch}; |
355 | $_[0]{'scratch'} = qq{<h$h id="$id">$text</h$h>}; |
356 | $_[0]->emit; |
357 | push @{ $_[0]{'to_index'} }, [$h, $id, $text]; |
358 | } |
359 | |
360 | sub end_head1 { shift->_end_head(@_); } |
361 | sub end_head2 { shift->_end_head(@_); } |
362 | sub end_head3 { shift->_end_head(@_); } |
363 | sub end_head4 { shift->_end_head(@_); } |
69473a20 |
364 | |
9d65762f |
365 | sub end_item_bullet { $_[0]{'scratch'} .= '</p>'; $_[0]->emit } |
366 | sub end_item_number { $_[0]{'scratch'} .= '</p>'; $_[0]->emit } |
4b6b311b |
367 | |
368 | sub end_item_text { |
369 | $_[0]{'scratch'} .= "</dt>\n<dd>"; |
370 | $_[0]{'in_dd'}[ $_[0]{'dl_level'} ] = 1; |
371 | $_[0]->emit; |
372 | } |
69473a20 |
373 | |
374 | # This handles =begin and =for blocks of all kinds. |
375 | sub start_for { |
376 | my ($self, $flags) = @_; |
433cf6b4 |
377 | |
378 | push @{ $self->{__region_targets} }, $flags->{target_matching}; |
379 | |
380 | unless ($self->__in_literal_xhtml_region) { |
381 | $self->{scratch} .= '<div'; |
382 | $self->{scratch} .= qq( class="$flags->{target}") if $flags->{target}; |
383 | $self->{scratch} .= '>'; |
384 | } |
385 | |
69473a20 |
386 | $self->emit; |
387 | |
388 | } |
389 | sub end_for { |
390 | my ($self) = @_; |
433cf6b4 |
391 | |
392 | $self->{'scratch'} .= '</div>' unless $self->__in_literal_xhtml_region; |
393 | |
394 | pop @{ $self->{__region_targets} }; |
69473a20 |
395 | $self->emit; |
396 | } |
397 | |
398 | sub start_Document { |
399 | my ($self) = @_; |
400 | if (defined $self->html_header) { |
401 | $self->{'scratch'} .= $self->html_header; |
402 | $self->emit unless $self->html_header eq ""; |
403 | } else { |
404 | my ($doctype, $title, $metatags); |
405 | $doctype = $self->html_doctype || ''; |
406 | $title = $self->force_title || $self->title || $self->default_title || ''; |
407 | $metatags = $self->html_header_tags || ''; |
408 | if ($self->html_css) { |
409 | $metatags .= "\n<link rel='stylesheet' href='" . |
410 | $self->html_css . "' type='text/css'>"; |
411 | } |
412 | if ($self->html_javascript) { |
413 | $metatags .= "\n<script type='text/javascript' src='" . |
414 | $self->html_javascript . "'></script>"; |
415 | } |
416 | $self->{'scratch'} .= <<"HTML"; |
417 | $doctype |
418 | <html> |
419 | <head> |
420 | <title>$title</title> |
421 | $metatags |
422 | </head> |
423 | <body> |
424 | HTML |
425 | $self->emit; |
426 | } |
427 | } |
428 | |
9d65762f |
429 | sub end_Document { |
69473a20 |
430 | my ($self) = @_; |
9d65762f |
431 | my $to_index = $self->{'to_index'}; |
432 | if ($self->index && @{ $to_index } ) { |
433 | my @out; |
434 | my $level = 0; |
435 | my $indent = -1; |
436 | my $space = ''; |
437 | my $id = ' id="index"'; |
438 | |
439 | for my $h (@{ $to_index }, [0]) { |
440 | my $target_level = $h->[0]; |
441 | # Get to target_level by opening or closing ULs |
442 | if ($level == $target_level) { |
443 | $out[-1] .= '</li>'; |
444 | } elsif ($level > $target_level) { |
445 | $out[-1] .= '</li>' if $out[-1] =~ /^\s+<li>/; |
446 | while ($level > $target_level) { |
447 | --$level; |
448 | push @out, (' ' x --$indent) . '</li>' if @out && $out[-1] =~ m{^\s+<\/ul}; |
449 | push @out, (' ' x --$indent) . '</ul>'; |
450 | } |
451 | push @out, (' ' x --$indent) . '</li>' if $level; |
452 | } else { |
453 | while ($level < $target_level) { |
454 | ++$level; |
455 | push @out, (' ' x ++$indent) . '<li>' if @out && $out[-1]=~ /^\s*<ul/; |
456 | push @out, (' ' x ++$indent) . "<ul$id>"; |
457 | $id = ''; |
458 | } |
459 | ++$indent; |
460 | } |
461 | |
462 | next unless $level; |
463 | $space = ' ' x $indent; |
464 | push @out, sprintf '%s<li><a href="#%s">%s</a>', |
465 | $space, $h->[1], $h->[2]; |
466 | } |
467 | # Splice the index in between the HTML headers and the first element. |
468 | my $offset = defined $self->html_header ? $self->html_header eq '' ? 0 : 1 : 1; |
469 | splice @{ $self->{'output'} }, $offset, 0, join "\n", @out; |
470 | } |
471 | |
69473a20 |
472 | if (defined $self->html_footer) { |
473 | $self->{'scratch'} .= $self->html_footer; |
474 | $self->emit unless $self->html_footer eq ""; |
475 | } else { |
476 | $self->{'scratch'} .= "</body>\n</html>"; |
477 | $self->emit; |
478 | } |
9d65762f |
479 | |
480 | if ($self->index) { |
481 | print {$self->{'output_fh'}} join ("\n\n", @{ $self->{'output'} }), "\n\n"; |
482 | @{$self->{'output'}} = (); |
483 | } |
484 | |
69473a20 |
485 | } |
486 | |
487 | # Handling code tags |
488 | sub start_B { $_[0]{'scratch'} .= '<b>' } |
489 | sub end_B { $_[0]{'scratch'} .= '</b>' } |
490 | |
9d65762f |
491 | sub start_C { $_[0]{'scratch'} .= '<code>' } |
492 | sub end_C { $_[0]{'scratch'} .= '</code>' } |
69473a20 |
493 | |
69473a20 |
494 | sub start_F { $_[0]{'scratch'} .= '<i>' } |
495 | sub end_F { $_[0]{'scratch'} .= '</i>' } |
496 | |
497 | sub start_I { $_[0]{'scratch'} .= '<i>' } |
498 | sub end_I { $_[0]{'scratch'} .= '</i>' } |
499 | |
a242eeb4 |
500 | sub start_L { |
69473a20 |
501 | my ($self, $flags) = @_; |
a242eeb4 |
502 | my ($type, $to, $section) = @{$flags}{'type', 'to', 'section'}; |
503 | my $url = $type eq 'url' ? $to |
504 | : $type eq 'pod' ? $self->resolve_pod_page_link($to, $section) |
505 | : $type eq 'man' ? $self->resolve_man_page_link($to, $section) |
506 | : undef; |
507 | |
508 | # If it's an unknown type, use an attribute-less <a> like HTML.pm. |
509 | $self->{'scratch'} .= '<a' . ($url ? ' href="'. $url . '">' : '>'); |
69473a20 |
510 | } |
a242eeb4 |
511 | |
69473a20 |
512 | sub end_L { $_[0]{'scratch'} .= '</a>' } |
513 | |
514 | sub start_S { $_[0]{'scratch'} .= '<nobr>' } |
515 | sub end_S { $_[0]{'scratch'} .= '</nobr>' } |
516 | |
517 | sub emit { |
518 | my($self) = @_; |
9d65762f |
519 | if ($self->index) { |
520 | push @{ $self->{'output'} }, $self->{'scratch'}; |
521 | } else { |
522 | print {$self->{'output_fh'}} $self->{'scratch'}, "\n\n"; |
523 | } |
69473a20 |
524 | $self->{'scratch'} = ''; |
525 | return; |
526 | } |
527 | |
a242eeb4 |
528 | =head2 resolve_pod_page_link |
529 | |
530 | my $url = $pod->resolve_pod_page_link('Net::Ping', 'INSTALL'); |
531 | my $url = $pod->resolve_pod_page_link('perlpodspec'); |
532 | my $url = $pod->resolve_pod_page_link(undef, 'SYNOPSIS'); |
533 | |
534 | Resolves a POD link target (typically a module or POD file name) and section |
535 | name to a URL. The resulting link will be returned for the above examples as: |
536 | |
537 | http://search.cpan.org/perldoc?Net::Ping#INSTALL |
538 | http://search.cpan.org/perldoc?perlpodspec |
539 | #SYNOPSIS |
540 | |
541 | Note that when there is only a section argument the URL will simply be a link |
542 | to a section in the current document. |
543 | |
544 | =cut |
545 | |
546 | sub resolve_pod_page_link { |
547 | my ($self, $to, $section) = @_; |
548 | return undef unless defined $to || defined $section; |
549 | if (defined $section) { |
550 | $section = '#' . $self->idify($section, 1); |
551 | return $section unless defined $to; |
552 | } else { |
553 | $section = '' |
554 | } |
555 | |
556 | return ($self->perldoc_url_prefix || '') |
557 | . encode_entities($to) . $section |
558 | . ($self->perldoc_url_postfix || ''); |
559 | } |
560 | |
561 | =head2 resolve_man_page_link |
562 | |
563 | my $url = $pod->resolve_man_page_link('crontab(5)', 'EXAMPLE CRON FILE'); |
564 | my $url = $pod->resolve_man_page_link('crontab'); |
565 | |
566 | Resolves a man page link target and numeric section to a URL. The resulting |
567 | link will be returned for the above examples as: |
568 | |
569 | http://man.he.net/man5/crontab |
570 | http://man.he.net/man1/crontab |
571 | |
572 | Note that the first argument is required. The section number will be parsed |
573 | from it, and if it's missing will default to 1. The second argument is |
574 | currently ignored, as L<man.he.net|http://man.he.net> does not currently |
575 | include linkable IDs or anchor names in its pages. Subclass to link to a |
576 | different man page HTTP server. |
577 | |
578 | =cut |
579 | |
580 | sub resolve_man_page_link { |
581 | my ($self, $to, $section) = @_; |
582 | return undef unless defined $to; |
583 | my ($page, $part) = $to =~ /^([^(]+)(?:[(](\d+)[)])?$/; |
584 | return undef unless $page; |
585 | return ($self->man_url_prefix || '') |
586 | . ($part || 1) . "/" . encode_entities($page) |
587 | . ($self->man_url_postfix || ''); |
588 | |
589 | } |
590 | |
9d65762f |
591 | =head2 idify |
592 | |
593 | my $id = $pod->idify($text); |
594 | my $hash = $pod->idify($text, 1); |
595 | |
596 | This method turns an arbitrary string into a valid XHTML ID attribute value. |
597 | The rules enforced, following |
598 | L<http://webdesign.about.com/od/htmltags/a/aa031707.htm>, are: |
599 | |
600 | =over |
601 | |
602 | =item * |
603 | |
604 | The id must start with a letter (a-z or A-Z) |
605 | |
606 | =item * |
607 | |
608 | All subsequent characters can be letters, numbers (0-9), hyphens (-), |
609 | underscores (_), colons (:), and periods (.). |
610 | |
611 | =item * |
612 | |
613 | Each id must be unique within the document. |
614 | |
615 | =back |
616 | |
617 | In addition, the returned value will be unique within the context of the |
618 | Pod::Simple::XHTML object unless a second argument is passed a true value. ID |
619 | attributes should always be unique within a single XHTML document, but pass |
620 | the true value if you are creating not an ID but a URL hash to point to |
621 | an ID (i.e., if you need to put the "#foo" in C<< <a href="#foo">foo</a> >>. |
622 | |
623 | =cut |
624 | |
625 | sub idify { |
626 | my ($self, $t, $not_unique) = @_; |
627 | for ($t) { |
628 | s/<[^>]+>//g; # Strip HTML. |
629 | s/&[^;]+;//g; # Strip entities. |
630 | s/^([^a-zA-Z]+)$/pod$1/; # Prepend "pod" if no valid chars. |
631 | s/^[^a-zA-Z]+//; # First char must be a letter. |
632 | s/[^-a-zA-Z0-9_:.]+/-/g; # All other chars must be valid. |
633 | } |
634 | return $t if $not_unique; |
635 | my $i = ''; |
636 | $i++ while $self->{ids}{"$t$i"}++; |
637 | return "$t$i"; |
638 | } |
639 | |
433cf6b4 |
640 | =head2 batch_mode_page_object_init |
69473a20 |
641 | |
433cf6b4 |
642 | $pod->batch_mode_page_object_init($batchconvobj, $module, $infile, $outfile, $depth); |
69473a20 |
643 | |
433cf6b4 |
644 | Called by L<Pod::Simple::HTMLBatch> so that the class has a chance to |
645 | initialize the converter. Internally it sets the C<batch_mode> property to |
646 | true and sets C<batch_mode_current_level()>, but Pod::Simple::XHTML does not |
647 | currently use those features. Subclasses might, though. |
648 | |
649 | =cut |
69473a20 |
650 | |
433cf6b4 |
651 | sub batch_mode_page_object_init { |
652 | my ($self, $batchconvobj, $module, $infile, $outfile, $depth) = @_; |
653 | $self->batch_mode(1); |
654 | $self->batch_mode_current_level($depth); |
655 | return $self; |
656 | } |
657 | |
658 | 1; |
659 | |
660 | __END__ |
69473a20 |
661 | |
a242eeb4 |
662 | =head1 SEE ALSO |
663 | |
664 | L<Pod::Simple>, L<Pod::Simple::Text>, L<Pod::Spell> |
665 | |
666 | =head1 SUPPORT |
667 | |
668 | Questions or discussion about POD and Pod::Simple should be sent to the |
669 | pod-people@perl.org mail list. Send an empty email to |
670 | pod-people-subscribe@perl.org to subscribe. |
671 | |
672 | This module is managed in an open GitHub repository, |
673 | L<http://github.com/theory/pod-simple/>. Feel free to fork and contribute, or |
674 | to clone L<git://github.com/theory/pod-simple.git> and send patches! |
675 | |
676 | Patches against Pod::Simple are welcome. Please send bug reports to |
677 | <bug-pod-simple@rt.cpan.org>. |
678 | |
679 | =head1 COPYRIGHT AND DISCLAIMERS |
69473a20 |
680 | |
681 | Copyright (c) 2003-2005 Allison Randal. |
682 | |
a242eeb4 |
683 | This library is free software; you can redistribute it and/or modify it |
684 | under the same terms as Perl itself. |
69473a20 |
685 | |
a242eeb4 |
686 | This program is distributed in the hope that it will be useful, but |
69473a20 |
687 | without any warranty; without even the implied warranty of |
688 | merchantability or fitness for a particular purpose. |
689 | |
433cf6b4 |
690 | =head1 ACKNOWLEDGEMENTS |
691 | |
692 | Thanks to L<Hurricane Electrict|http://he.net/> for permission to use its |
693 | L<Linux man pages online|http://man.he.net/> site for man page links. |
694 | |
695 | Thanks to L<search.cpan.org|http://search.cpan.org/> for permission to use the |
696 | site for Perl module links. |
697 | |
69473a20 |
698 | =head1 AUTHOR |
699 | |
a242eeb4 |
700 | Pod::Simpele::XHTML was created by Allison Randal <allison@perl.org>. |
69473a20 |
701 | |
a242eeb4 |
702 | Pod::Simple was created by Sean M. Burke <sburke@cpan.org>. |
703 | But don't bother him, he's retired. |
704 | |
705 | Pod::Simple is maintained by: |
706 | |
707 | =over |
708 | |
709 | =item * Allison Randal C<allison@perl.org> |
710 | |
711 | =item * Hans Dieter Pearcey C<hdp@cpan.org> |
712 | |
713 | =item * David E. Wheeler C<dwheeler@cpan.org> |
69473a20 |
714 | |
a242eeb4 |
715 | =back |
716 | |
717 | =cut |