Fix bug in pod2html crossreferencing

5 files changed, 229 insertions, 20 deletions

diff --git a/MANIFEST b/MANIFEST
index 009cfc241f..8fb18d296e 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -3810,6 +3810,8 @@ ext/Pod-Html/bin/pod2html	Translator to turn pod into HTML
 ext/Pod-Html/lib/Pod/Html.pm	Convert POD data to HTML
 ext/Pod-Html/t/cache.pod
 ext/Pod-Html/t/cache.t
+ext/Pod-Html/t/crossref2.t
+ext/Pod-Html/t/crossref3.t
 ext/Pod-Html/t/crossref.pod
 ext/Pod-Html/t/crossref.t
 ext/Pod-Html/t/eol.t		test end of line agnosticism
diff --git a/ext/Pod-Html/lib/Pod/Html.pm b/ext/Pod-Html/lib/Pod/Html.pm
index 9f333bc1de..e663281828 100644
--- a/ext/Pod-Html/lib/Pod/Html.pm
+++ b/ext/Pod-Html/lib/Pod/Html.pm
@@ -3,7 +3,7 @@ use strict;
 require Exporter;
 
 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
-$VERSION = 1.14;
+$VERSION = 1.15;
 @ISA = qw(Exporter);
 @EXPORT = qw(pod2html htmlify);
 @EXPORT_OK = qw(anchorify);
@@ -94,10 +94,13 @@ Displays the usage message.
 
     --htmldir=name
 
-Sets the directory in which the resulting HTML file is placed.  This
-is used to generate relative links to other files. Not passing this
-causes all links to be absolute, since this is the value that tells
-Pod::Html the root of the documentation tree.
+Sets the directory to which all cross references in the resulting
+html file will be relative. Not passing this causes all links to be
+absolute since this is the value that tells Pod::Html the root of the 
+documentation tree.
+
+Do not use this and --htmlroot in the same call to pod2html; they are
+mutually exclusive.
 
 =item htmlroot
 
@@ -106,6 +109,11 @@ Pod::Html the root of the documentation tree.
 Sets the base URL for the HTML files.  When cross-references are made,
 the HTML root is prepended to the URL.
 
+Do not use this if relative links are desired: use --htmldir instead.
+
+Do not pass both this and --htmldir to pod2html; they are mutually
+exclusive.
+
 =item index
 
     --index
