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     # I think this, and many other unixifications, belongs in
 293     # parse_command_line or some other higher-level location to get them all
 294     # unixified at once.  Right now, I think we may be unixifying things too
 295     # late and ad hoc. -- rjbs, 2012-02-21
 296     $Htmlfile = _unixify($Htmlfile);
 297
 298     if (  $Htmlroot eq ''
 299        && defined( $Htmldir )
 300        && $Htmldir ne ''
 301        && substr( $Htmlfile, 0, length( $Htmldir ) ) eq $Htmldir
 302        ) {
 303         # Set the 'base' url for this file, so that we can use it
 304         # as the location from which to calculate relative links
 305         # to other files. If this is '', then absolute links will
 306         # be used throughout.
 307         #$Htmlfileurl = "$Htmldir/" . substr( $Htmlfile, length( $Htmldir ) + 1);
 308         # Is the above not just "$Htmlfileurl = $Htmlfile"?
 309         $Htmlfileurl = Pod::Html::_unixify($Htmlfile);
 310
 311     }
 312
 313     # load or generate/cache %Pages
 314     unless (get_cache($Dircache, \@Podpath, $Podroot, $Recurse)) {
 315         # generate %Pages
 316         my $pwd = getcwd();
 317         chdir($Podroot) ||
 318             die "$0: error changing to directory $Podroot: $!\n";
 319
 320         # find all pod modules/pages in podpath, store in %Pages
 321         # - callback used to remove Podroot and extension from each file
 322         # - laborious to allow '.' in dirnames (e.g., /usr/share/perl/5.14.1)
 323         Pod::Simple::Search->new->inc(0)->verbose($Verbose)->laborious(1)
 324             ->callback(\&_save_page)->recurse($Recurse)->survey(@Podpath);
 325
 326         chdir($pwd) || die "$0: error changing to directory $pwd: $!\n";
 327
 328         # cache the directory list for later use
 329         warn "caching directories for later use\n" if $Verbose;
 330         open my $cache, '>', $Dircache
 331             or die "$0: error open $Dircache for writing: $!\n";
 332
 333         print $cache join(":", @Podpath) . "\n$Podroot\n";
 334         foreach my $key (keys %Pages) {
 335             print $cache "$key $Pages{$key}\n";
 336         }
 337
 338         close $cache or die "error closing $Dircache: $!";
 339     }
 340
 341     # set options for the parser
 342     my $parser = Pod::Simple::XHTML::LocalPodLinks->new();
 343     $parser->anchor_items(1); # the old Pod::Html always did
 344     $parser->backlink($Backlink); # linkify =head1 directives
 345     $parser->htmldir($Htmldir);
 346     $parser->htmlfileurl($Htmlfileurl);
 347     $parser->htmlroot($Htmlroot);
 348     $parser->index($Doindex);
 349     $parser->no_errata_section(!$Poderrors); # note the inverse
 350     $parser->output_string(\my $output); # written to file later
 351     $parser->pages(\%Pages);
 352     $parser->quiet($Quiet);
 353     $parser->verbose($Verbose);
 354
 355     # XXX: implement default title generator in pod::simple::xhtml
 356     # copy the way the old Pod::Html did it
 357     $Title = html_escape($Title);
 358
 359     # We need to add this ourselves because we use our own header, not
 360     # ::XHTML's header. We need to set $parser->backlink to linkify
 361     # the =head1 directives
 362     my $bodyid = $Backlink ? ' id="_podtop_"' : '';
 363
 364     my $csslink = '';
 365     my $bodystyle = ' style="background-color: white"';
 366     my $tdstyle = ' style="background-color: #cccccc"';
 367
 368     if ($Css) {
 369         $csslink = qq(\n<link rel="stylesheet" href="$Css" type="text/css" />);
 370         $csslink =~ s,\\,/,g;
 371         $csslink =~ s,(/.):,$1|,;
 372         $bodystyle = '';
 373         $tdstyle= '';
 374     }
 375
 376     # header/footer block
 377     my $block = $Header ? <<END_OF_BLOCK : '';
 378 <table border="0" width="100%" cellspacing="0" cellpadding="3">
 379 <tr><td class="_podblock_"$tdstyle valign="middle">
 380 <big><strong><span class="_podblock_">&nbsp;$Title</span></strong></big>
 381 </td></tr>
 382 </table>
 383 END_OF_BLOCK
 384
 385     # create own header/footer because of --header
 386     $parser->html_header(<<"HTMLHEAD");
 387 <?xml version="1.0" ?>
 388 <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
 389 <html xmlns="http://www.w3.org/1999/xhtml">
 390 <head>
 391 <title>$Title</title>$csslink
 392 <meta http-equiv="content-type" content="text/html; charset=utf-8" />
 393 <link rev="made" href="mailto:$Config{perladmin}" />
 394 </head>
 395
 396 <body$bodyid$bodystyle>
 397 $block
 398 HTMLHEAD
 399
 400     $parser->html_footer(<<"HTMLFOOT");
 401 $block
 402 </body>
 403
 404 </html>
 405 HTMLFOOT
 406
 407     my $input;
 408     unless (@ARGV && $ARGV[0]) {
 409         if ($Podfile and $Podfile ne '-') {
 410             $input = $Podfile;
 411         } else {
 412             $input = '-'; # XXX: make a test case for this
 413         }
 414     } else {
 415         $Podfile = $ARGV[0];
 416         $input = *ARGV;
 417     }
 418
 419     warn "Converting input file $Podfile\n" if $Verbose;
 420     $parser->parse_file($input);
 421
 422     # Write output to file
 423     $Htmlfile = "-" unless $Htmlfile; # stdout
 424     my $fhout;
 425     if($Htmlfile and $Htmlfile ne '-') {
 426         open $fhout, ">", $Htmlfile
 427             or die "$0: cannot open $Htmlfile file for output: $!\n";
 428     } else {
 429         open $fhout, ">-";
 430     }
 431     print $fhout $output;
 432     close $fhout or die "Failed to close $Htmlfile: $!";
 433 }
 434
 435 ##############################################################################
 436
 437 sub usage {
 438     my $podfile = shift;
 439     warn "$0: $podfile: @_\n" if @_;
 440     die <<END_OF_USAGE;
 441 Usage:  $0 --help --htmlroot=<name> --infile=<name> --outfile=<name>
 442            --podpath=<name>:...:<name> --podroot=<name> --cachedir=<name>
 443            --recurse --verbose --index --norecurse --noindex
 444
 445   --[no]backlink  - turn =head1 directives into links pointing to the top of
 446                       the page (off by default).
 447   --cachedir      - directory for the directory cache files.
 448   --css           - stylesheet URL
 449   --flush         - flushes the directory cache.
 450   --[no]header    - produce block header/footer (default is no headers).
 451   --help          - prints this message.
 452   --htmldir       - directory for resulting HTML files.
 453   --htmlroot      - http-server base directory from which all relative paths
 454                       in podpath stem (default is /).
 455   --[no]index     - generate an index at the top of the resulting html
 456                       (default behaviour).
 457   --infile        - filename for the pod to convert (input taken from stdin
 458                       by default).
 459   --outfile       - filename for the resulting html file (output sent to
 460                       stdout by default).
 461   --[no]poderrors - include a POD ERRORS section in the output if there were
 462                       any POD errors in the input (default behavior).
 463   --podpath       - colon-separated list of directories containing library
 464                       pods (empty by default).
 465   --podroot       - filesystem base directory from which all relative paths
 466                       in podpath stem (default is .).
 467   --[no]quiet     - suppress some benign warning messages (default is off).
 468   --[no]recurse   - recurse on those subdirectories listed in podpath
 469                       (default behaviour).
 470   --title         - title that will appear in resulting html file.
 471   --[no]verbose   - self-explanatory (off by default).
 472
 473 END_OF_USAGE
 474
 475 }
 476
 477 sub parse_command_line {
 478     my ($opt_backlink,$opt_cachedir,$opt_css,$opt_flush,$opt_header,
 479         $opt_help,$opt_htmldir,$opt_htmlroot,$opt_index,$opt_infile,
 480         $opt_outfile,$opt_poderrors,$opt_podpath,$opt_podroot,
 481         $opt_quiet,$opt_recurse,$opt_title,$opt_verbose);
 482
 483     unshift @ARGV, split ' ', $Config{pod2html} if $Config{pod2html};
 484     my $result = GetOptions(
 485                        'backlink!'  => \$opt_backlink,
 486                        'cachedir=s' => \$opt_cachedir,
 487                        'css=s'      => \$opt_css,
 488                        'flush'      => \$opt_flush,
 489                        'help'       => \$opt_help,
 490                        'header!'    => \$opt_header,
 491                        'htmldir=s'  => \$opt_htmldir,
 492                        'htmlroot=s' => \$opt_htmlroot,
 493                        'index!'     => \$opt_index,
 494                        'infile=s'   => \$opt_infile,
 495                        'outfile=s'  => \$opt_outfile,
 496                        'poderrors!' => \$opt_poderrors,
 497                        'podpath=s'  => \$opt_podpath,
 498                        'podroot=s'  => \$opt_podroot,
 499                        'quiet!'     => \$opt_quiet,
 500                        'recurse!'   => \$opt_recurse,
 501                        'title=s'    => \$opt_title,
 502                        'verbose!'   => \$opt_verbose,
 503     );
 504     usage("-", "invalid parameters") if not $result;
 505
 506     usage("-") if defined $opt_help;    # see if the user asked for help
 507     $opt_help = "";                     # just to make -w shut-up.
 508
 509     @Podpath  = split(":", $opt_podpath) if defined $opt_podpath;
 510
 511     $Backlink  = $opt_backlink  if defined $opt_backlink;
 512     $Cachedir  = $opt_cachedir  if defined $opt_cachedir;
 513     $Css       = $opt_css       if defined $opt_css;
 514     $Header    = $opt_header    if defined $opt_header;
 515     $Htmldir   = $opt_htmldir   if defined $opt_htmldir;
 516     $Htmlroot  = $opt_htmlroot  if defined $opt_htmlroot;
 517     $Doindex   = $opt_index     if defined $opt_index;
 518     $Podfile   = $opt_infile    if defined $opt_infile;
 519     $Htmlfile  = $opt_outfile   if defined $opt_outfile;
 520     $Poderrors = $opt_poderrors if defined $opt_poderrors;
 521     $Podroot   = $opt_podroot   if defined $opt_podroot;
 522     $Quiet     = $opt_quiet     if defined $opt_quiet;
 523     $Recurse   = $opt_recurse   if defined $opt_recurse;
 524     $Title     = $opt_title     if defined $opt_title;
 525     $Verbose   = $opt_verbose   if defined $opt_verbose;
 526
 527     warn "Flushing directory caches\n"
 528         if $opt_verbose && defined $opt_flush;
 529     $Dircache = "$Cachedir/pod2htmd.tmp";
 530     if (defined $opt_flush) {
 531         1 while unlink($Dircache);
 532     }
 533 }
 534
 535 my $Saved_Cache_Key;
 536
 537 sub get_cache {
 538     my($dircache, $podpath, $podroot, $recurse) = @_;
 539     my @cache_key_args = @_;
 540
 541     # A first-level cache:
 542     # Don't bother reading the cache files if they still apply
 543     # and haven't changed since we last read them.
 544
 545     my $this_cache_key = cache_key(@cache_key_args);
 546     return 1 if $Saved_Cache_Key and $this_cache_key eq $Saved_Cache_Key;
 547     $Saved_Cache_Key = $this_cache_key;
 548
 549     # load the cache of %Pages if possible.  $tests will be
 550     # non-zero if successful.
 551     my $tests = 0;
 552     if (-f $dircache) {
 553         warn "scanning for directory cache\n" if $Verbose;
 554         $tests = load_cache($dircache, $podpath, $podroot);
 555     }
 556
 557     return $tests;
 558 }
 559
 560 sub cache_key {
 561     my($dircache, $podpath, $podroot, $recurse) = @_;
 562     return join('!',$dircache,$recurse,@$podpath,$podroot,stat($dircache));
 563 }
 564
 565 #
 566 # load_cache - tries to find if the cache stored in $dircache is a valid
 567 #  cache of %Pages.  if so, it loads them and returns a non-zero value.
 568 #
 569 sub load_cache {
 570     my($dircache, $podpath, $podroot) = @_;
 571     my $tests = 0;
 572     local $_;
 573
 574     warn "scanning for directory cache\n" if $Verbose;
 575     open(my $cachefh, '<', $dircache) ||
 576         die "$0: error opening $dircache for reading: $!\n";
 577     $/ = "\n";
 578
 579     # is it the same podpath?
 580     $_ = <$cachefh>;
 581     chomp($_);
 582     $tests++ if (join(":", @$podpath) eq $_);
 583
 584     # is it the same podroot?
 585     $_ = <$cachefh>;
 586     chomp($_);
 587     $tests++ if ($podroot eq $_);
 588
 589     # load the cache if its good
 590     if ($tests != 2) {
 591         close($cachefh);
 592         return 0;
 593     }
 594
 595     warn "loading directory cache\n" if $Verbose;
 596     while (<$cachefh>) {
 597         /(.*?) (.*)$/;
 598         $Pages{$1} = $2;
 599     }
 600
 601     close($cachefh);
 602     return 1;
 603 }
 604
 605
 606 #
 607 # html_escape: make text safe for HTML
 608 #
 609 sub html_escape {
 610     my $rest = $_[0];
 611     $rest   =~ s/&/&amp;/g;
 612     $rest   =~ s/</&lt;/g;
 613     $rest   =~ s/>/&gt;/g;
 614     $rest   =~ s/"/&quot;/g;
 615     # &apos; is only in XHTML, not HTML4.  Be conservative
 616     #$rest   =~ s/'/&apos;/g;
 617     return $rest;
 618 }
 619
 620 #
 621 # htmlify - converts a pod section specification to a suitable section
 622 # specification for HTML. Note that we keep spaces and special characters
 623 # except ", ? (Netscape problem) and the hyphen (writer's problem...).
 624 #
 625 sub htmlify {
 626     my( $heading) = @_;
 627     $heading =~ s/(\s+)/ /g;
 628     $heading =~ s/\s+\Z//;
 629     $heading =~ s/\A\s+//;
 630     # The hyphen is a disgrace to the English language.
 631     # $heading =~ s/[-"?]//g;
 632     $heading =~ s/["?]//g;
 633     $heading = lc( $heading );
 634     return $heading;
 635 }
 636
 637 #
 638 # similar to htmlify, but turns non-alphanumerics into underscores
 639 #
 640 sub anchorify {
 641     my ($anchor) = @_;
 642     $anchor = htmlify($anchor);
 643     $anchor =~ s/\W/_/g;
 644     return $anchor;
 645 }
 646
 647 #
 648 # store POD files in %Pages
 649 #
 650 sub _save_page {
 651     my ($modspec, $modname) = @_;
 652
 653     # Remove Podroot from path
 654     $modspec = File::Spec->abs2rel($modspec, $Podroot);
 655
 656     # Convert path to unix style path
 657     $modspec = Pod::Html::_unixify($modspec);
 658
 659     my ($file, $dir) = fileparse($modspec, qr/\.[^.]*/); # strip .ext
 660     $Pages{$modname} = $dir.$file;
 661 }
 662
 663 sub _unixify {
 664     my $full_path = shift;
 665     return '' unless $full_path;
 666
 667     return File::Spec::Unix->catfile( # change \s to /s and such
 668                File::Spec->splitdir($full_path));
 669 }
 670
 671 package Pod::Simple::XHTML::LocalPodLinks;
 672 use strict;
 673 use warnings;
 674 use base 'Pod::Simple::XHTML';
 675
 676 use File::Spec;
 677 use File::Spec::Unix;
 678
 679 __PACKAGE__->_accessorize(
 680  'htmldir',
 681  'htmlfileurl',
 682  'htmlroot',
 683  'pages', # Page name => relative/path/to/page from root POD dir
 684  'quiet',
 685  'verbose',
 686 );
 687
 688 sub resolve_pod_page_link {
 689     my ($self, $to, $section) = @_;
 690
 691     return undef unless defined $to || defined $section;
 692     if (defined $section) {
 693         $section = '#' . $self->idify($section, 1);
 694         return $section unless defined $to;
 695     } else {
 696         $section = '';
 697     }
 698
 699     my $path; # path to $to according to %Pages
 700     unless (exists $self->pages->{$to}) {
 701         # Try to find a POD that ends with $to and use that.
 702         # e.g., given L<XHTML>, if there is no $Podpath/XHTML in %Pages,
 703         # look for $Podpath/*/XHTML in %Pages, with * being any path,
 704         # as a substitute (e.g., $Podpath/Pod/Simple/XHTML)
 705         my @matches;
 706         foreach my $modname (keys %{$self->pages}) {
 707             push @matches, $modname if $modname =~ /::\Q$to\E\z/;
 708         }
 709
 710         if ($#matches == -1) {
 711             warn "Cannot find \"$to\" in podpath: " .
 712                  "cannot find suitable replacement path, cannot resolve link\n"
 713                  unless $self->quiet;
 714             return '';
 715         } elsif ($#matches == 0) {
 716             warn "Cannot find \"$to\" in podpath: " .
 717                  "using $matches[0] as replacement path to $to\n"
 718                  unless $self->quiet;
 719             $path = $self->pages->{$matches[0]};
 720         } else {
 721             warn "Cannot find \"$to\" in podpath: " .
 722                  "more than one possible replacement path to $to, " .
 723                  "using $matches[-1]\n" unless $self->quiet;
 724             # Use [-1] so newer (higher numbered) perl PODs are used
 725             $path = $self->pages->{$matches[-1]};
 726         }
 727     } else {
 728         $path = $self->pages->{$to};
 729     }
 730
 731     my $url = File::Spec::Unix->catfile(Pod::Html::_unixify($self->htmlroot),
 732                                         $path);
 733
 734     if ($self->htmlfileurl ne '') {
 735         # then $self->htmlroot eq '' (by definition of htmlfileurl) so
 736         # $self->htmldir needs to be prepended to link to get the absolute path
 737         # that will be relativized
 738         $url = relativize_url(
 739             File::Spec::Unix->catdir(Pod::Html::_unixify($self->htmldir), $url),
 740             $self->htmlfileurl # already unixified
 741         );
 742     }
 743
 744     return $url . ".html$section";
 745 }
 746
 747 #
 748 # relativize_url - convert an absolute URL to one relative to a base URL.
 749 # Assumes both end in a filename.
 750 #
 751 sub relativize_url {
 752     my ($dest, $source) = @_;
 753
 754     # Remove each file from its path
 755     my ($dest_volume, $dest_directory, $dest_file) =
 756         File::Spec::Unix->splitpath( $dest );
 757     $dest = File::Spec::Unix->catpath( $dest_volume, $dest_directory, '' );
 758
 759     my ($source_volume, $source_directory, $source_file) =
 760         File::Spec::Unix->splitpath( $source );
 761     $source = File::Spec::Unix->catpath( $source_volume, $source_directory, '' );
 762
 763     my $rel_path = '';
 764     if ($dest ne '') {
 765        $rel_path = File::Spec::Unix->abs2rel( $dest, $source );
 766     }
 767
 768     if ($rel_path ne '' && substr( $rel_path, -1 ) ne '/') {
 769         $rel_path .= "/$dest_file";
 770     } else {
 771         $rel_path .= "$dest_file";
 772     }
 773
 774     return $rel_path;
 775 }
 776
 777 1;