| 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__ |