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