This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
unixify paths a bit more systematicaly in Pod-Html
[perl5.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.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;