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