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