1package Pod::Html; 2use strict; 3require Exporter; 4 5our $VERSION = 1.25; 6our @ISA = qw(Exporter); 7our @EXPORT = qw(pod2html htmlify); 8our @EXPORT_OK = qw(anchorify relativize_url); 9 10use Carp; 11use Config; 12use Cwd; 13use File::Basename; 14use File::Spec; 15use File::Spec::Unix; 16use Getopt::Long; 17use Pod::Simple::Search; 18use Pod::Simple::SimpleTree (); 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 226# This sub duplicates the guts of Pod::Simple::FromTree. We could have 227# used that module, except that it would have been a non-core dependency. 228sub feed_tree_to_parser { 229 my($parser, $tree) = @_; 230 if(ref($tree) eq "") { 231 $parser->_handle_text($tree); 232 } elsif(!($tree->[0] eq "X" && $parser->nix_X_codes)) { 233 $parser->_handle_element_start($tree->[0], $tree->[1]); 234 feed_tree_to_parser($parser, $_) foreach @{$tree}[2..$#$tree]; 235 $parser->_handle_element_end($tree->[0]); 236 } 237} 238 239my $Cachedir; 240my $Dircache; 241my($Htmlroot, $Htmldir, $Htmlfile, $Htmlfileurl); 242my($Podfile, @Podpath, $Podroot); 243my $Poderrors; 244my $Css; 245 246my $Recurse; 247my $Quiet; 248my $Verbose; 249my $Doindex; 250 251my $Backlink; 252 253my($Title, $Header); 254 255my %Pages = (); # associative array used to find the location 256 # of pages referenced by L<> links. 257 258my $Curdir = File::Spec->curdir; 259 260init_globals(); 261 262sub init_globals { 263 $Cachedir = "."; # The directory to which directory caches 264 # will be written. 265 266 $Dircache = "pod2htmd.tmp"; 267 268 $Htmlroot = "/"; # http-server base directory from which all 269 # relative paths in $podpath stem. 270 $Htmldir = ""; # The directory to which the html pages 271 # will (eventually) be written. 272 $Htmlfile = ""; # write to stdout by default 273 $Htmlfileurl = ""; # The url that other files would use to 274 # refer to this file. This is only used 275 # to make relative urls that point to 276 # other files. 277 278 $Poderrors = 1; 279 $Podfile = ""; # read from stdin by default 280 @Podpath = (); # list of directories containing library pods. 281 $Podroot = $Curdir; # filesystem base directory from which all 282 # relative paths in $podpath stem. 283 $Css = ''; # Cascading style sheet 284 $Recurse = 1; # recurse on subdirectories in $podpath. 285 $Quiet = 0; # not quiet by default 286 $Verbose = 0; # not verbose by default 287 $Doindex = 1; # non-zero if we should generate an index 288 $Backlink = 0; # no backlinks added by default 289 $Header = 0; # produce block header/footer 290 $Title = undef; # title to give the pod(s) 291} 292 293sub pod2html { 294 local(@ARGV) = @_; 295 local $_; 296 297 init_globals(); 298 parse_command_line(); 299 300 # prevent '//' in urls 301 $Htmlroot = "" if $Htmlroot eq "/"; 302 $Htmldir =~ s#/\z##; 303 304 if ( $Htmlroot eq '' 305 && defined( $Htmldir ) 306 && $Htmldir ne '' 307 && substr( $Htmlfile, 0, length( $Htmldir ) ) eq $Htmldir 308 ) { 309 # Set the 'base' url for this file, so that we can use it 310 # as the location from which to calculate relative links 311 # to other files. If this is '', then absolute links will 312 # be used throughout. 313 #$Htmlfileurl = "$Htmldir/" . substr( $Htmlfile, length( $Htmldir ) + 1); 314 # Is the above not just "$Htmlfileurl = $Htmlfile"? 315 $Htmlfileurl = Pod::Html::_unixify($Htmlfile); 316 317 } 318 319 # load or generate/cache %Pages 320 unless (get_cache($Dircache, \@Podpath, $Podroot, $Recurse)) { 321 # generate %Pages 322 my $pwd = getcwd(); 323 chdir($Podroot) || 324 die "$0: error changing to directory $Podroot: $!\n"; 325 326 # find all pod modules/pages in podpath, store in %Pages 327 # - callback used to remove Podroot and extension from each file 328 # - laborious to allow '.' in dirnames (e.g., /usr/share/perl/5.14.1) 329 Pod::Simple::Search->new->inc(0)->verbose($Verbose)->laborious(1) 330 ->callback(\&_save_page)->recurse($Recurse)->survey(@Podpath); 331 332 chdir($pwd) || die "$0: error changing to directory $pwd: $!\n"; 333 334 # cache the directory list for later use 335 warn "caching directories for later use\n" if $Verbose; 336 open my $cache, '>', $Dircache 337 or die "$0: error open $Dircache for writing: $!\n"; 338 339 print $cache join(":", @Podpath) . "\n$Podroot\n"; 340 my $_updirs_only = ($Podroot =~ /\.\./) && !($Podroot =~ /[^\.\\\/]/); 341 foreach my $key (keys %Pages) { 342 if($_updirs_only) { 343 my $_dirlevel = $Podroot; 344 while($_dirlevel =~ /\.\./) { 345 $_dirlevel =~ s/\.\.//; 346 # Assume $Pages{$key} has '/' separators (html dir separators). 347 $Pages{$key} =~ s/^[\w\s\-\.]+\///; 348 } 349 } 350 print $cache "$key $Pages{$key}\n"; 351 } 352 353 close $cache or die "error closing $Dircache: $!"; 354 } 355 356 my $input; 357 unless (@ARGV && $ARGV[0]) { 358 if ($Podfile and $Podfile ne '-') { 359 $input = $Podfile; 360 } else { 361 $input = '-'; # XXX: make a test case for this 362 } 363 } else { 364 $Podfile = $ARGV[0]; 365 $input = *ARGV; 366 } 367 368 # set options for input parser 369 my $parser = Pod::Simple::SimpleTree->new; 370 $parser->codes_in_verbatim(0); 371 $parser->accept_targets(qw(html HTML)); 372 $parser->no_errata_section(!$Poderrors); # note the inverse 373 374 warn "Converting input file $Podfile\n" if $Verbose; 375 my $podtree = $parser->parse_file($input)->root; 376 377 unless(defined $Title) { 378 if($podtree->[0] eq "Document" && ref($podtree->[2]) eq "ARRAY" && 379 $podtree->[2]->[0] eq "head1" && @{$podtree->[2]} == 3 && 380 ref($podtree->[2]->[2]) eq "" && $podtree->[2]->[2] eq "NAME" && 381 ref($podtree->[3]) eq "ARRAY" && $podtree->[3]->[0] eq "Para" && 382 @{$podtree->[3]} >= 3 && 383 !(grep { ref($_) ne "" } 384 @{$podtree->[3]}[2..$#{$podtree->[3]}]) && 385 (@$podtree == 4 || 386 (ref($podtree->[4]) eq "ARRAY" && 387 $podtree->[4]->[0] eq "head1"))) { 388 $Title = join("", @{$podtree->[3]}[2..$#{$podtree->[3]}]); 389 } 390 } 391 392 $Title //= ""; 393 $Title = html_escape($Title); 394 395 # set options for the HTML generator 396 $parser = Pod::Simple::XHTML::LocalPodLinks->new(); 397 $parser->codes_in_verbatim(0); 398 $parser->anchor_items(1); # the old Pod::Html always did 399 $parser->backlink($Backlink); # linkify =head1 directives 400 $parser->force_title($Title); 401 $parser->htmldir($Htmldir); 402 $parser->htmlfileurl($Htmlfileurl); 403 $parser->htmlroot($Htmlroot); 404 $parser->index($Doindex); 405 $parser->output_string(\my $output); # written to file later 406 $parser->pages(\%Pages); 407 $parser->quiet($Quiet); 408 $parser->verbose($Verbose); 409 410 # We need to add this ourselves because we use our own header, not 411 # ::XHTML's header. We need to set $parser->backlink to linkify 412 # the =head1 directives 413 my $bodyid = $Backlink ? ' id="_podtop_"' : ''; 414 415 my $csslink = ''; 416 my $tdstyle = ' style="background-color: #cccccc; color: #000"'; 417 418 if ($Css) { 419 $csslink = qq(\n<link rel="stylesheet" href="$Css" type="text/css" />); 420 $csslink =~ s,\\,/,g; 421 $csslink =~ s,(/.):,$1|,; 422 $tdstyle= ''; 423 } 424 425 # header/footer block 426 my $block = $Header ? <<END_OF_BLOCK : ''; 427<table border="0" width="100%" cellspacing="0" cellpadding="3"> 428<tr><td class="_podblock_"$tdstyle valign="middle"> 429<big><strong><span class="_podblock_"> $Title</span></strong></big> 430</td></tr> 431</table> 432END_OF_BLOCK 433 434 # create own header/footer because of --header 435 $parser->html_header(<<"HTMLHEAD"); 436<?xml version="1.0" ?> 437<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd"> 438<html xmlns="http://www.w3.org/1999/xhtml"> 439<head> 440<title>$Title</title>$csslink 441<meta http-equiv="content-type" content="text/html; charset=utf-8" /> 442<link rev="made" href="mailto:$Config{perladmin}" /> 443</head> 444 445<body$bodyid> 446$block 447HTMLHEAD 448 449 $parser->html_footer(<<"HTMLFOOT"); 450$block 451</body> 452 453</html> 454HTMLFOOT 455 456 feed_tree_to_parser($parser, $podtree); 457 458 # Write output to file 459 $Htmlfile = "-" unless $Htmlfile; # stdout 460 my $fhout; 461 if($Htmlfile and $Htmlfile ne '-') { 462 open $fhout, ">", $Htmlfile 463 or die "$0: cannot open $Htmlfile file for output: $!\n"; 464 } else { 465 open $fhout, ">-"; 466 } 467 binmode $fhout, ":utf8"; 468 print $fhout $output; 469 close $fhout or die "Failed to close $Htmlfile: $!"; 470 chmod 0644, $Htmlfile unless $Htmlfile eq '-'; 471} 472 473############################################################################## 474 475sub usage { 476 my $podfile = shift; 477 warn "$0: $podfile: @_\n" if @_; 478 die <<END_OF_USAGE; 479Usage: $0 --help --htmldir=<name> --htmlroot=<URL> 480 --infile=<name> --outfile=<name> 481 --podpath=<name>:...:<name> --podroot=<name> 482 --cachedir=<name> --flush --recurse --norecurse 483 --quiet --noquiet --verbose --noverbose 484 --index --noindex --backlink --nobacklink 485 --header --noheader --poderrors --nopoderrors 486 --css=<URL> --title=<name> 487 488 --[no]backlink - turn =head1 directives into links pointing to the top of 489 the page (off by default). 490 --cachedir - directory for the directory cache files. 491 --css - stylesheet URL 492 --flush - flushes the directory cache. 493 --[no]header - produce block header/footer (default is no headers). 494 --help - prints this message. 495 --htmldir - directory for resulting HTML files. 496 --htmlroot - http-server base directory from which all relative paths 497 in podpath stem (default is /). 498 --[no]index - generate an index at the top of the resulting html 499 (default behaviour). 500 --infile - filename for the pod to convert (input taken from stdin 501 by default). 502 --outfile - filename for the resulting html file (output sent to 503 stdout by default). 504 --[no]poderrors - include a POD ERRORS section in the output if there were 505 any POD errors in the input (default behavior). 506 --podpath - colon-separated list of directories containing library 507 pods (empty by default). 508 --podroot - filesystem base directory from which all relative paths 509 in podpath stem (default is .). 510 --[no]quiet - suppress some benign warning messages (default is off). 511 --[no]recurse - recurse on those subdirectories listed in podpath 512 (default behaviour). 513 --title - title that will appear in resulting html file. 514 --[no]verbose - self-explanatory (off by default). 515 516END_OF_USAGE 517 518} 519 520sub parse_command_line { 521 my ($opt_backlink,$opt_cachedir,$opt_css,$opt_flush,$opt_header, 522 $opt_help,$opt_htmldir,$opt_htmlroot,$opt_index,$opt_infile, 523 $opt_outfile,$opt_poderrors,$opt_podpath,$opt_podroot, 524 $opt_quiet,$opt_recurse,$opt_title,$opt_verbose); 525 526 unshift @ARGV, split ' ', $Config{pod2html} if $Config{pod2html}; 527 my $result = GetOptions( 528 'backlink!' => \$opt_backlink, 529 'cachedir=s' => \$opt_cachedir, 530 'css=s' => \$opt_css, 531 'flush' => \$opt_flush, 532 'help' => \$opt_help, 533 'header!' => \$opt_header, 534 'htmldir=s' => \$opt_htmldir, 535 'htmlroot=s' => \$opt_htmlroot, 536 'index!' => \$opt_index, 537 'infile=s' => \$opt_infile, 538 'outfile=s' => \$opt_outfile, 539 'poderrors!' => \$opt_poderrors, 540 'podpath=s' => \$opt_podpath, 541 'podroot=s' => \$opt_podroot, 542 'quiet!' => \$opt_quiet, 543 'recurse!' => \$opt_recurse, 544 'title=s' => \$opt_title, 545 'verbose!' => \$opt_verbose, 546 ); 547 usage("-", "invalid parameters") if not $result; 548 549 usage("-") if defined $opt_help; # see if the user asked for help 550 $opt_help = ""; # just to make -w shut-up. 551 552 @Podpath = split(":", $opt_podpath) if defined $opt_podpath; 553 554 $Backlink = $opt_backlink if defined $opt_backlink; 555 $Cachedir = _unixify($opt_cachedir) if defined $opt_cachedir; 556 $Css = $opt_css if defined $opt_css; 557 $Header = $opt_header if defined $opt_header; 558 $Htmldir = _unixify($opt_htmldir) if defined $opt_htmldir; 559 $Htmlroot = _unixify($opt_htmlroot) if defined $opt_htmlroot; 560 $Doindex = $opt_index if defined $opt_index; 561 $Podfile = _unixify($opt_infile) if defined $opt_infile; 562 $Htmlfile = _unixify($opt_outfile) if defined $opt_outfile; 563 $Poderrors = $opt_poderrors if defined $opt_poderrors; 564 $Podroot = _unixify($opt_podroot) if defined $opt_podroot; 565 $Quiet = $opt_quiet if defined $opt_quiet; 566 $Recurse = $opt_recurse if defined $opt_recurse; 567 $Title = $opt_title if defined $opt_title; 568 $Verbose = $opt_verbose if defined $opt_verbose; 569 570 warn "Flushing directory caches\n" 571 if $opt_verbose && defined $opt_flush; 572 $Dircache = "$Cachedir/pod2htmd.tmp"; 573 if (defined $opt_flush) { 574 1 while unlink($Dircache); 575 } 576} 577 578my $Saved_Cache_Key; 579 580sub get_cache { 581 my($dircache, $podpath, $podroot, $recurse) = @_; 582 my @cache_key_args = @_; 583 584 # A first-level cache: 585 # Don't bother reading the cache files if they still apply 586 # and haven't changed since we last read them. 587 588 my $this_cache_key = cache_key(@cache_key_args); 589 return 1 if $Saved_Cache_Key and $this_cache_key eq $Saved_Cache_Key; 590 $Saved_Cache_Key = $this_cache_key; 591 592 # load the cache of %Pages if possible. $tests will be 593 # non-zero if successful. 594 my $tests = 0; 595 if (-f $dircache) { 596 warn "scanning for directory cache\n" if $Verbose; 597 $tests = load_cache($dircache, $podpath, $podroot); 598 } 599 600 return $tests; 601} 602 603sub cache_key { 604 my($dircache, $podpath, $podroot, $recurse) = @_; 605 return join('!',$dircache,$recurse,@$podpath,$podroot,stat($dircache)); 606} 607 608# 609# load_cache - tries to find if the cache stored in $dircache is a valid 610# cache of %Pages. if so, it loads them and returns a non-zero value. 611# 612sub load_cache { 613 my($dircache, $podpath, $podroot) = @_; 614 my $tests = 0; 615 local $_; 616 617 warn "scanning for directory cache\n" if $Verbose; 618 open(my $cachefh, '<', $dircache) || 619 die "$0: error opening $dircache for reading: $!\n"; 620 $/ = "\n"; 621 622 # is it the same podpath? 623 $_ = <$cachefh>; 624 chomp($_); 625 $tests++ if (join(":", @$podpath) eq $_); 626 627 # is it the same podroot? 628 $_ = <$cachefh>; 629 chomp($_); 630 $tests++ if ($podroot eq $_); 631 632 # load the cache if its good 633 if ($tests != 2) { 634 close($cachefh); 635 return 0; 636 } 637 638 warn "loading directory cache\n" if $Verbose; 639 while (<$cachefh>) { 640 /(.*?) (.*)$/; 641 $Pages{$1} = $2; 642 } 643 644 close($cachefh); 645 return 1; 646} 647 648 649# 650# html_escape: make text safe for HTML 651# 652sub html_escape { 653 my $rest = $_[0]; 654 $rest =~ s/&/&/g; 655 $rest =~ s/</</g; 656 $rest =~ s/>/>/g; 657 $rest =~ s/"/"/g; 658 $rest =~ s/([[:^print:]])/sprintf("&#x%x;", ord($1))/aeg; 659 return $rest; 660} 661 662# 663# htmlify - converts a pod section specification to a suitable section 664# specification for HTML. We adopt the mechanism used by the formatter 665# that we use. 666# 667sub htmlify { 668 my( $heading) = @_; 669 return Pod::Simple::XHTML->can("idify")->(undef, $heading, 1); 670} 671 672# 673# similar to htmlify, but turns non-alphanumerics into underscores 674# 675sub anchorify { 676 my ($anchor) = @_; 677 $anchor = htmlify($anchor); 678 $anchor =~ s/\W/_/g; 679 return $anchor; 680} 681 682# 683# store POD files in %Pages 684# 685sub _save_page { 686 my ($modspec, $modname) = @_; 687 688 # Remove Podroot from path 689 $modspec = $Podroot eq File::Spec->curdir 690 ? File::Spec->abs2rel($modspec) 691 : File::Spec->abs2rel($modspec, 692 File::Spec->canonpath($Podroot)); 693 694 # Convert path to unix style path 695 $modspec = Pod::Html::_unixify($modspec); 696 697 my ($file, $dir) = fileparse($modspec, qr/\.[^.]*/); # strip .ext 698 $Pages{$modname} = $dir.$file; 699} 700 701sub _unixify { 702 my $full_path = shift; 703 return '' unless $full_path; 704 return $full_path if $full_path eq '/'; 705 706 my ($vol, $dirs, $file) = File::Spec->splitpath($full_path); 707 my @dirs = $dirs eq File::Spec->curdir() 708 ? (File::Spec::Unix->curdir()) 709 : File::Spec->splitdir($dirs); 710 if (defined($vol) && $vol) { 711 $vol =~ s/:$// if $^O eq 'VMS'; 712 $vol = uc $vol if $^O eq 'MSWin32'; 713 714 if( $dirs[0] ) { 715 unshift @dirs, $vol; 716 } 717 else { 718 $dirs[0] = $vol; 719 } 720 } 721 unshift @dirs, '' if File::Spec->file_name_is_absolute($full_path); 722 return $file unless scalar(@dirs); 723 $full_path = File::Spec::Unix->catfile(File::Spec::Unix->catdir(@dirs), 724 $file); 725 $full_path =~ s|^\/|| if $^O eq 'MSWin32'; # C:/foo works, /C:/foo doesn't 726 $full_path =~ s/\^\././g if $^O eq 'VMS'; # unescape dots 727 return $full_path; 728} 729 730package Pod::Simple::XHTML::LocalPodLinks; 731use strict; 732use warnings; 733use parent 'Pod::Simple::XHTML'; 734 735use File::Spec; 736use File::Spec::Unix; 737 738__PACKAGE__->_accessorize( 739 'htmldir', 740 'htmlfileurl', 741 'htmlroot', 742 'pages', # Page name => relative/path/to/page from root POD dir 743 'quiet', 744 'verbose', 745); 746 747sub resolve_pod_page_link { 748 my ($self, $to, $section) = @_; 749 750 return undef unless defined $to || defined $section; 751 if (defined $section) { 752 $section = '#' . $self->idify($section, 1); 753 return $section unless defined $to; 754 } else { 755 $section = ''; 756 } 757 758 my $path; # path to $to according to %Pages 759 unless (exists $self->pages->{$to}) { 760 # Try to find a POD that ends with $to and use that. 761 # e.g., given L<XHTML>, if there is no $Podpath/XHTML in %Pages, 762 # look for $Podpath/*/XHTML in %Pages, with * being any path, 763 # as a substitute (e.g., $Podpath/Pod/Simple/XHTML) 764 my @matches; 765 foreach my $modname (keys %{$self->pages}) { 766 push @matches, $modname if $modname =~ /::\Q$to\E\z/; 767 } 768 769 # make it look like a path instead of a namespace 770 my $modloc = File::Spec->catfile(split(/::/, $to)); 771 772 if ($#matches == -1) { 773 warn "Cannot find file \"$modloc.*\" directly under podpath, " . 774 "cannot find suitable replacement: link remains unresolved.\n" 775 if $self->verbose; 776 return ''; 777 } elsif ($#matches == 0) { 778 $path = $self->pages->{$matches[0]}; 779 my $matchloc = File::Spec->catfile(split(/::/, $path)); 780 warn "Cannot find file \"$modloc.*\" directly under podpath, but ". 781 "I did find \"$matchloc.*\", so I'll assume that is what you ". 782 "meant to link to.\n" 783 if $self->verbose; 784 } else { 785 # Use [-1] so newer (higher numbered) perl PODs are used 786 # XXX currently, @matches isn't sorted so this is not true 787 $path = $self->pages->{$matches[-1]}; 788 my $matchloc = File::Spec->catfile(split(/::/, $path)); 789 warn "Cannot find file \"$modloc.*\" directly under podpath, but ". 790 "I did find \"$matchloc.*\" (among others), so I'll use that " . 791 "to resolve the link.\n" if $self->verbose; 792 } 793 } else { 794 $path = $self->pages->{$to}; 795 } 796 797 my $url = File::Spec::Unix->catfile(Pod::Html::_unixify($self->htmlroot), 798 $path); 799 800 if ($self->htmlfileurl ne '') { 801 # then $self->htmlroot eq '' (by definition of htmlfileurl) so 802 # $self->htmldir needs to be prepended to link to get the absolute path 803 # that will be relativized 804 $url = Pod::Html::relativize_url( 805 File::Spec::Unix->catdir(Pod::Html::_unixify($self->htmldir), $url), 806 $self->htmlfileurl # already unixified 807 ); 808 } 809 810 return $url . ".html$section"; 811} 812 813package Pod::Html; 814 815# 816# relativize_url - convert an absolute URL to one relative to a base URL. 817# Assumes both end in a filename. 818# 819sub relativize_url { 820 my ($dest, $source) = @_; 821 822 # Remove each file from its path 823 my ($dest_volume, $dest_directory, $dest_file) = 824 File::Spec::Unix->splitpath( $dest ); 825 $dest = File::Spec::Unix->catpath( $dest_volume, $dest_directory, '' ); 826 827 my ($source_volume, $source_directory, $source_file) = 828 File::Spec::Unix->splitpath( $source ); 829 $source = File::Spec::Unix->catpath( $source_volume, $source_directory, '' ); 830 831 my $rel_path = ''; 832 if ($dest ne '') { 833 $rel_path = File::Spec::Unix->abs2rel( $dest, $source ); 834 } 835 836 if ($rel_path ne '' && substr( $rel_path, -1 ) ne '/') { 837 $rel_path .= "/$dest_file"; 838 } else { 839 $rel_path .= "$dest_file"; 840 } 841 842 return $rel_path; 843} 844 8451; 846