blib/lib/Pod/Simple/XHTML.pm | |||
---|---|---|---|
Criterion | Covered | Total | % |
statement | 308 | 317 | 97.1 |
branch | 97 | 118 | 82.2 |
condition | 34 | 50 | 68.0 |
subroutine | 65 | 68 | 95.5 |
pod | 9 | 63 | 14.2 |
total | 513 | 616 | 83.2 |
line | stmt | bran | cond | sub | pod | time | code | |||||||
---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
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 |
|||||||||||||
23 | methods. The implementation is entirely different than | |||||||||||||
24 | L |
|||||||||||||
25 | ||||||||||||||
26 | =head2 Minimal code | |||||||||||||
27 | ||||||||||||||
28 | use Pod::Simple::XHTML; | |||||||||||||
29 | my $psx = Pod::Simple::XHTML->new; | |||||||||||||
30 | $psx->output_string(\my $html); | |||||||||||||
31 | $psx->parse_file('path/to/Module/Name.pm'); | |||||||||||||
32 | open my $out, '>', 'out.html' or die "Cannot open 'out.html': $!\n"; | |||||||||||||
33 | print $out $html; | |||||||||||||
34 | ||||||||||||||
35 | You can also control the character encoding and entities. For example, if | |||||||||||||
36 | you're sure that the POD is properly encoded (using the C<=encoding> command), | |||||||||||||
37 | you can prevent high-bit characters from being encoded as HTML entities and | |||||||||||||
38 | declare the output character set as UTF-8 before parsing, like so: | |||||||||||||
39 | ||||||||||||||
40 | $psx->html_charset('UTF-8'); | |||||||||||||
41 | use warnings; | |||||||||||||
42 | $psx->html_encode_chars(q{&<>'"}); | |||||||||||||
43 | ||||||||||||||
44 | =cut | |||||||||||||
45 | ||||||||||||||
46 | package Pod::Simple::XHTML; | |||||||||||||
47 | 11 | 11 | 147481 | use strict; | ||||||||||
11 | 36 | |||||||||||||
11 | 485 | |||||||||||||
48 | our $VERSION = '3.45'; | |||||||||||||
49 | 11 | 11 | 4534 | use Pod::Simple::Methody (); | ||||||||||
11 | 39 | |||||||||||||
11 | 747 | |||||||||||||
50 | our @ISA = ('Pod::Simple::Methody'); | |||||||||||||
51 | ||||||||||||||
52 | our $HAS_HTML_ENTITIES; | |||||||||||||
53 | BEGIN { | |||||||||||||
54 | 11 | 11 | 660 | $HAS_HTML_ENTITIES = eval "require HTML::Entities; 1"; | ||||||||||
55 | } | |||||||||||||
56 | ||||||||||||||
57 | my %entities = ( | |||||||||||||
58 | q{>} => 'gt', | |||||||||||||
59 | q{<} => 'lt', | |||||||||||||
60 | q{'} => '#39', | |||||||||||||
61 | q{"} => 'quot', | |||||||||||||
62 | q{&} => 'amp', | |||||||||||||
63 | ); | |||||||||||||
64 | ||||||||||||||
65 | sub encode_entities { | |||||||||||||
66 | 509 | 509 | 0 | 751 | my $self = shift; | |||||||||
67 | 509 | 1036 | my $ents = $self->html_encode_chars; | |||||||||||
68 | 509 | 100 | 1584 | return HTML::Entities::encode_entities( $_[0], $ents ) if $HAS_HTML_ENTITIES; | ||||||||||
69 | 9 | 100 | 15 | if (defined $ents) { | ||||||||||
70 | 1 | 3 | $ents =~ s,(? | |||||||||||
71 | 1 | 4 | $ents =~ s,(? | |||||||||||
72 | } else { | |||||||||||||
73 | 8 | 28 | $ents = join '', keys %entities; | |||||||||||
74 | } | |||||||||||||
75 | 9 | 14 | my $str = $_[0]; | |||||||||||
76 | 9 | 66 | 81 | $str =~ s/([$ents])/'&' . ($entities{$1} || sprintf '#x%X', ord $1) . ';'/ge; | ||||||||||
21 | 97 | |||||||||||||
77 | 9 | 37 | return $str; | |||||||||||
78 | } | |||||||||||||
79 | ||||||||||||||
80 | my %entity_to_char = reverse %entities; | |||||||||||||
81 | my ($entity_re) = map qr{$_}, join '|', map quotemeta, sort keys %entity_to_char; | |||||||||||||
82 | ||||||||||||||
83 | sub decode_entities { | |||||||||||||
84 | 5 | 5 | 0 | 11 | my ($self, $string) = @_; | |||||||||
85 | 5 | 50 | 46 | return HTML::Entities::decode_entities( $string ) if $HAS_HTML_ENTITIES; | ||||||||||
86 | ||||||||||||||
87 | 0 | 0 | $string =~ s{&(?:($entity_re)|#x([0123456789abcdefABCDEF]+)|#([0123456789]+));}{ | |||||||||||
88 | 0 | 0 | 0 | defined $1 ? $entity_to_char{$1} | ||||||||||
0 | ||||||||||||||
0 | ||||||||||||||
89 | : defined $2 ? chr(hex($2)) | |||||||||||||
90 | : defined $3 ? chr($3) | |||||||||||||
91 | : die; | |||||||||||||
92 | }ge; | |||||||||||||
93 | ||||||||||||||
94 | 0 | 0 | return $string; | |||||||||||
95 | } | |||||||||||||
96 | ||||||||||||||
97 | sub encode_url { | |||||||||||||
98 | 73 | 73 | 0 | 139 | my ($self, $string) = @_; | |||||||||
99 | ||||||||||||||
100 | 73 | 139 | $string =~ s{([^-_.!~*()abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZZ0123456789])}{ | |||||||||||
101 | 0 | 0 | sprintf('%%%02X', ord($1)) | |||||||||||
102 | }eg; | |||||||||||||
103 | ||||||||||||||
104 | 73 | 166 | return $string; | |||||||||||
105 | } | |||||||||||||
106 | ||||||||||||||
107 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ | |||||||||||||
108 | ||||||||||||||
109 | =head1 METHODS | |||||||||||||
110 | ||||||||||||||
111 | Pod::Simple::XHTML offers a number of methods that modify the format of | |||||||||||||
112 | the HTML output. Call these after creating the parser object, but before | |||||||||||||
113 | the call to C |
|||||||||||||
114 | ||||||||||||||
115 | my $parser = Pod::PseudoPod::HTML->new(); | |||||||||||||
116 | $parser->set_optional_param("value"); | |||||||||||||
117 | $parser->parse_file($file); | |||||||||||||
118 | ||||||||||||||
119 | =head2 perldoc_url_prefix | |||||||||||||
120 | ||||||||||||||
121 | In turning L |
|||||||||||||
122 | to put before the "Foo%3a%3aBar". The default value is | |||||||||||||
123 | "https://metacpan.org/pod/". | |||||||||||||
124 | ||||||||||||||
125 | =head2 perldoc_url_postfix | |||||||||||||
126 | ||||||||||||||
127 | What to put after "Foo%3a%3aBar" in the URL. This option is not set by | |||||||||||||
128 | default. | |||||||||||||
129 | ||||||||||||||
130 | =head2 man_url_prefix | |||||||||||||
131 | ||||||||||||||
132 | In turning C<< L |
|||||||||||||
133 | to put before the "1/crontab". The default value is | |||||||||||||
134 | "http://man.he.net/man". | |||||||||||||
135 | ||||||||||||||
136 | =head2 man_url_postfix | |||||||||||||
137 | ||||||||||||||
138 | What to put after "1/crontab" in the URL. This option is not set by default. | |||||||||||||
139 | ||||||||||||||
140 | =head2 title_prefix, title_postfix | |||||||||||||
141 | ||||||||||||||
142 | What to put before and after the title in the head. The values should | |||||||||||||
143 | already be &-escaped. | |||||||||||||
144 | ||||||||||||||
145 | =head2 html_css | |||||||||||||
146 | ||||||||||||||
147 | $parser->html_css('path/to/style.css'); | |||||||||||||
148 | ||||||||||||||
149 | The URL or relative path of a CSS file to include. This option is not | |||||||||||||
150 | set by default. | |||||||||||||
151 | ||||||||||||||
152 | =head2 html_javascript | |||||||||||||
153 | ||||||||||||||
154 | The URL or relative path of a JavaScript file to pull in. This option is | |||||||||||||
155 | not set by default. | |||||||||||||
156 | ||||||||||||||
157 | =head2 html_doctype | |||||||||||||
158 | ||||||||||||||
159 | A document type tag for the file. This option is not set by default. | |||||||||||||
160 | ||||||||||||||
161 | =head2 html_charset | |||||||||||||
162 | ||||||||||||||
163 | The character set to declare in the Content-Type meta tag created by default | |||||||||||||
164 | for C |
|||||||||||||
165 | C |
|||||||||||||
166 | ||||||||||||||
167 | =head2 html_header_tags | |||||||||||||
168 | ||||||||||||||
169 | Additional arbitrary HTML tags for the header of the document. The | |||||||||||||
170 | default value is just a content type header tag: | |||||||||||||
171 | ||||||||||||||
172 | ||||||||||||||
173 | ||||||||||||||
174 | Add additional meta tags here, or blocks of inline CSS or JavaScript | |||||||||||||
175 | (wrapped in the appropriate tags). | |||||||||||||
176 | ||||||||||||||
177 | =head3 html_encode_chars | |||||||||||||
178 | ||||||||||||||
179 | A string containing all characters that should be encoded as HTML entities, | |||||||||||||
180 | specified using the regular expression character class syntax (what you find | |||||||||||||
181 | within brackets in regular expressions). This value will be passed as the | |||||||||||||
182 | second argument to the C |
|||||||||||||
183 | L |
|||||||||||||
184 | will be encoded numerically. | |||||||||||||
185 | ||||||||||||||
186 | =head2 html_h_level | |||||||||||||
187 | ||||||||||||||
188 | This is the level of HTML "Hn" element to which a Pod "head1" corresponds. For | |||||||||||||
189 | example, if C |
|||||||||||||
190 | will produce an H3, and so on. | |||||||||||||
191 | ||||||||||||||
192 | =head2 default_title | |||||||||||||
193 | ||||||||||||||
194 | Set a default title for the page if no title can be determined from the | |||||||||||||
195 | content. The value of this string should already be &-escaped. | |||||||||||||
196 | ||||||||||||||
197 | =head2 force_title | |||||||||||||
198 | ||||||||||||||
199 | Force a title for the page (don't try to determine it from the content). | |||||||||||||
200 | The value of this string should already be &-escaped. | |||||||||||||
201 | ||||||||||||||
202 | =head2 html_header, html_footer | |||||||||||||
203 | ||||||||||||||
204 | Set the HTML output at the beginning and end of each file. The default | |||||||||||||
205 | header includes a title, a doctype tag (if C |
|||||||||||||
206 | content tag (customized by C |
|||||||||||||
207 | (if C |
|||||||||||||
208 | C |
|||||||||||||
209 | and C tags. | |||||||||||||
210 | ||||||||||||||
211 | The options listed above customize parts of the default header, but | |||||||||||||
212 | setting C |
|||||||||||||
213 | built-in header or footer. These may be useful if you want to use | |||||||||||||
214 | template tags instead of literal HTML headers and footers or are | |||||||||||||
215 | integrating converted POD pages in a larger website. | |||||||||||||
216 | ||||||||||||||
217 | If you want no headers or footers output in the HTML, set these options | |||||||||||||
218 | to the empty string. | |||||||||||||
219 | ||||||||||||||
220 | =head2 index | |||||||||||||
221 | ||||||||||||||
222 | Whether to add a table-of-contents at the top of each page (called an | |||||||||||||
223 | index for the sake of tradition). | |||||||||||||
224 | ||||||||||||||
225 | =head2 anchor_items | |||||||||||||
226 | ||||||||||||||
227 | Whether to anchor every definition C<=item> directive. This needs to be | |||||||||||||
228 | enabled if you want to be able to link to specific C<=item> directives, which | |||||||||||||
229 | are output as C<< |
|||||||||||||
230 | ||||||||||||||
231 | =head2 backlink | |||||||||||||
232 | ||||||||||||||
233 | Whether to turn every =head1 directive into a link pointing to the top | |||||||||||||
234 | of the page (specifically, the opening body tag). | |||||||||||||
235 | ||||||||||||||
236 | =cut | |||||||||||||
237 | ||||||||||||||
238 | __PACKAGE__->_accessorize( | |||||||||||||
239 | 'perldoc_url_prefix', | |||||||||||||
240 | 'perldoc_url_postfix', | |||||||||||||
241 | 'man_url_prefix', | |||||||||||||
242 | 'man_url_postfix', | |||||||||||||
243 | 'title_prefix', 'title_postfix', | |||||||||||||
244 | 'html_css', | |||||||||||||
245 | 'html_javascript', | |||||||||||||
246 | 'html_doctype', | |||||||||||||
247 | 'html_charset', | |||||||||||||
248 | 'html_encode_chars', | |||||||||||||
249 | 'html_h_level', | |||||||||||||
250 | 'title', # Used internally for the title extracted from the content | |||||||||||||
251 | 'default_title', | |||||||||||||
252 | 'force_title', | |||||||||||||
253 | 'html_header', | |||||||||||||
254 | 'html_footer', | |||||||||||||
255 | 'index', | |||||||||||||
256 | 'anchor_items', | |||||||||||||
257 | 'backlink', | |||||||||||||
258 | 'batch_mode', # whether we're in batch mode | |||||||||||||
259 | 'batch_mode_current_level', | |||||||||||||
260 | # When in batch mode, how deep the current module is: 1 for "LWP", | |||||||||||||
261 | # 2 for "LWP::Procotol", 3 for "LWP::Protocol::GHTTP", etc | |||||||||||||
262 | ); | |||||||||||||
263 | ||||||||||||||
264 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ | |||||||||||||
265 | ||||||||||||||
266 | =head1 SUBCLASSING | |||||||||||||
267 | ||||||||||||||
268 | If the standard options aren't enough, you may want to subclass | |||||||||||||
269 | Pod::Simple::XHMTL. These are the most likely candidates for methods | |||||||||||||
270 | you'll want to override when subclassing. | |||||||||||||
271 | ||||||||||||||
272 | =cut | |||||||||||||
273 | ||||||||||||||
274 | sub new { | |||||||||||||
275 | 127 | 127 | 1 | 33457 | my $self = shift; | |||||||||
276 | 127 | 475 | my $new = $self->SUPER::new(@_); | |||||||||||
277 | 127 | 50 | 714 | $new->{'output_fh'} ||= *STDOUT{IO}; | ||||||||||
278 | 127 | 375 | $new->perldoc_url_prefix('https://metacpan.org/pod/'); | |||||||||||
279 | 127 | 341 | $new->man_url_prefix('http://man.he.net/man'); | |||||||||||
280 | 127 | 333 | $new->html_charset('ISO-8859-1'); | |||||||||||
281 | 127 | 383 | $new->nix_X_codes(1); | |||||||||||
282 | 127 | 297 | $new->{'scratch'} = ''; | |||||||||||
283 | 127 | 256 | $new->{'to_index'} = []; | |||||||||||
284 | 127 | 237 | $new->{'output'} = []; | |||||||||||
285 | 127 | 229 | $new->{'saved'} = []; | |||||||||||
286 | 127 | 295 | $new->{'ids'} = { '_podtop_' => 1 }; # used in | |||||||||||
287 | 127 | 229 | $new->{'in_li'} = []; | |||||||||||
288 | ||||||||||||||
289 | 127 | 354 | $new->{'__region_targets'} = []; | |||||||||||
290 | 127 | 221 | $new->{'__literal_targets'} = {}; | |||||||||||
291 | 127 | 325 | $new->accept_targets_as_html( 'html', 'HTML' ); | |||||||||||
292 | ||||||||||||||
293 | 127 | 1191 | return $new; | |||||||||||
294 | } | |||||||||||||
295 | ||||||||||||||
296 | sub html_header_tags { | |||||||||||||
297 | 20 | 20 | 1 | 31 | my $self = shift; | |||||||||
298 | 20 | 50 | 57 | return $self->{html_header_tags} = shift if @_; | ||||||||||
299 | return $self->{html_header_tags} | |||||||||||||
300 | 20 | 33 | 87 | ||= ' 301 | . $self->html_charset . '" />'; | |||||||||
302 | } | |||||||||||||
303 | ||||||||||||||
304 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ | |||||||||||||
305 | ||||||||||||||
306 | =head2 handle_text | |||||||||||||
307 | ||||||||||||||
308 | This method handles the body of text within any element: it's the body | |||||||||||||
309 | of a paragraph, or everything between a "=begin" tag and the | |||||||||||||
310 | corresponding "=end" tag, or the text within an L entity, etc. You would | |||||||||||||
311 | want to override this if you are adding a custom element type that does | |||||||||||||
312 | more than just display formatted text. Perhaps adding a way to generate | |||||||||||||
313 | HTML tables from an extended version of POD. | |||||||||||||
314 | ||||||||||||||
315 | So, let's say you want to add a custom element called 'foo'. In your | |||||||||||||
316 | subclass's C |
|||||||||||||
317 | ||||||||||||||
318 | $new->accept_targets_as_text( 'foo' ); | |||||||||||||
319 | ||||||||||||||
320 | Then override the C |
|||||||||||||
321 | "$flags->{'target'}" is equal to 'foo' and set a flag that marks that | |||||||||||||
322 | you're in a foo block (maybe "$self->{'in_foo'} = 1"). Then override the | |||||||||||||
323 | C |
|||||||||||||
324 | custom subroutine to construct the HTML output for 'foo' elements, | |||||||||||||
325 | something like: | |||||||||||||
326 | ||||||||||||||
327 | sub handle_text { | |||||||||||||
328 | my ($self, $text) = @_; | |||||||||||||
329 | if ($self->{'in_foo'}) { | |||||||||||||
330 | $self->{'scratch'} .= build_foo_html($text); | |||||||||||||
331 | return; | |||||||||||||
332 | } | |||||||||||||
333 | $self->SUPER::handle_text($text); | |||||||||||||
334 | } | |||||||||||||
335 | ||||||||||||||
336 | =head2 handle_code | |||||||||||||
337 | ||||||||||||||
338 | This method handles the body of text that is marked up to be code. | |||||||||||||
339 | You might for instance override this to plug in a syntax highlighter. | |||||||||||||
340 | The base implementation just escapes the text. | |||||||||||||
341 | ||||||||||||||
342 | The callback methods C tags |
|||||||||||||
343 | before and after C |
|||||||||||||
344 | together with C |
|||||||||||||
345 | ||||||||||||||
346 | Note that the code might be broken into multiple segments if there are | |||||||||||||
347 | nested formatting codes inside a C<< CE |
|||||||||||||
348 | calls to C |
|||||||||||||
349 | case. The same is true for verbatim sections if the C |
|||||||||||||
350 | option is turned on. | |||||||||||||
351 | ||||||||||||||
352 | =head2 accept_targets_as_html | |||||||||||||
353 | ||||||||||||||
354 | This method behaves like C |
|||||||||||||
355 | as one whose content should be emitted literally, without HTML entity escaping | |||||||||||||
356 | or wrapping in a C element. |
|||||||||||||
357 | ||||||||||||||
358 | =cut | |||||||||||||
359 | ||||||||||||||
360 | sub __in_literal_xhtml_region { | |||||||||||||
361 | 300 | 100 | 300 | 382 | return unless @{ $_[0]{__region_targets} }; | |||||||||
300 | 871 | |||||||||||||
362 | 30 | 51 | my $target = $_[0]{__region_targets}[-1]; | |||||||||||
363 | 30 | 70 | return $_[0]{__literal_targets}{ $target }; | |||||||||||
364 | } | |||||||||||||
365 | ||||||||||||||
366 | sub accept_targets_as_html { | |||||||||||||
367 | 127 | 127 | 1 | 320 | my ($self, @targets) = @_; | |||||||||
368 | 127 | 432 | $self->accept_targets(@targets); | |||||||||||
369 | 127 | 456 | $self->{__literal_targets}{$_} = 1 for @targets; | |||||||||||
370 | } | |||||||||||||
371 | ||||||||||||||
372 | sub handle_text { | |||||||||||||
373 | # escape special characters in HTML (<, >, &, etc) | |||||||||||||
374 | 279 | 279 | 1 | 458 | my $text = $_[1]; | |||||||||
375 | 279 | 365 | my $html; | |||||||||||
376 | 279 | 100 | 609 | if ($_[0]->__in_literal_xhtml_region) { | ||||||||||
377 | 5 | 6 | $html = $text; | |||||||||||
378 | 5 | 26 | $text =~ s{<[^>]+?>}{}g; | |||||||||||
379 | 5 | 26 | $text = $_[0]->decode_entities($text); | |||||||||||
380 | } | |||||||||||||
381 | else { | |||||||||||||
382 | 274 | 578 | $html = $_[0]->encode_entities($text); | |||||||||||
383 | } | |||||||||||||
384 | ||||||||||||||
385 | 279 | 100 | 100 | 5037 | if ($_[0]{'in_code'} && @{$_[0]{'in_code'}}) { | |||||||||
50 | 134 | |||||||||||||
386 | # Intentionally use the raw text in $_[1], even if we're not in a | |||||||||||||
387 | # literal xhtml region, since handle_code calls encode_entities. | |||||||||||||
388 | 40 | 94 | $_[0]->handle_code( $_[1], $_[0]{'in_code'}[-1] ); | |||||||||||
389 | } else { | |||||||||||||
390 | 239 | 100 | 453 | if ($_[0]->{in_for}) { | ||||||||||
391 | 9 | 100 | 19 | my $newlines = $_[0]->__in_literal_xhtml_region ? "\n\n" : ''; | ||||||||||
392 | 9 | 100 | 28 | if ($_[0]->{started_for}) { | ||||||||||
393 | 6 | 50 | 25 | if ($html =~ /\S/) { | ||||||||||
394 | 6 | 12 | delete $_[0]->{started_for}; | |||||||||||
395 | 6 | 14 | $_[0]{'scratch'} .= $html . $newlines; | |||||||||||
396 | } | |||||||||||||
397 | # Otherwise, append nothing until we have something to append. | |||||||||||||
398 | } else { | |||||||||||||
399 | # The parser sometimes preserves newlines and sometimes doesn't! | |||||||||||||
400 | 3 | 18 | $html =~ s/\n\z//; | |||||||||||
401 | 3 | 19 | $_[0]{'scratch'} .= $html . $newlines; | |||||||||||
402 | } | |||||||||||||
403 | } else { | |||||||||||||
404 | # Just plain text. | |||||||||||||
405 | 230 | 461 | $_[0]{'scratch'} .= $html; | |||||||||||
406 | } | |||||||||||||
407 | } | |||||||||||||
408 | ||||||||||||||
409 | 279 | 100 | 1098 | $_[0]{hhtml} .= $html if $_[0]{'in_head'}; | ||||||||||
410 | 279 | 100 | 568 | $_[0]{htext} .= $text if $_[0]{'in_head'}; | ||||||||||
411 | 279 | 100 | 1034 | $_[0]{itext} .= $text if $_[0]{'in_item_text'}; | ||||||||||
412 | } | |||||||||||||
413 | ||||||||||||||
414 | sub start_code { | |||||||||||||
415 | 29 | 29 | 0 | 68 | $_[0]{'scratch'} .= ''; |
|||||||||
416 | } | |||||||||||||
417 | ||||||||||||||
418 | sub end_code { | |||||||||||||
419 | 29 | 29 | 0 | 64 | $_[0]{'scratch'} .= ''; | |||||||||
420 | } | |||||||||||||
421 | ||||||||||||||
422 | sub handle_code { | |||||||||||||
423 | 40 | 40 | 1 | 128 | $_[0]{'scratch'} .= $_[0]->encode_entities( $_[1] ); | |||||||||
424 | } | |||||||||||||
425 | ||||||||||||||
426 | sub start_Para { | |||||||||||||
427 | 81 | 81 | 0 | 218 | $_[0]{'scratch'} .= ' '; |
|||||||||
428 | } | |||||||||||||
429 | ||||||||||||||
430 | sub start_Verbatim { | |||||||||||||
431 | 26 | 26 | 0 | 62 | $_[0]{'scratch'} = ''; |
|||||||||
432 | 26 | 42 | push(@{$_[0]{'in_code'}}, 'Verbatim'); | |||||||||||
26 | 138 | |||||||||||||
433 | 26 | 69 | $_[0]->start_code($_[0]{'in_code'}[-1]); | |||||||||||
434 | } | |||||||||||||
435 | ||||||||||||||
436 | 59 | 59 | 0 | 176 | sub start_head1 { $_[0]{'in_head'} = 1; $_[0]{htext} = $_[0]{hhtml} = ''; } | |||||||||
59 | 201 | |||||||||||||
437 | 14 | 14 | 0 | 42 | sub start_head2 { $_[0]{'in_head'} = 2; $_[0]{htext} = $_[0]{hhtml} = ''; } | |||||||||
14 | 52 | |||||||||||||
438 | 8 | 8 | 0 | 21 | sub start_head3 { $_[0]{'in_head'} = 3; $_[0]{htext} = $_[0]{hhtml} = ''; } | |||||||||
8 | 22 | |||||||||||||
439 | 9 | 9 | 0 | 23 | sub start_head4 { $_[0]{'in_head'} = 4; $_[0]{htext} = $_[0]{hhtml} = ''; } | |||||||||
9 | 26 | |||||||||||||
440 | 2 | 2 | 0 | 6 | sub start_head5 { $_[0]{'in_head'} = 5; $_[0]{htext} = $_[0]{hhtml} = ''; } | |||||||||
2 | 9 | |||||||||||||
441 | 2 | 2 | 0 | 5 | sub start_head6 { $_[0]{'in_head'} = 6; $_[0]{htext} = $_[0]{hhtml} = ''; } | |||||||||
2 | 8 | |||||||||||||
442 | ||||||||||||||
443 | sub start_item_number { | |||||||||||||
444 | 8 | 100 | 66 | 8 | 0 | 33 | $_[0]{'scratch'} = "\n" if ($_[0]{'in_li'}->[-1] && pop @{$_[0]{'in_li'}}); | |||||||
3 | 28 | |||||||||||||
445 | 8 | 31 | $_[0]{'scratch'} .= ' '; |
|||||||||||
446 | 8 | 14 | push @{$_[0]{'in_li'}}, 1; | |||||||||||
8 | 28 | |||||||||||||
447 | } | |||||||||||||
448 | ||||||||||||||
449 | sub start_item_bullet { | |||||||||||||
450 | 12 | 100 | 66 | 12 | 0 | 45 | $_[0]{'scratch'} = "\n" if ($_[0]{'in_li'}->[-1] && pop @{$_[0]{'in_li'}}); | |||||||
5 | 20 | |||||||||||||
451 | 12 | 27 | $_[0]{'scratch'} .= ' '; |
|||||||||||
452 | 12 | 17 | push @{$_[0]{'in_li'}}, 1; | |||||||||||
12 | 30 | |||||||||||||
453 | } | |||||||||||||
454 | ||||||||||||||
455 | sub start_item_text { | |||||||||||||
456 | 13 | 13 | 0 | 37 | $_[0]{'in_item_text'} = 1; $_[0]{itext} = ''; | |||||||||
13 | 31 | |||||||||||||
457 | # see end_item_text | |||||||||||||
458 | } | |||||||||||||
459 | ||||||||||||||
460 | 7 | 7 | 0 | 28 | sub start_over_bullet { $_[0]{'scratch'} = '
|
|||||||||
7 | 13 | |||||||||||||
7 | 18 | |||||||||||||
7 | 18 | |||||||||||||
461 | 0 | 0 | 0 | 0 | sub start_over_block { $_[0]{'scratch'} = '
|
|||||||||
0 | 0 | |||||||||||||
462 | 5 | 5 | 0 | 14 | sub start_over_number { $_[0]{'scratch'} = '
|
|||||||||
5 | 11 | |||||||||||||
5 | 17 | |||||||||||||
5 | 14 | |||||||||||||
463 | sub start_over_text { | |||||||||||||
464 | 7 | 7 | 0 | 16 | $_[0]{'scratch'} = '
|
|||||||||
465 | 7 | 14 | $_[0]{'dl_level'}++; | |||||||||||
466 | 7 | 100 | 29 | $_[0]{'in_dd'} ||= []; | ||||||||||
467 | 7 | 17 | $_[0]->emit | |||||||||||
468 | } | |||||||||||||
469 | ||||||||||||||
470 | 0 | 0 | 0 | 0 | sub end_over_block { $_[0]{'scratch'} .= ''; $_[0]->emit } | |||||||||
0 | 0 | |||||||||||||
471 | ||||||||||||||
472 | sub end_over_number { | |||||||||||||
473 | 5 | 50 | 5 | 0 | 12 | $_[0]{'scratch'} = "\n" if ( pop @{$_[0]{'in_li'}} ); | ||||||||
5 | 22 | |||||||||||||
474 | 5 | 116 | $_[0]{'scratch'} .= ''; | |||||||||||
475 | 5 | 74 | pop @{$_[0]{'in_li'}}; | |||||||||||
5 | 14 | |||||||||||||
476 | 5 | 16 | $_[0]->emit; | |||||||||||
477 | } | |||||||||||||
478 | ||||||||||||||
479 | sub end_over_bullet { | |||||||||||||
480 | 7 | 50 | 7 | 0 | 12 | $_[0]{'scratch'} = "\n" if ( pop @{$_[0]{'in_li'}} ); | ||||||||
7 | 27 | |||||||||||||
481 | 7 | 24 | $_[0]{'scratch'} .= ''; | |||||||||||
482 | 7 | 21 | pop @{$_[0]{'in_li'}}; | |||||||||||
7 | 14 | |||||||||||||
483 | 7 | 18 | $_[0]->emit; | |||||||||||
484 | } | |||||||||||||
485 | ||||||||||||||
486 | sub end_over_text { | |||||||||||||
487 | 7 | 50 | 7 | 0 | 23 | if ($_[0]{'in_dd'}[ $_[0]{'dl_level'} ]) { | ||||||||
488 | 7 | 13 | $_[0]{'scratch'} = "\n"; | |||||||||||
489 | 7 | 13 | $_[0]{'in_dd'}[ $_[0]{'dl_level'} ] = 0; | |||||||||||
490 | } | |||||||||||||
491 | 7 | 12 | $_[0]{'scratch'} .= ''; | |||||||||||
492 | 7 | 12 | $_[0]{'dl_level'}--; | |||||||||||
493 | 7 | 16 | $_[0]->emit; | |||||||||||
494 | } | |||||||||||||
495 | ||||||||||||||
496 | # . . . . . Now the actual formatters: | |||||||||||||
497 | ||||||||||||||
498 | 81 | 81 | 0 | 180 | sub end_Para { $_[0]{'scratch'} .= ''; $_[0]->emit } | |||||||||
81 | 189 | |||||||||||||
499 | sub end_Verbatim { | |||||||||||||
500 | 26 | 26 | 0 | 55 | $_[0]->end_code(pop(@{$_[0]->{'in_code'}})); | |||||||||
26 | 91 | |||||||||||||
501 | 26 | 51 | $_[0]{'scratch'} .= ''; | |||||||||||
502 | 26 | 62 | $_[0]->emit; | |||||||||||
503 | } | |||||||||||||
504 | ||||||||||||||
505 | sub _end_head { | |||||||||||||
506 | 94 | 94 | 196 | my $h = delete $_[0]{in_head}; | ||||||||||
507 | ||||||||||||||
508 | 94 | 222 | my $add = $_[0]->html_h_level; | |||||||||||
509 | 94 | 100 | 225 | $add = 1 unless defined $add; | ||||||||||
510 | 94 | 180 | $h += $add - 1; | |||||||||||
511 | ||||||||||||||
512 | 94 | 226 | my $id = $_[0]->idify(delete $_[0]{htext}); | |||||||||||
513 | 94 | 211 | my $text = $_[0]{scratch}; | |||||||||||
514 | 94 | 263 | my $head = qq{ |
|||||||||||
515 | 94 | 100 | 100 | 1488 | $_[0]{'scratch'} = $_[0]->backlink && ($h - $add == 0) | |||||||||
516 | # backlinks enabled && =head1 | |||||||||||||
517 | ? qq{$head} | |||||||||||||
518 | : $head; | |||||||||||||
519 | 94 | 241 | $_[0]->emit; | |||||||||||
520 | 94 | 129 | push @{ $_[0]{'to_index'} }, [$h, $id, delete $_[0]{'hhtml'}]; | |||||||||||
94 | 464 | |||||||||||||
521 | } | |||||||||||||
522 | ||||||||||||||
523 | 59 | 59 | 0 | 176 | sub end_head1 { shift->_end_head(@_); } | |||||||||
524 | 14 | 14 | 0 | 56 | sub end_head2 { shift->_end_head(@_); } | |||||||||
525 | 8 | 8 | 0 | 32 | sub end_head3 { shift->_end_head(@_); } | |||||||||
526 | 9 | 9 | 0 | 24 | sub end_head4 { shift->_end_head(@_); } | |||||||||
527 | 2 | 2 | 0 | 8 | sub end_head5 { shift->_end_head(@_); } | |||||||||
528 | 2 | 2 | 0 | 8 | sub end_head6 { shift->_end_head(@_); } | |||||||||
529 | ||||||||||||||
530 | 12 | 12 | 0 | 27 | sub end_item_bullet { $_[0]{'scratch'} .= ''; $_[0]->emit } | |||||||||
12 | 56 | |||||||||||||
531 | 8 | 8 | 0 | 21 | sub end_item_number { $_[0]{'scratch'} .= ''; $_[0]->emit } | |||||||||
8 | 21 | |||||||||||||
532 | ||||||||||||||
533 | sub end_item_text { | |||||||||||||
534 | # idify and anchor =item content if wanted | |||||||||||||
535 | my $dt_id = $_[0]{'anchor_items'} | |||||||||||||
536 | 13 | 100 | 13 | 0 | 40 | ? ' id="'. $_[0]->encode_entities($_[0]->idify($_[0]{'itext'})) .'"' | ||||||||
537 | : ''; | |||||||||||||
538 | ||||||||||||||
539 | # reset scratch | |||||||||||||
540 | 13 | 130 | my $text = $_[0]{scratch}; | |||||||||||
541 | 13 | 85 | $_[0]{'scratch'} = ''; | |||||||||||
542 | ||||||||||||||
543 | 13 | 100 | 38 | if ($_[0]{'in_dd'}[ $_[0]{'dl_level'} ]) { | ||||||||||
544 | 6 | 12 | $_[0]{'scratch'} = "\n"; | |||||||||||
545 | 6 | 14 | $_[0]{'in_dd'}[ $_[0]{'dl_level'} ] = 0; | |||||||||||
546 | } | |||||||||||||
547 | ||||||||||||||
548 | 13 | 32 | $_[0]{'scratch'} .= qq{ |
|||||||||||
549 | 13 | 23 | $_[0]{'in_dd'}[ $_[0]{'dl_level'} ] = 1; | |||||||||||
550 | 13 | 26 | $_[0]->emit; | |||||||||||
551 | } | |||||||||||||
552 | ||||||||||||||
553 | # This handles =begin and =for blocks of all kinds. | |||||||||||||
554 | sub start_for { | |||||||||||||
555 | 6 | 6 | 0 | 14 | my ($self, $flags) = @_; | |||||||||
556 | ||||||||||||||
557 | 6 | 17 | push @{ $self->{__region_targets} }, $flags->{target_matching}; | |||||||||||
6 | 43 | |||||||||||||
558 | 6 | 11 | $self->{started_for} = 1; | |||||||||||
559 | 6 | 14 | $self->{in_for} = 1; | |||||||||||
560 | ||||||||||||||
561 | 6 | 100 | 13 | unless ($self->__in_literal_xhtml_region) { | ||||||||||
562 | 4 | 8 | $self->{scratch} .= ' | |||||||||||
563 | 4 | 50 | 10 | $self->{scratch} .= qq( class="$flags->{target}") if $flags->{target}; | ||||||||||
564 | 4 | 10 | $self->{scratch} .= ">\n\n"; | |||||||||||
565 | } | |||||||||||||
566 | } | |||||||||||||
567 | ||||||||||||||
568 | sub end_for { | |||||||||||||
569 | 6 | 6 | 0 | 12 | my ($self) = @_; | |||||||||
570 | 6 | 11 | delete $self->{started_for}; | |||||||||||
571 | 6 | 26 | delete $self->{in_for}; | |||||||||||
572 | ||||||||||||||
573 | 6 | 100 | 32 | if ($self->__in_literal_xhtml_region) { | ||||||||||
574 | # Remove trailine newlines. | |||||||||||||
575 | 2 | 13 | $self->{'scratch'} =~ s/\s+\z//s; | |||||||||||
576 | } else { | |||||||||||||
577 | 4 | 7 | $self->{'scratch'} .= ''; | |||||||||||
578 | } | |||||||||||||
579 | ||||||||||||||
580 | 6 | 9 | pop @{ $self->{__region_targets} }; | |||||||||||
6 | 10 | |||||||||||||
581 | 6 | 12 | $self->emit; | |||||||||||
582 | } | |||||||||||||
583 | ||||||||||||||
584 | sub start_Document { | |||||||||||||
585 | 123 | 123 | 0 | 275 | my ($self) = @_; | |||||||||
586 | 123 | 100 | 318 | if (defined $self->html_header) { | ||||||||||
587 | 103 | 241 | $self->{'scratch'} .= $self->html_header; | |||||||||||
588 | 103 | 100 | 249 | $self->emit unless $self->html_header eq ""; | ||||||||||
589 | } else { | |||||||||||||
590 | 20 | 35 | my ($doctype, $title, $metatags, $bodyid); | |||||||||||
591 | 20 | 50 | 55 | $doctype = $self->html_doctype || ''; | ||||||||||
592 | 20 | 50 | 52 | $title = $self->force_title || $self->title || $self->default_title || ''; | ||||||||||
593 | 20 | 50 | 57 | $metatags = $self->html_header_tags || ''; | ||||||||||
594 | 20 | 100 | 71 | if (my $css = $self->html_css) { | ||||||||||
595 | 3 | 100 | 11 | if ($css !~ / | ||||||||||
596 | # this is required to be compatible with Pod::Simple::BatchHTML | |||||||||||||
597 | 2 | 6 | $metatags .= ' 598 | . $self->encode_entities($css) . '" type="text/css" />'; | ||||||||||
599 | } else { | |||||||||||||
600 | 1 | 3 | $metatags .= $css; | |||||||||||
601 | } | |||||||||||||
602 | } | |||||||||||||
603 | 20 | 50 | 96 | if ($self->html_javascript) { | ||||||||||
604 | 0 | 0 | $metatags .= qq{\n'; | |||||||||||
606 | } | |||||||||||||
607 | 20 | 100 | 58 | $bodyid = $self->backlink ? ' id="_podtop_"' : ''; | ||||||||||
608 | 20 | 91 | $self->{'scratch'} .= <<"HTML"; | |||||||||||
609 | $doctype | |||||||||||||
610 | ||||||||||||||
611 | ||||||||||||||
612 | |
|||||||||||||
613 | $metatags | |||||||||||||
614 | ||||||||||||||
615 | ||||||||||||||
616 | HTML | |||||||||||||
617 | 20 | 48 | $self->emit; | |||||||||||
618 | } | |||||||||||||
619 | } | |||||||||||||
620 | ||||||||||||||
621 | sub build_index { | |||||||||||||
622 | 26 | 26 | 0 | 43 | my ($self, $to_index) = @_; | |||||||||
623 | ||||||||||||||
624 | 26 | 37 | my @out; | |||||||||||
625 | 26 | 39 | my $level = 0; | |||||||||||
626 | 26 | 30 | my $indent = -1; | |||||||||||
627 | 26 | 42 | my $space = ''; | |||||||||||
628 | 26 | 33 | my $id = ' id="index"'; | |||||||||||
629 | ||||||||||||||
630 | 26 | 34 | for my $h (@{ $to_index }, [0]) { | |||||||||||
26 | 58 | |||||||||||||
631 | 88 | 146 | my $target_level = $h->[0]; | |||||||||||
632 | # Get to target_level by opening or closing ULs | |||||||||||||
633 | 88 | 100 | 205 | if ($level == $target_level) { | ||||||||||
100 | ||||||||||||||
634 | 9 | 24 | $out[-1] .= ''; | |||||||||||
635 | } elsif ($level > $target_level) { | |||||||||||||
636 | 32 | 50 | 186 | $out[-1] .= '' if $out[-1] =~ /^\s+ |
||||||||||
637 | 32 | 74 | while ($level > $target_level) { | |||||||||||
638 | 61 | 74 | --$level; | |||||||||||
639 | 61 | 100 | 66 | 268 | push @out, (' ' x --$indent) . '' if @out && $out[-1] =~ m{^\s+<\/ul}; | |||||||||
640 | 61 | 184 | push @out, (' ' x --$indent) . ''; | |||||||||||
641 | } | |||||||||||||
642 | 32 | 100 | 92 | push @out, (' ' x --$indent) . '' if $level; | ||||||||||
643 | } else { | |||||||||||||
644 | 47 | 104 | while ($level < $target_level) { | |||||||||||
645 | 61 | 80 | ++$level; | |||||||||||
646 | 61 | 100 | 100 | 224 | push @out, (' ' x ++$indent) . ' | |||||||||
647 | 61 | 184 | push @out, (' ' x ++$indent) . "
|
|||||||||||
648 | 61 | 123 | $id = ''; | |||||||||||
649 | } | |||||||||||||
650 | 47 | 71 | ++$indent; | |||||||||||
651 | } | |||||||||||||
652 | ||||||||||||||
653 | 88 | 100 | 169 | next unless $level; | ||||||||||
654 | 62 | 104 | $space = ' ' x $indent; | |||||||||||
655 | 62 | 130 | my $fragment = $self->encode_entities($self->encode_url($h->[1])); | |||||||||||
656 | 62 | 1078 | push @out, sprintf '%s |
|||||||||||
657 | $space, $fragment, $h->[2]; | |||||||||||||
658 | } | |||||||||||||
659 | ||||||||||||||
660 | 26 | 130 | return join "\n", @out; | |||||||||||
661 | } | |||||||||||||
662 | ||||||||||||||
663 | sub end_Document { | |||||||||||||
664 | 123 | 123 | 0 | 246 | my ($self) = @_; | |||||||||
665 | 123 | 207 | my $to_index = $self->{'to_index'}; | |||||||||||
666 | 123 | 100 | 66 | 285 | if ($self->index && @{ $to_index } ) { | |||||||||
26 | 69 | |||||||||||||
667 | 26 | 57 | my $index = $self->build_index($to_index); | |||||||||||
668 | ||||||||||||||
669 | # Splice the index in between the HTML headers and the first element. | |||||||||||||
670 | 26 | 50 | 71 | my $offset = defined $self->html_header ? $self->html_header eq '' ? 0 : 1 : 1; | ||||||||||
100 | ||||||||||||||
671 | 26 | 43 | splice @{ $self->{'output'} }, $offset, 0, $index; | |||||||||||
26 | 81 | |||||||||||||
672 | } | |||||||||||||
673 | ||||||||||||||
674 | 123 | 100 | 301 | if (defined $self->html_footer) { | ||||||||||
675 | 103 | 227 | $self->{'scratch'} .= $self->html_footer; | |||||||||||
676 | 103 | 100 | 224 | $self->emit unless $self->html_footer eq ""; | ||||||||||
677 | } else { | |||||||||||||
678 | 20 | 44 | $self->{'scratch'} .= "\n"; | |||||||||||
679 | 20 | 40 | $self->emit; | |||||||||||
680 | } | |||||||||||||
681 | ||||||||||||||
682 | 123 | 100 | 299 | if ($self->index) { | ||||||||||
683 | 26 | 36 | print {$self->{'output_fh'}} join ("\n\n", @{ $self->{'output'} }), "\n\n"; | |||||||||||
26 | 53 | |||||||||||||
26 | 179 | |||||||||||||
684 | 26 | 51 | @{$self->{'output'}} = (); | |||||||||||
26 | 86 | |||||||||||||
685 | } | |||||||||||||
686 | ||||||||||||||
687 | } | |||||||||||||
688 | ||||||||||||||
689 | # Handling code tags | |||||||||||||
690 | 7 | 7 | 0 | 36 | sub start_B { $_[0]{'scratch'} .= '' } | |||||||||
691 | 7 | 7 | 0 | 17 | sub end_B { $_[0]{'scratch'} .= '' } | |||||||||
692 | ||||||||||||||
693 | 7 | 7 | 0 | 22 | sub start_C { push(@{$_[0]{'in_code'}}, 'C'); $_[0]->start_code($_[0]{'in_code'}[-1]); } | |||||||||
7 | 25 | |||||||||||||
7 | 43 | |||||||||||||
694 | 7 | 7 | 0 | 16 | sub end_C { $_[0]->end_code(pop(@{$_[0]{'in_code'}})); } | |||||||||
7 | 35 | |||||||||||||
695 | ||||||||||||||
696 | 1 | 1 | 0 | 5 | sub start_F { $_[0]{'scratch'} .= '' } | |||||||||
697 | 1 | 1 | 0 | 7 | sub end_F { $_[0]{'scratch'} .= '' } | |||||||||
698 | ||||||||||||||
699 | 1 | 1 | 0 | 3 | sub start_I { $_[0]{'scratch'} .= '' } | |||||||||
700 | 1 | 1 | 0 | 3 | sub end_I { $_[0]{'scratch'} .= '' } | |||||||||
701 | ||||||||||||||
702 | sub start_L { | |||||||||||||
703 | 29 | 29 | 0 | 70 | my ($self, $flags) = @_; | |||||||||
704 | 29 | 46 | my ($type, $to, $section) = @{$flags}{'type', 'to', 'section'}; | |||||||||||
29 | 97 | |||||||||||||
705 | 29 | 50 | 124 | my $url = $self->encode_entities( | ||||||||||
100 | ||||||||||||||
100 | ||||||||||||||
706 | $type eq 'url' ? $to | |||||||||||||
707 | : $type eq 'pod' ? $self->resolve_pod_page_link($to, $section) | |||||||||||||
708 | : $type eq 'man' ? $self->resolve_man_page_link($to, $section) | |||||||||||||
709 | : undef | |||||||||||||
710 | ); | |||||||||||||
711 | ||||||||||||||
712 | # If it's an unknown type, use an attribute-less like HTML.pm. | |||||||||||||
713 | 29 | 50 | 395 | $self->{'scratch'} .= '' : '>'); | ||||||||||
714 | } | |||||||||||||
715 | ||||||||||||||
716 | 29 | 29 | 0 | 75 | sub end_L { $_[0]{'scratch'} .= '' } | |||||||||
717 | ||||||||||||||
718 | 1 | 1 | 0 | 4 | sub start_S { $_[0]{'scratch'} .= '' } | |||||||||
719 | 1 | 1 | 0 | 2 | sub end_S { $_[0]{'scratch'} .= '' } | |||||||||
720 | ||||||||||||||
721 | sub emit { | |||||||||||||
722 | 320 | 320 | 0 | 595 | my($self) = @_; | |||||||||
723 | 320 | 100 | 735 | if ($self->index) { | ||||||||||
724 | 100 | 130 | push @{ $self->{'output'} }, $self->{'scratch'}; | |||||||||||
100 | 284 | |||||||||||||
725 | } else { | |||||||||||||
726 | 220 | 312 | print {$self->{'output_fh'}} $self->{'scratch'}, "\n\n"; | |||||||||||
220 | 821 | |||||||||||||
727 | } | |||||||||||||
728 | 320 | 606 | $self->{'scratch'} = ''; | |||||||||||
729 | 320 | 640 | return; | |||||||||||
730 | } | |||||||||||||
731 | ||||||||||||||
732 | =head2 resolve_pod_page_link | |||||||||||||
733 | ||||||||||||||
734 | my $url = $pod->resolve_pod_page_link('Net::Ping', 'INSTALL'); | |||||||||||||
735 | my $url = $pod->resolve_pod_page_link('perlpodspec'); | |||||||||||||
736 | my $url = $pod->resolve_pod_page_link(undef, 'SYNOPSIS'); | |||||||||||||
737 | ||||||||||||||
738 | Resolves a POD link target (typically a module or POD file name) and section | |||||||||||||
739 | name to a URL. The resulting link will be returned for the above examples as: | |||||||||||||
740 | ||||||||||||||
741 | https://metacpan.org/pod/Net::Ping#INSTALL | |||||||||||||
742 | https://metacpan.org/pod/perlpodspec | |||||||||||||
743 | #SYNOPSIS | |||||||||||||
744 | ||||||||||||||
745 | Note that when there is only a section argument the URL will simply be a link | |||||||||||||
746 | to a section in the current document. | |||||||||||||
747 | ||||||||||||||
748 | =cut | |||||||||||||
749 | ||||||||||||||
750 | sub resolve_pod_page_link { | |||||||||||||
751 | 19 | 19 | 1 | 67 | my ($self, $to, $section) = @_; | |||||||||
752 | 19 | 50 | 66 | 68 | return undef unless defined $to || defined $section; | |||||||||
753 | 19 | 100 | 37 | if (defined $section) { | ||||||||||
754 | 11 | 34 | my $id = $self->idify($section, 1); | |||||||||||
755 | 11 | 32 | $section = '#' . $self->encode_url($id); | |||||||||||
756 | 11 | 100 | 50 | return $section unless defined $to; | ||||||||||
757 | } else { | |||||||||||||
758 | 8 | 15 | $section = '' | |||||||||||
759 | } | |||||||||||||
760 | ||||||||||||||
761 | 13 | 50 | 47 | return ($self->perldoc_url_prefix || '') | ||||||||||
50 | ||||||||||||||
762 | . $to . $section | |||||||||||||
763 | . ($self->perldoc_url_postfix || ''); | |||||||||||||
764 | } | |||||||||||||
765 | ||||||||||||||
766 | =head2 resolve_man_page_link | |||||||||||||
767 | ||||||||||||||
768 | my $url = $pod->resolve_man_page_link('crontab(5)', 'EXAMPLE CRON FILE'); | |||||||||||||
769 | my $url = $pod->resolve_man_page_link('crontab'); | |||||||||||||
770 | ||||||||||||||
771 | Resolves a man page link target and numeric section to a URL. The resulting | |||||||||||||
772 | link will be returned for the above examples as: | |||||||||||||
773 | ||||||||||||||
774 | http://man.he.net/man5/crontab | |||||||||||||
775 | http://man.he.net/man1/crontab | |||||||||||||
776 | ||||||||||||||
777 | Note that the first argument is required. The section number will be parsed | |||||||||||||
778 | from it, and if it's missing will default to 1. The second argument is | |||||||||||||
779 | currently ignored, as L |
|||||||||||||
780 | include linkable IDs or anchor names in its pages. Subclass to link to a | |||||||||||||
781 | different man page HTTP server. | |||||||||||||
782 | ||||||||||||||
783 | =cut | |||||||||||||
784 | ||||||||||||||
785 | sub resolve_man_page_link { | |||||||||||||
786 | 6 | 6 | 1 | 21 | my ($self, $to, $section) = @_; | |||||||||
787 | 6 | 50 | 20 | return undef unless defined $to; | ||||||||||
788 | 6 | 31 | my ($page, $part) = $to =~ /^([^(]+)(?:[(](\d+)[)])?$/; | |||||||||||
789 | 6 | 50 | 17 | return undef unless $page; | ||||||||||
790 | 6 | 50 | 17 | return ($self->man_url_prefix || '') | ||||||||||
100 | ||||||||||||||
50 | ||||||||||||||
791 | . ($part || 1) . "/" . $self->encode_entities($page) | |||||||||||||
792 | . ($self->man_url_postfix || ''); | |||||||||||||
793 | ||||||||||||||
794 | } | |||||||||||||
795 | ||||||||||||||
796 | =head2 idify | |||||||||||||
797 | ||||||||||||||
798 | my $id = $pod->idify($text); | |||||||||||||
799 | my $hash = $pod->idify($text, 1); | |||||||||||||
800 | ||||||||||||||
801 | This method turns an arbitrary string into a valid XHTML ID attribute value. | |||||||||||||
802 | The rules enforced, following | |||||||||||||
803 | L |
|||||||||||||
804 | ||||||||||||||
805 | =over | |||||||||||||
806 | ||||||||||||||
807 | =item * | |||||||||||||
808 | ||||||||||||||
809 | The id must start with a letter (a-z or A-Z) | |||||||||||||
810 | ||||||||||||||
811 | =item * | |||||||||||||
812 | ||||||||||||||
813 | All subsequent characters can be letters, numbers (0-9), hyphens (-), | |||||||||||||
814 | underscores (_), colons (:), and periods (.). | |||||||||||||
815 | ||||||||||||||
816 | =item * | |||||||||||||
817 | ||||||||||||||
818 | The final character can't be a hyphen, colon, or period. URLs ending with these | |||||||||||||
819 | characters, while allowed by XHTML, can be awkward to extract from plain text. | |||||||||||||
820 | ||||||||||||||
821 | =item * | |||||||||||||
822 | ||||||||||||||
823 | Each id must be unique within the document. | |||||||||||||
824 | ||||||||||||||
825 | =back | |||||||||||||
826 | ||||||||||||||
827 | In addition, the returned value will be unique within the context of the | |||||||||||||
828 | Pod::Simple::XHTML object unless a second argument is passed a true value. ID | |||||||||||||
829 | attributes should always be unique within a single XHTML document, but pass | |||||||||||||
830 | the true value if you are creating not an ID but a URL hash to point to | |||||||||||||
831 | an ID (i.e., if you need to put the "#foo" in C<< foo >>. | |||||||||||||
832 | ||||||||||||||
833 | =cut | |||||||||||||
834 | ||||||||||||||
835 | sub idify { | |||||||||||||
836 | 119 | 119 | 1 | 2732 | my ($self, $t, $not_unique) = @_; | |||||||||
837 | 119 | 229 | for ($t) { | |||||||||||
838 | 119 | 250 | s/[<>&'"]//g; # Strip HTML special characters | |||||||||||
839 | 119 | 296 | s/^\s+//; s/\s+$//; # Strip white space. | |||||||||||
119 | 259 | |||||||||||||
840 | 119 | 275 | s/^([^a-zA-Z]+)$/pod$1/; # Prepend "pod" if no valid chars. | |||||||||||
841 | 119 | 219 | s/^[^a-zA-Z]+//; # First char must be a letter. | |||||||||||
842 | 119 | 268 | s/[^-a-zA-Z0-9_:.]+/-/g; # All other chars must be valid. | |||||||||||
843 | 119 | 300 | s/[-:.]+$//; # Strip trailing punctuation. | |||||||||||
844 | } | |||||||||||||
845 | 119 | 100 | 293 | return $t if $not_unique; | ||||||||||
846 | 102 | 162 | my $i = ''; | |||||||||||
847 | 102 | 403 | $i++ while $self->{ids}{"$t$i"}++; | |||||||||||
848 | 102 | 274 | return "$t$i"; | |||||||||||
849 | } | |||||||||||||
850 | ||||||||||||||
851 | =head2 batch_mode_page_object_init | |||||||||||||
852 | ||||||||||||||
853 | $pod->batch_mode_page_object_init($batchconvobj, $module, $infile, $outfile, $depth); | |||||||||||||
854 | ||||||||||||||
855 | Called by L |
|||||||||||||
856 | initialize the converter. Internally it sets the C |
|||||||||||||
857 | true and sets C |
|||||||||||||
858 | currently use those features. Subclasses might, though. | |||||||||||||
859 | ||||||||||||||
860 | =cut | |||||||||||||
861 | ||||||||||||||
862 | sub batch_mode_page_object_init { | |||||||||||||
863 | 1 | 1 | 1 | 4 | my ($self, $batchconvobj, $module, $infile, $outfile, $depth) = @_; | |||||||||
864 | 1 | 5 | $self->batch_mode(1); | |||||||||||
865 | 1 | 4 | $self->batch_mode_current_level($depth); | |||||||||||
866 | 1 | 4 | return $self; | |||||||||||
867 | } | |||||||||||||
868 | ||||||||||||||
869 | 0 | 0 | sub html_header_after_title { | |||||||||||
870 | } | |||||||||||||
871 | ||||||||||||||
872 | ||||||||||||||
873 | 1; | |||||||||||||
874 | ||||||||||||||
875 | __END__ |