ext/Pod-Html/lib/Pod/Html.pm

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