1package Pod::Html; 2use strict; 3require Exporter; 4 5use vars qw($VERSION @ISA @EXPORT @EXPORT_OK); 6$VERSION = 1.21_01; 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 $tdstyle = ' style="background-color: #cccccc; color: #000"'; 373 374 if ($Css) { 375 $csslink = qq(\n<link rel="stylesheet" href="$Css" type="text/css" />); 376 $csslink =~ s,\\,/,g; 377 $csslink =~ s,(/.):,$1|,; 378 $tdstyle= ''; 379 } 380 381 # header/footer block 382 my $block = $Header ? <<END_OF_BLOCK : ''; 383<table border="0" width="100%" cellspacing="0" cellpadding="3"> 384<tr><td class="_podblock_"$tdstyle valign="middle"> 385<big><strong><span class="_podblock_"> $Title</span></strong></big> 386</td></tr> 387</table> 388END_OF_BLOCK 389 390 # create own header/footer because of --header 391 $parser->html_header(<<"HTMLHEAD"); 392<?xml version="1.0" ?> 393<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd"> 394<html xmlns="http://www.w3.org/1999/xhtml"> 395<head> 396<title>$Title</title>$csslink 397<meta http-equiv="content-type" content="text/html; charset=utf-8" /> 398<link rev="made" href="mailto:$Config{perladmin}" /> 399</head> 400 401<body$bodyid> 402$block 403HTMLHEAD 404 405 $parser->html_footer(<<"HTMLFOOT"); 406$block 407</body> 408 409</html> 410HTMLFOOT 411 412 my $input; 413 unless (@ARGV && $ARGV[0]) { 414 if ($Podfile and $Podfile ne '-') { 415 $input = $Podfile; 416 } else { 417 $input = '-'; # XXX: make a test case for this 418 } 419 } else { 420 $Podfile = $ARGV[0]; 421 $input = *ARGV; 422 } 423 424 warn "Converting input file $Podfile\n" if $Verbose; 425 $parser->parse_file($input); 426 427 # Write output to file 428 $Htmlfile = "-" unless $Htmlfile; # stdout 429 my $fhout; 430 if($Htmlfile and $Htmlfile ne '-') { 431 open $fhout, ">", $Htmlfile 432 or die "$0: cannot open $Htmlfile file for output: $!\n"; 433 } else { 434 open $fhout, ">-"; 435 } 436 binmode $fhout, ":utf8"; 437 print $fhout $output; 438 close $fhout or die "Failed to close $Htmlfile: $!"; 439 chmod 0644, $Htmlfile unless $Htmlfile eq '-'; 440} 441 442############################################################################## 443 444sub usage { 445 my $podfile = shift; 446 warn "$0: $podfile: @_\n" if @_; 447 die <<END_OF_USAGE; 448Usage: $0 --help --htmldir=<name> --htmlroot=<URL> 449 --infile=<name> --outfile=<name> 450 --podpath=<name>:...:<name> --podroot=<name> 451 --cachedir=<name> --flush --recurse --norecurse 452 --quiet --noquiet --verbose --noverbose 453 --index --noindex --backlink --nobacklink 454 --header --noheader --poderrors --nopoderrors 455 --css=<URL> --title=<name> 456 457 --[no]backlink - turn =head1 directives into links pointing to the top of 458 the page (off by default). 459 --cachedir - directory for the directory cache files. 460 --css - stylesheet URL 461 --flush - flushes the directory cache. 462 --[no]header - produce block header/footer (default is no headers). 463 --help - prints this message. 464 --htmldir - directory for resulting HTML files. 465 --htmlroot - http-server base directory from which all relative paths 466 in podpath stem (default is /). 467 --[no]index - generate an index at the top of the resulting html 468 (default behaviour). 469 --infile - filename for the pod to convert (input taken from stdin 470 by default). 471 --outfile - filename for the resulting html file (output sent to 472 stdout by default). 473 --[no]poderrors - include a POD ERRORS section in the output if there were 474 any POD errors in the input (default behavior). 475 --podpath - colon-separated list of directories containing library 476 pods (empty by default). 477 --podroot - filesystem base directory from which all relative paths 478 in podpath stem (default is .). 479 --[no]quiet - suppress some benign warning messages (default is off). 480 --[no]recurse - recurse on those subdirectories listed in podpath 481 (default behaviour). 482 --title - title that will appear in resulting html file. 483 --[no]verbose - self-explanatory (off by default). 484 485END_OF_USAGE 486 487} 488 489sub parse_command_line { 490 my ($opt_backlink,$opt_cachedir,$opt_css,$opt_flush,$opt_header, 491 $opt_help,$opt_htmldir,$opt_htmlroot,$opt_index,$opt_infile, 492 $opt_outfile,$opt_poderrors,$opt_podpath,$opt_podroot, 493 $opt_quiet,$opt_recurse,$opt_title,$opt_verbose,$opt_libpods); 494 495 unshift @ARGV, split ' ', $Config{pod2html} if $Config{pod2html}; 496 my $result = GetOptions( 497 'backlink!' => \$opt_backlink, 498 'cachedir=s' => \$opt_cachedir, 499 'css=s' => \$opt_css, 500 'flush' => \$opt_flush, 501 'help' => \$opt_help, 502 'header!' => \$opt_header, 503 'htmldir=s' => \$opt_htmldir, 504 'htmlroot=s' => \$opt_htmlroot, 505 'index!' => \$opt_index, 506 'infile=s' => \$opt_infile, 507 'libpods=s' => \$opt_libpods, # deprecated 508 'outfile=s' => \$opt_outfile, 509 'poderrors!' => \$opt_poderrors, 510 'podpath=s' => \$opt_podpath, 511 'podroot=s' => \$opt_podroot, 512 'quiet!' => \$opt_quiet, 513 'recurse!' => \$opt_recurse, 514 'title=s' => \$opt_title, 515 'verbose!' => \$opt_verbose, 516 ); 517 usage("-", "invalid parameters") if not $result; 518 519 usage("-") if defined $opt_help; # see if the user asked for help 520 $opt_help = ""; # just to make -w shut-up. 521 522 @Podpath = split(":", $opt_podpath) if defined $opt_podpath; 523 warn "--libpods is no longer supported" if defined $opt_libpods; 524 525 $Backlink = $opt_backlink if defined $opt_backlink; 526 $Cachedir = _unixify($opt_cachedir) if defined $opt_cachedir; 527 $Css = $opt_css if defined $opt_css; 528 $Header = $opt_header if defined $opt_header; 529 $Htmldir = _unixify($opt_htmldir) if defined $opt_htmldir; 530 $Htmlroot = _unixify($opt_htmlroot) if defined $opt_htmlroot; 531 $Doindex = $opt_index if defined $opt_index; 532 $Podfile = _unixify($opt_infile) if defined $opt_infile; 533 $Htmlfile = _unixify($opt_outfile) if defined $opt_outfile; 534 $Poderrors = $opt_poderrors if defined $opt_poderrors; 535 $Podroot = _unixify($opt_podroot) if defined $opt_podroot; 536 $Quiet = $opt_quiet if defined $opt_quiet; 537 $Recurse = $opt_recurse if defined $opt_recurse; 538 $Title = $opt_title if defined $opt_title; 539 $Verbose = $opt_verbose if defined $opt_verbose; 540 541 warn "Flushing directory caches\n" 542 if $opt_verbose && defined $opt_flush; 543 $Dircache = "$Cachedir/pod2htmd.tmp"; 544 if (defined $opt_flush) { 545 1 while unlink($Dircache); 546 } 547} 548 549my $Saved_Cache_Key; 550 551sub get_cache { 552 my($dircache, $podpath, $podroot, $recurse) = @_; 553 my @cache_key_args = @_; 554 555 # A first-level cache: 556 # Don't bother reading the cache files if they still apply 557 # and haven't changed since we last read them. 558 559 my $this_cache_key = cache_key(@cache_key_args); 560 return 1 if $Saved_Cache_Key and $this_cache_key eq $Saved_Cache_Key; 561 $Saved_Cache_Key = $this_cache_key; 562 563 # load the cache of %Pages if possible. $tests will be 564 # non-zero if successful. 565 my $tests = 0; 566 if (-f $dircache) { 567 warn "scanning for directory cache\n" if $Verbose; 568 $tests = load_cache($dircache, $podpath, $podroot); 569 } 570 571 return $tests; 572} 573 574sub cache_key { 575 my($dircache, $podpath, $podroot, $recurse) = @_; 576 return join('!',$dircache,$recurse,@$podpath,$podroot,stat($dircache)); 577} 578 579# 580# load_cache - tries to find if the cache stored in $dircache is a valid 581# cache of %Pages. if so, it loads them and returns a non-zero value. 582# 583sub load_cache { 584 my($dircache, $podpath, $podroot) = @_; 585 my $tests = 0; 586 local $_; 587 588 warn "scanning for directory cache\n" if $Verbose; 589 open(my $cachefh, '<', $dircache) || 590 die "$0: error opening $dircache for reading: $!\n"; 591 $/ = "\n"; 592 593 # is it the same podpath? 594 $_ = <$cachefh>; 595 chomp($_); 596 $tests++ if (join(":", @$podpath) eq $_); 597 598 # is it the same podroot? 599 $_ = <$cachefh>; 600 chomp($_); 601 $tests++ if ($podroot eq $_); 602 603 # load the cache if its good 604 if ($tests != 2) { 605 close($cachefh); 606 return 0; 607 } 608 609 warn "loading directory cache\n" if $Verbose; 610 while (<$cachefh>) { 611 /(.*?) (.*)$/; 612 $Pages{$1} = $2; 613 } 614 615 close($cachefh); 616 return 1; 617} 618 619 620# 621# html_escape: make text safe for HTML 622# 623sub html_escape { 624 my $rest = $_[0]; 625 $rest =~ s/&/&/g; 626 $rest =~ s/</</g; 627 $rest =~ s/>/>/g; 628 $rest =~ s/"/"/g; 629 # ' is only in XHTML, not HTML4. Be conservative 630 #$rest =~ s/'/'/g; 631 return $rest; 632} 633 634# 635# htmlify - converts a pod section specification to a suitable section 636# specification for HTML. Note that we keep spaces and special characters 637# except ", ? (Netscape problem) and the hyphen (writer's problem...). 638# 639sub htmlify { 640 my( $heading) = @_; 641 $heading =~ s/(\s+)/ /g; 642 $heading =~ s/\s+\Z//; 643 $heading =~ s/\A\s+//; 644 # The hyphen is a disgrace to the English language. 645 # $heading =~ s/[-"?]//g; 646 $heading =~ s/["?]//g; 647 $heading = lc( $heading ); 648 return $heading; 649} 650 651# 652# similar to htmlify, but turns non-alphanumerics into underscores 653# 654sub anchorify { 655 my ($anchor) = @_; 656 $anchor = htmlify($anchor); 657 $anchor =~ s/\W/_/g; 658 return $anchor; 659} 660 661# 662# store POD files in %Pages 663# 664sub _save_page { 665 my ($modspec, $modname) = @_; 666 667 # Remove Podroot from path 668 $modspec = $Podroot eq File::Spec->curdir 669 ? File::Spec->abs2rel($modspec) 670 : File::Spec->abs2rel($modspec, 671 File::Spec->canonpath($Podroot)); 672 673 # Convert path to unix style path 674 $modspec = Pod::Html::_unixify($modspec); 675 676 my ($file, $dir) = fileparse($modspec, qr/\.[^.]*/); # strip .ext 677 $Pages{$modname} = $dir.$file; 678} 679 680sub _unixify { 681 my $full_path = shift; 682 return '' unless $full_path; 683 return $full_path if $full_path eq '/'; 684 685 my ($vol, $dirs, $file) = File::Spec->splitpath($full_path); 686 my @dirs = $dirs eq File::Spec->curdir() 687 ? (File::Spec::Unix->curdir()) 688 : File::Spec->splitdir($dirs); 689 if (defined($vol) && $vol) { 690 $vol =~ s/:$// if $^O eq 'VMS'; 691 $vol = uc $vol if $^O eq 'MSWin32'; 692 693 if( $dirs[0] ) { 694 unshift @dirs, $vol; 695 } 696 else { 697 $dirs[0] = $vol; 698 } 699 } 700 unshift @dirs, '' if File::Spec->file_name_is_absolute($full_path); 701 return $file unless scalar(@dirs); 702 $full_path = File::Spec::Unix->catfile(File::Spec::Unix->catdir(@dirs), 703 $file); 704 $full_path =~ s|^\/|| if $^O eq 'MSWin32'; # C:/foo works, /C:/foo doesn't 705 $full_path =~ s/\^\././g if $^O eq 'VMS'; # unescape dots 706 return $full_path; 707} 708 709package Pod::Simple::XHTML::LocalPodLinks; 710use strict; 711use warnings; 712use parent 'Pod::Simple::XHTML'; 713 714use File::Spec; 715use File::Spec::Unix; 716 717__PACKAGE__->_accessorize( 718 'htmldir', 719 'htmlfileurl', 720 'htmlroot', 721 'pages', # Page name => relative/path/to/page from root POD dir 722 'quiet', 723 'verbose', 724); 725 726sub resolve_pod_page_link { 727 my ($self, $to, $section) = @_; 728 729 return undef unless defined $to || defined $section; 730 if (defined $section) { 731 $section = '#' . $self->idify($section, 1); 732 return $section unless defined $to; 733 } else { 734 $section = ''; 735 } 736 737 my $path; # path to $to according to %Pages 738 unless (exists $self->pages->{$to}) { 739 # Try to find a POD that ends with $to and use that. 740 # e.g., given L<XHTML>, if there is no $Podpath/XHTML in %Pages, 741 # look for $Podpath/*/XHTML in %Pages, with * being any path, 742 # as a substitute (e.g., $Podpath/Pod/Simple/XHTML) 743 my @matches; 744 foreach my $modname (keys %{$self->pages}) { 745 push @matches, $modname if $modname =~ /::\Q$to\E\z/; 746 } 747 748 if ($#matches == -1) { 749 warn "Cannot find \"$to\" in podpath: " . 750 "cannot find suitable replacement path, cannot resolve link\n" 751 unless $self->quiet; 752 return ''; 753 } elsif ($#matches == 0) { 754 warn "Cannot find \"$to\" in podpath: " . 755 "using $matches[0] as replacement path to $to\n" 756 unless $self->quiet; 757 $path = $self->pages->{$matches[0]}; 758 } else { 759 warn "Cannot find \"$to\" in podpath: " . 760 "more than one possible replacement path to $to, " . 761 "using $matches[-1]\n" unless $self->quiet; 762 # Use [-1] so newer (higher numbered) perl PODs are used 763 $path = $self->pages->{$matches[-1]}; 764 } 765 } else { 766 $path = $self->pages->{$to}; 767 } 768 769 my $url = File::Spec::Unix->catfile(Pod::Html::_unixify($self->htmlroot), 770 $path); 771 772 if ($self->htmlfileurl ne '') { 773 # then $self->htmlroot eq '' (by definition of htmlfileurl) so 774 # $self->htmldir needs to be prepended to link to get the absolute path 775 # that will be relativized 776 $url = relativize_url( 777 File::Spec::Unix->catdir(Pod::Html::_unixify($self->htmldir), $url), 778 $self->htmlfileurl # already unixified 779 ); 780 } 781 782 return $url . ".html$section"; 783} 784 785# 786# relativize_url - convert an absolute URL to one relative to a base URL. 787# Assumes both end in a filename. 788# 789sub relativize_url { 790 my ($dest, $source) = @_; 791 792 # Remove each file from its path 793 my ($dest_volume, $dest_directory, $dest_file) = 794 File::Spec::Unix->splitpath( $dest ); 795 $dest = File::Spec::Unix->catpath( $dest_volume, $dest_directory, '' ); 796 797 my ($source_volume, $source_directory, $source_file) = 798 File::Spec::Unix->splitpath( $source ); 799 $source = File::Spec::Unix->catpath( $source_volume, $source_directory, '' ); 800 801 my $rel_path = ''; 802 if ($dest ne '') { 803 $rel_path = File::Spec::Unix->abs2rel( $dest, $source ); 804 } 805 806 if ($rel_path ne '' && substr( $rel_path, -1 ) ne '/') { 807 $rel_path .= "/$dest_file"; 808 } else { 809 $rel_path .= "$dest_file"; 810 } 811 812 return $rel_path; 813} 814 8151; 816