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