@@ -248,7 +256,7 @@ sub init_globals {
     $Htmlroot = "/";            # http-server base directory from which all
                                 #   relative paths in $podpath stem.
     $Htmldir = "";              # The directory to which the html pages
-                                # will (eventually) be written.
+                                #   will (eventually) be written.
     $Htmlfile = "";             # write to stdout by default
     $Htmlfileurl = "";          # The url that other files would use to
                                 # refer to this file.  This is only used
@@ -637,14 +645,7 @@ sub _save_page {
     my ($modspec, $modname) = @_;
 
     # Remove Podroot from path
-    foreach my $podpath (@Podpath) {
-        my $beg_path = File::Spec->catdir($Podroot, $podpath);
-        if ($beg_path eq substr($modspec, 0, length($beg_path))) {
-            # Replace $Podroot/$podpath with $podpath
-            substr($modspec, 0, length($beg_path), $podpath);
-            last;
-        }
-    }
+    $modspec = File::Spec->abs2rel($modspec, $Podroot);
 
     # Convert path to unix style path
     $modspec = Pod::Html::_unixify($modspec);
@@ -721,17 +722,15 @@ sub resolve_pod_page_link {
         $path = $self->pages->{$to};
     }
 
-    # The use of catdir here (instead of catfile) ensures there will be one
-    # '/' between htmlroot and $path; not zero (if htmlroot == ''), not two
-    # (if htmlroot =~ m#/\z# and $path =~ m#\a/#), just one.
-    my $url = File::Spec::Unix->catdir( Pod::Html::_unixify($self->htmlroot),
+    my $url = File::Spec::Unix->catfile(Pod::Html::_unixify($self->htmlroot),
                                         $path);
+
     if ($self->htmlfileurl ne '') {
         # then $self->htmlroot eq '' (by definition of htmlfileurl) so
         # $self->htmldir needs to be prepended to link to get the absolute path
         # that will be relativized
         $url = relativize_url(
-            File::Spec::Unix->catdir( Pod::Html::_unixify($self->htmldir), $url),
+            File::Spec::Unix->catdir(Pod::Html::_unixify($self->htmldir), $url),
             $self->htmlfileurl # already unixified
         );
     }
diff --git a/ext/Pod-Html/t/cache.t b/ext/Pod-Html/t/cache.t
index f38de45fa1..5a8e1fef1f 100644
--- a/ext/Pod-Html/t/cache.t
+++ b/ext/Pod-Html/t/cache.t
@@ -59,7 +59,7 @@ while (<$cache>) {
 chdir("t");
 my %expected_pages = 
     # chop off the .pod and set the path
-    map { my $f = substr($_, 0, -4); $f => "$cwd/t/$f" }
+    map { my $f = substr($_, 0, -4); $f => "t/$f" }
     <*.pod>;
 chdir($cwd);
 is_deeply(\%pages, \%expected_pages, "cache contents");
diff --git a/ext/Pod-Html/t/crossref2.t b/ext/Pod-Html/t/crossref2.t
new file mode 100644
index 0000000000..b4e0f65503
--- /dev/null
+++ b/ext/Pod-Html/t/crossref2.t
@@ -0,0 +1,104 @@
+#!/usr/bin/perl -w                                         # -*- perl -*-
+
+BEGIN {
+    require "t/pod2html-lib.pl";
+}
+
+END {
+    rem_test_dir();
+}
+
+use strict;
+use Cwd;
+use File::Spec;
+use File::Spec::Functions;
+use Test::More tests => 1;
+
+SKIP: {
+    my $output = make_test_dir();
+    skip "$output", 1 if $output;
+    
+    my $cwd = cwd();
+
+    convert_n_test("crossref", "cross references", 
+     "--podpath=t:testdir/test.lib",
+     "--podroot=$cwd",
+     "--htmldir=$cwd",
+     "--quiet",
+    );
+}
+
+__DATA__
+<?xml version="1.0" ?>
+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
+<html xmlns="http://www.w3.org/1999/xhtml">
+<head>
+<title></title>
+<meta http-equiv="content-type" content="text/html; charset=utf-8" />
+<link rev="made" href="mailto:[PERLADMIN]" />
+</head>
+
+<body style="background-color: white">
+
+
+
+<ul id="index">
+  <li><a href="#NAME">NAME</a></li>
+  <li><a href="#LINKS">LINKS</a></li>
+  <li><a href="#TARGETS">TARGETS</a>
+    <ul>
+      <li><a href="#section1">section1</a></li>
+    </ul>
+  </li>
+</ul>
+
+<h1 id="NAME">NAME</h1>
+
+<p>htmlcrossref - Test HTML cross reference links</p>
+
+<h1 id="LINKS">LINKS</h1>
+
+<p><a href="#section1">&quot;section1&quot;</a></p>
+
+<p><a href="./htmllink.html#section-2">&quot;section 2&quot; in htmllink</a></p>
+
+<p><a href="#item1">&quot;item1&quot;</a></p>
+
+<p><a href="#non-existant-section">&quot;non existant section&quot;</a></p>
+
+<p><a href="../testdir/test.lib/var-copy.html">var-copy</a></p>
+
+<p><a href="../testdir/test.lib/var-copy.html#pod-">&quot;$&quot;&quot; in var-copy</a></p>
+
+<p><code>var-copy</code></p>
+
+<p><code>var-copy/$&quot;</code></p>
+
+<p><a href="../testdir/test.lib/podspec-copy.html#First:">&quot;First:&quot; in podspec-copy</a></p>
+
+<p><code>podspec-copy/First:</code></p>
+
+<p><a>notperldoc</a></p>
+
+<h1 id="TARGETS">TARGETS</h1>
+
+<h2 id="section1">section1</h2>
+
+<p>This is section one.</p>
+
+<dl>
+
+<dt id="item1">item1  </dt>
+<dd>
+
+<p>This is item one.</p>
+
+</dd>
+</dl>
+
+
+</body>
+
+</html>
+
+
diff --git a/ext/Pod-Html/t/crossref3.t b/ext/Pod-Html/t/crossref3.t
new file mode 100644
index 0000000000..fc1983c87a
--- /dev/null
+++ b/ext/Pod-Html/t/crossref3.t
@@ -0,0 +1,104 @@
+#!/usr/bin/perl -w                                         # -*- perl -*-
+
+BEGIN {
+    require "t/pod2html-lib.pl";
+}
+
+END {
+    rem_test_dir();
+}
+
+use strict;
+use Cwd;
+use File::Spec;
+use File::Spec::Functions;
+use Test::More tests => 1;
+
+SKIP: {
+    my $output = make_test_dir();
+    skip "$output", 1 if $output;
+    
+    my $cwd = cwd();
+
+    convert_n_test("crossref", "cross references", 
+     "--podpath=t:testdir/test.lib",
+     "--podroot=$cwd",
+     "--htmlroot=$cwd",
+     "--quiet",
+    );
+}
+
+__DATA__
+<?xml version="1.0" ?>
+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
+<html xmlns="http://www.w3.org/1999/xhtml">
+<head>
+<title></title>
+<meta http-equiv="content-type" content="text/html; charset=utf-8" />
+<link rev="made" href="mailto:[PERLADMIN]" />
+</head>
+
+<body style="background-color: white">
+
+
+
+<ul id="index">
+  <li><a href="#NAME">NAME</a></li>
+  <li><a href="#LINKS">LINKS</a></li>
+  <li><a href="#TARGETS">TARGETS</a>
+    <ul>
+      <li><a href="#section1">section1</a></li>
+    </ul>
+  </li>
+</ul>
+
+<h1 id="NAME">NAME</h1>
+
+<p>htmlcrossref - Test HTML cross reference links</p>
+
+<h1 id="LINKS">LINKS</h1>
+
+<p><a href="#section1">&quot;section1&quot;</a></p>
+
+<p><a href="/[RELCURRENTWORKINGDIRECTORY]/t/htmllink.html#section-2">&quot;section 2&quot; in htmllink</a></p>
+
+<p><a href="#item1">&quot;item1&quot;</a></p>
+
+<p><a href="#non-existant-section">&quot;non existant section&quot;</a></p>
+
+<p><a href="/[RELCURRENTWORKINGDIRECTORY]/testdir/test.lib/var-copy.html">var-copy</a></p>
+
+<p><a href="/[RELCURRENTWORKINGDIRECTORY]/testdir/test.lib/var-copy.html#pod-">&quot;$&quot;&quot; in var-copy</a></p>
+
+<p><code>var-copy</code></p>
+
+<p><code>var-copy/$&quot;</code></p>
+
+<p><a href="/[RELCURRENTWORKINGDIRECTORY]/testdir/test.lib/podspec-copy.html#First:">&quot;First:&quot; in podspec-copy</a></p>
+
+<p><code>podspec-copy/First:</code></p>
+
+<p><a>notperldoc</a></p>
+
+<h1 id="TARGETS">TARGETS</h1>
+
+<h2 id="section1">section1</h2>
+
+<p>This is section one.</p>
+
+<dl>
+
+<dt id="item1">item1  </dt>
+<dd>
+
+<p>This is item one.</p>
+
+</dd>
+</dl>
+
+
+</body>
+
+</html>
+
+