| 1 | package Pod::Html; |
| 2 | use strict; |
| 3 | require Exporter; |
| 4 | |
| 5 | use vars qw($VERSION @ISA @EXPORT @EXPORT_OK); |
| 6 | $VERSION = 1.15; |
| 7 | @ISA = qw(Exporter); |
| 8 | @EXPORT = qw(pod2html htmlify); |
| 9 | @EXPORT_OK = qw(anchorify); |
| 10 | |
| 11 | use Carp; |
| 12 | use Config; |
| 13 | use Cwd; |
| 14 | use File::Basename; |
| 15 | use File::Spec; |
| 16 | use File::Spec::Unix; |
| 17 | use Getopt::Long; |
| 18 | use Pod::Simple::Search; |
| 19 | |
| 20 | use locale; # make \w work right in non-ASCII lands |
| 21 | |
| 22 | =head1 NAME |
| 23 | |
| 24 | Pod::Html - module to convert pod files to HTML |
| 25 | |
| 26 | =head1 SYNOPSIS |
| 27 | |
| 28 | use Pod::Html; |
| 29 | pod2html([options]); |
| 30 | |
| 31 | =head1 DESCRIPTION |
| 32 | |
| 33 | Converts files from pod format (see L<perlpod>) to HTML format. It |
| 34 | can automatically generate indexes and cross-references, and it keeps |
| 35 | a cache of things it knows how to cross-reference. |
| 36 | |
| 37 | =head1 FUNCTIONS |
| 38 | |
| 39 | =head2 pod2html |
| 40 | |
| 41 | pod2html("pod2html", |
| 42 | "--podpath=lib:ext:pod:vms", |
| 43 | "--podroot=/usr/src/perl", |
| 44 | "--htmlroot=/perl/nmanual", |
| 45 | "--recurse", |
| 46 | "--infile=foo.pod", |
| 47 | "--outfile=/perl/nmanual/foo.html"); |
| 48 | |
| 49 | pod2html takes the following arguments: |
| 50 | |
| 51 | =over 4 |
| 52 | |
| 53 | =item backlink |
| 54 | |
| 55 | --backlink |
| 56 | |
| 57 | Turns every C<head1> heading into a link back to the top of the page. |
| 58 | By default, no backlinks are generated. |
| 59 | |
| 60 | =item cachedir |
| 61 | |
| 62 | --cachedir=name |
| 63 | |
| 64 | Creates the directory cache in the given directory. |
| 65 | |
| 66 | =item css |
| 67 | |
| 68 | --css=stylesheet |
| 69 | |
| 70 | Specify the URL of a cascading style sheet. Also disables all HTML/CSS |
| 71 | C<style> attributes that are output by default (to avoid conflicts). |
| 72 | |
| 73 | =item flush |
| 74 | |
| 75 | --flush |
| 76 | |
| 77 | Flushes the directory cache. |
| 78 | |
| 79 | =item header |
| 80 | |
| 81 | --header |
| 82 | --noheader |
| 83 | |
| 84 | Creates header and footer blocks containing the text of the C<NAME> |
| 85 | section. By default, no headers are generated. |
| 86 | |
| 87 | =item help |
| 88 | |
| 89 | --help |
| 90 | |
| 91 | Displays the usage message. |
| 92 | |
| 93 | =item htmldir |
| 94 | |
| 95 | --htmldir=name |
| 96 | |
| 97 | Sets the directory to which all cross references in the resulting |
| 98 | html file will be relative. Not passing this causes all links to be |
| 99 | absolute since this is the value that tells Pod::Html the root of the |
| 100 | documentation tree. |
| 101 | |
| 102 | Do not use this and --htmlroot in the same call to pod2html; they are |
| 103 | mutually exclusive. |
| 104 | |
| 105 | =item htmlroot |
| 106 | |
| 107 | --htmlroot=name |
| 108 | |
| 109 | Sets the base URL for the HTML files. When cross-references are made, |
| 110 | the HTML root is prepended to the URL. |
| 111 | |
| 112 | Do not use this if relative links are desired: use --htmldir instead. |
| 113 | |
| 114 | Do not pass both this and --htmldir to pod2html; they are mutually |
| 115 | exclusive. |
| 116 | |
| 117 | =item index |
| 118 | |
| 119 | --index |
| 120 | --noindex |
| 121 | |
| 122 | Generate an index at the top of the HTML file. This is the default |
| 123 | behaviour. |
| 124 | |
| 125 | =item infile |
| 126 | |
| 127 | --infile=name |
| 128 | |
| 129 | Specify the pod file to convert. Input is taken from STDIN if no |
| 130 | infile is specified. |
| 131 | |
| 132 | =item outfile |
| 133 | |
| 134 | --outfile=name |
| 135 | |
| 136 | Specify the HTML file to create. Output goes to STDOUT if no outfile |
| 137 | is specified. |
| 138 | |
| 139 | =item poderrors |
| 140 | |
| 141 | --poderrors |
| 142 | --nopoderrors |
| 143 | |
| 144 | Include a "POD ERRORS" section in the outfile if there were any POD |
| 145 | errors in the infile. This section is included by default. |
| 146 | |
| 147 | =item podpath |
| 148 | |
| 149 | --podpath=name:...:name |
| 150 | |
| 151 | Specify which subdirectories of the podroot contain pod files whose |
| 152 | HTML converted forms can be linked to in cross references. |
| 153 | |
| 154 | =item podroot |
| 155 | |
| 156 | --podroot=name |
| 157 | |
| 158 | Specify the base directory for finding library pods. Default is the |
| 159 | current working directory. |
| 160 | |
| 161 | =item quiet |
| 162 | |
| 163 | --quiet |
| 164 | --noquiet |
| 165 | |
| 166 | Don't display I<mostly harmless> warning messages. These messages |
| 167 | will be displayed by default. But this is not the same as C<verbose> |
| 168 | mode. |
| 169 | |
| 170 | =item recurse |
| 171 | |
| 172 | --recurse |
| 173 | --norecurse |
| 174 | |
| 175 | Recurse into subdirectories specified in podpath (default behaviour). |
| 176 | |
| 177 | =item title |
| 178 | |
| 179 | --title=title |
| 180 | |
| 181 | Specify the title of the resulting HTML file. |
| 182 | |
| 183 | =item verbose |
| 184 | |
| 185 | --verbose |
| 186 | --noverbose |
| 187 | |
| 188 | Display progress messages. By default, they won't be displayed. |
| 189 | |
| 190 | =back |
| 191 | |
| 192 | =head2 htmlify |
| 193 | |
| 194 | htmlify($heading); |
| 195 | |
| 196 | Converts a pod section specification to a suitable section specification |
| 197 | for HTML. Note that we keep spaces and special characters except |
| 198 | C<", ?> (Netscape problem) and the hyphen (writer's problem...). |
| 199 | |
| 200 | =head2 anchorify |
| 201 | |
| 202 | anchorify(@heading); |
| 203 | |
| 204 | Similar to C<htmlify()>, but turns non-alphanumerics into underscores. Note |
| 205 | that C<anchorify()> is not exported by default. |
| 206 | |
| 207 | =head1 ENVIRONMENT |
| 208 | |
| 209 | Uses C<$Config{pod2html}> to setup default options. |
| 210 | |
| 211 | =head1 AUTHOR |
| 212 | |
| 213 | Marc Green, E<lt>marcgreen@cpan.orgE<gt>. |
| 214 | |
| 215 | Original version by Tom Christiansen, E<lt>tchrist@perl.comE<gt>. |
| 216 | |
| 217 | =head1 SEE ALSO |
| 218 | |
| 219 | L<perlpod> |
| 220 | |
| 221 | =head1 COPYRIGHT |
| 222 | |
| 223 | This program is distributed under the Artistic License. |
| 224 | |
| 225 | =cut |
| 226 | |
| 227 | my $Cachedir; |
| 228 | my $Dircache; |
| 229 | my($Htmlroot, $Htmldir, $Htmlfile, $Htmlfileurl); |
| 230 | my($Podfile, @Podpath, $Podroot); |
| 231 | my $Poderrors; |
| 232 | my $Css; |
| 233 | |
| 234 | my $Recurse; |
| 235 | my $Quiet; |
| 236 | my $Verbose; |
| 237 | my $Doindex; |
| 238 | |
| 239 | my $Backlink; |
| 240 | |
| 241 | my($Title, $Header); |
| 242 | |
| 243 | my %Pages = (); # associative array used to find the location |
| 244 | # of pages referenced by L<> links. |
| 245 | |
| 246 | my $Curdir = File::Spec->curdir; |
| 247 | |
| 248 | init_globals(); |
| 249 | |
| 250 | sub init_globals { |
| 251 | $Cachedir = "."; # The directory to which directory caches |
| 252 | # will be written. |
| 253 | |
| 254 | $Dircache = "pod2htmd.tmp"; |
| 255 | |
| 256 | $Htmlroot = "/"; # http-server base directory from which all |
| 257 | # relative paths in $podpath stem. |
| 258 | $Htmldir = ""; # The directory to which the html pages |
| 259 | # will (eventually) be written. |
| 260 | $Htmlfile = ""; # write to stdout by default |
| 261 | $Htmlfileurl = ""; # The url that other files would use to |
| 262 | # refer to this file. This is only used |
| 263 | # to make relative urls that point to |
| 264 | # other files. |
| 265 | |
| 266 | $Poderrors = 1; |
| 267 | $Podfile = ""; # read from stdin by default |
| 268 | @Podpath = (); # list of directories containing library pods. |
| 269 | $Podroot = $Curdir; # filesystem base directory from which all |
| 270 | # relative paths in $podpath stem. |
| 271 | $Css = ''; # Cascading style sheet |
| 272 | $Recurse = 1; # recurse on subdirectories in $podpath. |
| 273 | $Quiet = 0; # not quiet by default |
| 274 | $Verbose = 0; # not verbose by default |
| 275 | $Doindex = 1; # non-zero if we should generate an index |
| 276 | $Backlink = 0; # no backlinks added by default |
| 277 | $Header = 0; # produce block header/footer |
| 278 | $Title = ''; # title to give the pod(s) |
| 279 | } |
| 280 | |
| 281 | sub pod2html { |
| 282 | local(@ARGV) = @_; |
| 283 | local $_; |
| 284 | |
| 285 | init_globals(); |
| 286 | parse_command_line(); |
| 287 | |
| 288 | # prevent '//' in urls |
| 289 | $Htmlroot = "" if $Htmlroot eq "/"; |
| 290 | $Htmldir =~ s#/\z##; |
| 291 | |
| 292 | if ( $Htmlroot eq '' |
| 293 | && defined( $Htmldir ) |
| 294 | && $Htmldir ne '' |
| 295 | && substr( $Htmlfile, 0, length( $Htmldir ) ) eq $Htmldir |
| 296 | ) { |
| 297 | # Set the 'base' url for this file, so that we can use it |
| 298 | # as the location from which to calculate relative links |
| 299 | # to other files. If this is '', then absolute links will |
| 300 | # be used throughout. |
| 301 | #$Htmlfileurl = "$Htmldir/" . substr( $Htmlfile, length( $Htmldir ) + 1); |
| 302 | # Is the above not just "$Htmlfileurl = $Htmlfile"? |
| 303 | $Htmlfileurl = Pod::Html::_unixify($Htmlfile); |
| 304 | |
| 305 | } |
| 306 | |
| 307 | # load or generate/cache %Pages |
| 308 | unless (get_cache($Dircache, \@Podpath, $Podroot, $Recurse)) { |
| 309 | # generate %Pages |
| 310 | my $pwd = getcwd(); |
| 311 | chdir($Podroot) || |
| 312 | die "$0: error changing to directory $Podroot: $!\n"; |
| 313 | |
| 314 | # find all pod modules/pages in podpath, store in %Pages |
| 315 | # - callback used to remove Podroot and extension from each file |
| 316 | # - laborious to allow '.' in dirnames (e.g., /usr/share/perl/5.14.1) |
| 317 | Pod::Simple::Search->new->inc(0)->verbose($Verbose)->laborious(1) |
| 318 | ->callback(\&_save_page)->recurse($Recurse)->survey(@Podpath); |
| 319 | |
| 320 | chdir($pwd) || die "$0: error changing to directory $pwd: $!\n"; |
| 321 | |
| 322 | # cache the directory list for later use |
| 323 | warn "caching directories for later use\n" if $Verbose; |
| 324 | open my $cache, '>', $Dircache |
| 325 | or die "$0: error open $Dircache for writing: $!\n"; |
| 326 | |
| 327 | print $cache join(":", @Podpath) . "\n$Podroot\n"; |
| 328 | foreach my $key (keys %Pages) { |
| 329 | print $cache "$key $Pages{$key}\n"; |
| 330 | } |
| 331 | |
| 332 | close $cache or die "error closing $Dircache: $!"; |
| 333 | } |
| 334 | |
| 335 | # set options for the parser |
| 336 | my $parser = Pod::Simple::XHTML::LocalPodLinks->new(); |
| 337 | $parser->anchor_items(1); # the old Pod::Html always did |
| 338 | $parser->backlink($Backlink); # linkify =head1 directives |
| 339 | $parser->htmldir($Htmldir); |
| 340 | $parser->htmlfileurl($Htmlfileurl); |
| 341 | $parser->htmlroot($Htmlroot); |
| 342 | $parser->index($Doindex); |
| 343 | $parser->no_errata_section(!$Poderrors); # note the inverse |
| 344 | $parser->output_string(\my $output); # written to file later |
| 345 | $parser->pages(\%Pages); |
| 346 | $parser->quiet($Quiet); |
| 347 | $parser->verbose($Verbose); |
| 348 | |
| 349 | # XXX: implement default title generator in pod::simple::xhtml |
| 350 | # copy the way the old Pod::Html did it |
| 351 | $Title = html_escape($Title); |
| 352 | |
| 353 | # We need to add this ourselves because we use our own header, not |
| 354 | # ::XHTML's header. We need to set $parser->backlink to linkify |
| 355 | # the =head1 directives |
| 356 | my $bodyid = $Backlink ? ' id="_podtop_"' : ''; |
| 357 | |
| 358 | my $csslink = ''; |
| 359 | my $bodystyle = ' style="background-color: white"'; |
| 360 | my $tdstyle = ' style="background-color: #cccccc"'; |
| 361 | |
| 362 | if ($Css) { |
| 363 | $csslink = qq(\n<link rel="stylesheet" href="$Css" type="text/css" />); |
| 364 | $csslink =~ s,\\,/,g; |
| 365 | $csslink =~ s,(/.):,$1|,; |
| 366 | $bodystyle = ''; |
| 367 | $tdstyle= ''; |
| 368 | } |
| 369 | |
| 370 | # header/footer block |
| 371 | my $block = $Header ? <<END_OF_BLOCK : ''; |
| 372 | <table border="0" width="100%" cellspacing="0" cellpadding="3"> |
| 373 | <tr><td class="_podblock_"$tdstyle valign="middle"> |
| 374 | <big><strong><span class="_podblock_"> $Title</span></strong></big> |
| 375 | </td></tr> |
| 376 | </table> |
| 377 | END_OF_BLOCK |
| 378 | |
| 379 | # create own header/footer because of --header |
| 380 | $parser->html_header(<<"HTMLHEAD"); |
| 381 | <?xml version="1.0" ?> |
| 382 | <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd"> |
| 383 | <html xmlns="http://www.w3.org/1999/xhtml"> |
| 384 | <head> |
| 385 | <title>$Title</title>$csslink |
| 386 | <meta http-equiv="content-type" content="text/html; charset=utf-8" /> |
| 387 | <link rev="made" href="mailto:$Config{perladmin}" /> |
| 388 | </head> |
| 389 | |
| 390 | <body$bodyid$bodystyle> |
| 391 | $block |
| 392 | HTMLHEAD |
| 393 | |
| 394 | $parser->html_footer(<<"HTMLFOOT"); |
| 395 | $block |
| 396 | </body> |
| 397 | |
| 398 | </html> |
| 399 | HTMLFOOT |
| 400 | |
| 401 | my $input; |
| 402 | unless (@ARGV && $ARGV[0]) { |
| 403 | if ($Podfile and $Podfile ne '-') { |
| 404 | $input = $Podfile; |
| 405 | } else { |
| 406 | $input = '-'; # XXX: make a test case for this |
| 407 | } |
| 408 | } else { |
| 409 | $Podfile = $ARGV[0]; |
| 410 | $input = *ARGV; |
| 411 | } |
| 412 | |
| 413 | warn "Converting input file $Podfile\n" if $Verbose; |
| 414 | $parser->parse_file($input); |
| 415 | |
| 416 | # Write output to file |
| 417 | $Htmlfile = "-" unless $Htmlfile; # stdout |
| 418 | my $fhout; |
| 419 | if($Htmlfile and $Htmlfile ne '-') { |
| 420 | open $fhout, ">", $Htmlfile |
| 421 | or die "$0: cannot open $Htmlfile file for output: $!\n"; |
| 422 | } else { |
| 423 | open $fhout, ">-"; |
| 424 | } |
| 425 | print $fhout $output; |
| 426 | close $fhout or die "Failed to close $Htmlfile: $!"; |
| 427 | } |
| 428 | |
| 429 | ############################################################################## |
| 430 | |
| 431 | sub usage { |
| 432 | my $podfile = shift; |
| 433 | warn "$0: $podfile: @_\n" if @_; |
| 434 | die <<END_OF_USAGE; |
| 435 | Usage: $0 --help --htmlroot=<name> --infile=<name> --outfile=<name> |
| 436 | --podpath=<name>:...:<name> --podroot=<name> --cachedir=<name> |
| 437 | --recurse --verbose --index --norecurse --noindex |
| 438 | |
| 439 | --[no]backlink - turn =head1 directives into links pointing to the top of |
| 440 | the page (off by default). |
| 441 | --cachedir - directory for the directory cache files. |
| 442 | --css - stylesheet URL |
| 443 | --flush - flushes the directory cache. |
| 444 | --[no]header - produce block header/footer (default is no headers). |
| 445 | --help - prints this message. |
| 446 | --htmldir - directory for resulting HTML files. |
| 447 | --htmlroot - http-server base directory from which all relative paths |
| 448 | in podpath stem (default is /). |
| 449 | --[no]index - generate an index at the top of the resulting html |
| 450 | (default behaviour). |
| 451 | --infile - filename for the pod to convert (input taken from stdin |
| 452 | by default). |
| 453 | --outfile - filename for the resulting html file (output sent to |
| 454 | stdout by default). |
| 455 | --[no]poderrors - include a POD ERRORS section in the output if there were |
| 456 | any POD errors in the input (default behavior). |
| 457 | --podpath - colon-separated list of directories containing library |
| 458 | pods (empty by default). |
| 459 | --podroot - filesystem base directory from which all relative paths |
| 460 | in podpath stem (default is .). |
| 461 | --[no]quiet - suppress some benign warning messages (default is off). |
| 462 | --[no]recurse - recurse on those subdirectories listed in podpath |
| 463 | (default behaviour). |
| 464 | --title - title that will appear in resulting html file. |
| 465 | --[no]verbose - self-explanatory (off by default). |
| 466 | |
| 467 | END_OF_USAGE |
| 468 | |
| 469 | } |
| 470 | |
| 471 | sub parse_command_line { |
| 472 | my ($opt_backlink,$opt_cachedir,$opt_css,$opt_flush,$opt_header, |
| 473 | $opt_help,$opt_htmldir,$opt_htmlroot,$opt_index,$opt_infile, |
| 474 | $opt_outfile,$opt_poderrors,$opt_podpath,$opt_podroot, |
| 475 | $opt_quiet,$opt_recurse,$opt_title,$opt_verbose); |
| 476 | |
| 477 | unshift @ARGV, split ' ', $Config{pod2html} if $Config{pod2html}; |
| 478 | my $result = GetOptions( |
| 479 | 'backlink!' => \$opt_backlink, |
| 480 | 'cachedir=s' => \$opt_cachedir, |
| 481 | 'css=s' => \$opt_css, |
| 482 | 'flush' => \$opt_flush, |
| 483 | 'help' => \$opt_help, |
| 484 | 'header!' => \$opt_header, |
| 485 | 'htmldir=s' => \$opt_htmldir, |
| 486 | 'htmlroot=s' => \$opt_htmlroot, |
| 487 | 'index!' => \$opt_index, |
| 488 | 'infile=s' => \$opt_infile, |
| 489 | 'outfile=s' => \$opt_outfile, |
| 490 | 'poderrors!' => \$opt_poderrors, |
| 491 | 'podpath=s' => \$opt_podpath, |
| 492 | 'podroot=s' => \$opt_podroot, |
| 493 | 'quiet!' => \$opt_quiet, |
| 494 | 'recurse!' => \$opt_recurse, |
| 495 | 'title=s' => \$opt_title, |
| 496 | 'verbose!' => \$opt_verbose, |
| 497 | ); |
| 498 | usage("-", "invalid parameters") if not $result; |
| 499 | |
| 500 | usage("-") if defined $opt_help; # see if the user asked for help |
| 501 | $opt_help = ""; # just to make -w shut-up. |
| 502 | |
| 503 | @Podpath = split(":", $opt_podpath) if defined $opt_podpath; |
| 504 | |
| 505 | $Backlink = $opt_backlink if defined $opt_backlink; |
| 506 | $Cachedir = _unixify($opt_cachedir) if defined $opt_cachedir; |
| 507 | $Css = $opt_css if defined $opt_css; |
| 508 | $Header = $opt_header if defined $opt_header; |
| 509 | $Htmldir = _unixify($opt_htmldir) if defined $opt_htmldir; |
| 510 | $Htmlroot = _unixify($opt_htmlroot) if defined $opt_htmlroot; |
| 511 | $Doindex = $opt_index if defined $opt_index; |
| 512 | $Podfile = _unixify($opt_infile) if defined $opt_infile; |
| 513 | $Htmlfile = _unixify($opt_outfile) if defined $opt_outfile; |
| 514 | $Poderrors = $opt_poderrors if defined $opt_poderrors; |
| 515 | $Podroot = _unixify($opt_podroot) if defined $opt_podroot; |
| 516 | $Quiet = $opt_quiet if defined $opt_quiet; |
| 517 | $Recurse = $opt_recurse if defined $opt_recurse; |
| 518 | $Title = $opt_title if defined $opt_title; |
| 519 | $Verbose = $opt_verbose if defined $opt_verbose; |
| 520 | |
| 521 | warn "Flushing directory caches\n" |
| 522 | if $opt_verbose && defined $opt_flush; |
| 523 | $Dircache = "$Cachedir/pod2htmd.tmp"; |
| 524 | if (defined $opt_flush) { |
| 525 | 1 while unlink($Dircache); |
| 526 | } |
| 527 | } |
| 528 | |
| 529 | my $Saved_Cache_Key; |
| 530 | |
| 531 | sub get_cache { |
| 532 | my($dircache, $podpath, $podroot, $recurse) = @_; |
| 533 | my @cache_key_args = @_; |
| 534 | |
| 535 | # A first-level cache: |
| 536 | # Don't bother reading the cache files if they still apply |
| 537 | # and haven't changed since we last read them. |
| 538 | |
| 539 | my $this_cache_key = cache_key(@cache_key_args); |
| 540 | return 1 if $Saved_Cache_Key and $this_cache_key eq $Saved_Cache_Key; |
| 541 | $Saved_Cache_Key = $this_cache_key; |
| 542 | |
| 543 | # load the cache of %Pages if possible. $tests will be |
| 544 | # non-zero if successful. |
| 545 | my $tests = 0; |
| 546 | if (-f $dircache) { |
| 547 | warn "scanning for directory cache\n" if $Verbose; |
| 548 | $tests = load_cache($dircache, $podpath, $podroot); |
| 549 | } |
| 550 | |
| 551 | return $tests; |
| 552 | } |
| 553 | |
| 554 | sub cache_key { |
| 555 | my($dircache, $podpath, $podroot, $recurse) = @_; |
| 556 | return join('!',$dircache,$recurse,@$podpath,$podroot,stat($dircache)); |
| 557 | } |
| 558 | |
| 559 | # |
| 560 | # load_cache - tries to find if the cache stored in $dircache is a valid |
| 561 | # cache of %Pages. if so, it loads them and returns a non-zero value. |
| 562 | # |
| 563 | sub load_cache { |
| 564 | my($dircache, $podpath, $podroot) = @_; |
| 565 | my $tests = 0; |
| 566 | local $_; |
| 567 | |
| 568 | warn "scanning for directory cache\n" if $Verbose; |
| 569 | open(my $cachefh, '<', $dircache) || |
| 570 | die "$0: error opening $dircache for reading: $!\n"; |
| 571 | $/ = "\n"; |
| 572 | |
| 573 | # is it the same podpath? |
| 574 | $_ = <$cachefh>; |
| 575 | chomp($_); |
| 576 | $tests++ if (join(":", @$podpath) eq $_); |
| 577 | |
| 578 | # is it the same podroot? |
| 579 | $_ = <$cachefh>; |
| 580 | chomp($_); |
| 581 | $tests++ if ($podroot eq $_); |
| 582 | |
| 583 | # load the cache if its good |
| 584 | if ($tests != 2) { |
| 585 | close($cachefh); |
| 586 | return 0; |
| 587 | } |
| 588 | |
| 589 | warn "loading directory cache\n" if $Verbose; |
| 590 | while (<$cachefh>) { |
| 591 | /(.*?) (.*)$/; |
| 592 | $Pages{$1} = $2; |
| 593 | } |
| 594 | |
| 595 | close($cachefh); |
| 596 | return 1; |
| 597 | } |
| 598 | |
| 599 | |
| 600 | # |
| 601 | # html_escape: make text safe for HTML |
| 602 | # |
| 603 | sub html_escape { |
| 604 | my $rest = $_[0]; |
| 605 | $rest =~ s/&/&/g; |
| 606 | $rest =~ s/</</g; |
| 607 | $rest =~ s/>/>/g; |
| 608 | $rest =~ s/"/"/g; |
| 609 | # ' is only in XHTML, not HTML4. Be conservative |
| 610 | #$rest =~ s/'/'/g; |
| 611 | return $rest; |
| 612 | } |
| 613 | |
| 614 | # |
| 615 | # htmlify - converts a pod section specification to a suitable section |
| 616 | # specification for HTML. Note that we keep spaces and special characters |
| 617 | # except ", ? (Netscape problem) and the hyphen (writer's problem...). |
| 618 | # |
| 619 | sub htmlify { |
| 620 | my( $heading) = @_; |
| 621 | $heading =~ s/(\s+)/ /g; |
| 622 | $heading =~ s/\s+\Z//; |
| 623 | $heading =~ s/\A\s+//; |
| 624 | # The hyphen is a disgrace to the English language. |
| 625 | # $heading =~ s/[-"?]//g; |
| 626 | $heading =~ s/["?]//g; |
| 627 | $heading = lc( $heading ); |
| 628 | return $heading; |
| 629 | } |
| 630 | |
| 631 | # |
| 632 | # similar to htmlify, but turns non-alphanumerics into underscores |
| 633 | # |
| 634 | sub anchorify { |
| 635 | my ($anchor) = @_; |
| 636 | $anchor = htmlify($anchor); |
| 637 | $anchor =~ s/\W/_/g; |
| 638 | return $anchor; |
| 639 | } |
| 640 | |
| 641 | # |
| 642 | # store POD files in %Pages |
| 643 | # |
| 644 | sub _save_page { |
| 645 | my ($modspec, $modname) = @_; |
| 646 | |
| 647 | # Remove Podroot from path |
| 648 | $modspec = File::Spec->abs2rel($modspec, $Podroot); |
| 649 | |
| 650 | # Convert path to unix style path |
| 651 | $modspec = Pod::Html::_unixify($modspec); |
| 652 | |
| 653 | my ($file, $dir) = fileparse($modspec, qr/\.[^.]*/); # strip .ext |
| 654 | $Pages{$modname} = $dir.$file; |
| 655 | } |
| 656 | |
| 657 | sub _unixify { |
| 658 | my $full_path = shift; |
| 659 | return '' unless $full_path; |
| 660 | |
| 661 | return File::Spec::Unix->catfile( # change \s to /s and such |
| 662 | File::Spec->splitdir($full_path)); |
| 663 | } |
| 664 | |
| 665 | package Pod::Simple::XHTML::LocalPodLinks; |
| 666 | use strict; |
| 667 | use warnings; |
| 668 | use base 'Pod::Simple::XHTML'; |
| 669 | |
| 670 | use File::Spec; |
| 671 | use File::Spec::Unix; |
| 672 | |
| 673 | __PACKAGE__->_accessorize( |
| 674 | 'htmldir', |
| 675 | 'htmlfileurl', |
| 676 | 'htmlroot', |
| 677 | 'pages', # Page name => relative/path/to/page from root POD dir |
| 678 | 'quiet', |
| 679 | 'verbose', |
| 680 | ); |
| 681 | |
| 682 | sub resolve_pod_page_link { |
| 683 | my ($self, $to, $section) = @_; |
| 684 | |
| 685 | return undef unless defined $to || defined $section; |
| 686 | if (defined $section) { |
| 687 | $section = '#' . $self->idify($section, 1); |
| 688 | return $section unless defined $to; |
| 689 | } else { |
| 690 | $section = ''; |
| 691 | } |
| 692 | |
| 693 | my $path; # path to $to according to %Pages |
| 694 | unless (exists $self->pages->{$to}) { |
| 695 | # Try to find a POD that ends with $to and use that. |
| 696 | # e.g., given L<XHTML>, if there is no $Podpath/XHTML in %Pages, |
| 697 | # look for $Podpath/*/XHTML in %Pages, with * being any path, |
| 698 | # as a substitute (e.g., $Podpath/Pod/Simple/XHTML) |
| 699 | my @matches; |
| 700 | foreach my $modname (keys %{$self->pages}) { |
| 701 | push @matches, $modname if $modname =~ /::\Q$to\E\z/; |
| 702 | } |
| 703 | |
| 704 | if ($#matches == -1) { |
| 705 | warn "Cannot find \"$to\" in podpath: " . |
| 706 | "cannot find suitable replacement path, cannot resolve link\n" |
| 707 | unless $self->quiet; |
| 708 | return ''; |
| 709 | } elsif ($#matches == 0) { |
| 710 | warn "Cannot find \"$to\" in podpath: " . |
| 711 | "using $matches[0] as replacement path to $to\n" |
| 712 | unless $self->quiet; |
| 713 | $path = $self->pages->{$matches[0]}; |
| 714 | } else { |
| 715 | warn "Cannot find \"$to\" in podpath: " . |
| 716 | "more than one possible replacement path to $to, " . |
| 717 | "using $matches[-1]\n" unless $self->quiet; |
| 718 | # Use [-1] so newer (higher numbered) perl PODs are used |
| 719 | $path = $self->pages->{$matches[-1]}; |
| 720 | } |
| 721 | } else { |
| 722 | $path = $self->pages->{$to}; |
| 723 | } |
| 724 | |
| 725 | my $url = File::Spec::Unix->catfile(Pod::Html::_unixify($self->htmlroot), |
| 726 | $path); |
| 727 | |
| 728 | if ($self->htmlfileurl ne '') { |
| 729 | # then $self->htmlroot eq '' (by definition of htmlfileurl) so |
| 730 | # $self->htmldir needs to be prepended to link to get the absolute path |
| 731 | # that will be relativized |
| 732 | $url = relativize_url( |
| 733 | File::Spec::Unix->catdir(Pod::Html::_unixify($self->htmldir), $url), |
| 734 | $self->htmlfileurl # already unixified |
| 735 | ); |
| 736 | } |
| 737 | |
| 738 | return $url . ".html$section"; |
| 739 | } |
| 740 | |
| 741 | # |
| 742 | # relativize_url - convert an absolute URL to one relative to a base URL. |
| 743 | # Assumes both end in a filename. |
| 744 | # |
| 745 | sub relativize_url { |
| 746 | my ($dest, $source) = @_; |
| 747 | |
| 748 | # Remove each file from its path |
| 749 | my ($dest_volume, $dest_directory, $dest_file) = |
| 750 | File::Spec::Unix->splitpath( $dest ); |
| 751 | $dest = File::Spec::Unix->catpath( $dest_volume, $dest_directory, '' ); |
| 752 | |
| 753 | my ($source_volume, $source_directory, $source_file) = |
| 754 | File::Spec::Unix->splitpath( $source ); |
| 755 | $source = File::Spec::Unix->catpath( $source_volume, $source_directory, '' ); |
| 756 | |
| 757 | my $rel_path = ''; |
| 758 | if ($dest ne '') { |
| 759 | $rel_path = File::Spec::Unix->abs2rel( $dest, $source ); |
| 760 | } |
| 761 | |
| 762 | if ($rel_path ne '' && substr( $rel_path, -1 ) ne '/') { |
| 763 | $rel_path .= "/$dest_file"; |
| 764 | } else { |
| 765 | $rel_path .= "$dest_file"; |
| 766 | } |
| 767 | |
| 768 | return $rel_path; |
| 769 | } |
| 770 | |
| 771 | 1; |