summaryrefslogtreecommitdiff
path: root/ext
diff options
context:
space:
mode:
authorMarc Green <marcgreen@cpan.org>2011-07-01 09:47:11 -0400
committerMarc Green <marcgreen@cpan.org>2011-10-31 13:26:42 -0400
commit7c41f1eab9d2e151aad59f8e95f914ad932afcbd (patch)
treefb0643bc3fa9f49c448716c3021a2c78f3ef811f /ext
parent042c2bc8aafe40de8820e3d79b96a237b9989292 (diff)
downloadperl-7c41f1eab9d2e151aad59f8e95f914ad932afcbd.tar.gz
Fix crossref cross platform compatability issues
I added a whole bunch of "File::Spec"s and "File::Spec::Unix"s and I updated the test cases and test harness to be platform independent. I also updated some documentation in Pod::Html and removed some unneeded code.
Diffstat (limited to 'ext')
-rw-r--r--ext/Pod-Html/lib/Pod/Html.pm59
-rw-r--r--ext/Pod-Html/t/htmlcrossref.t21
-rw-r--r--ext/Pod-Html/t/htmldir.t27
-rw-r--r--ext/Pod-Html/t/htmldir2.t2
-rw-r--r--ext/Pod-Html/t/htmldir3.t21
-rw-r--r--ext/Pod-Html/t/htmldir4.t9
-rw-r--r--ext/Pod-Html/t/htmldir5.t7
-rw-r--r--ext/Pod-Html/t/htmlfeature.t8
-rw-r--r--ext/Pod-Html/t/htmlfeature2.t4
-rw-r--r--ext/Pod-Html/t/pod2html-lib.pl13
10 files changed, 106 insertions, 65 deletions
diff --git a/ext/Pod-Html/lib/Pod/Html.pm b/ext/Pod-Html/lib/Pod/Html.pm
index f85310db93..aaf0764688 100644
--- a/ext/Pod-Html/lib/Pod/Html.pm
+++ b/ext/Pod-Html/lib/Pod/Html.pm
@@ -268,7 +268,10 @@ sub pod2html {
# as the location from which to calculate relative links
# to other files. If this is '', then absolute links will
# be used throughout.
- $Htmlfileurl = "$Htmldir/" . substr( $Htmlfile, length( $Htmldir ) + 1);
+ #$Htmlfileurl = "$Htmldir/" . substr( $Htmlfile, length( $Htmldir ) + 1);
+ # Is the above not just "$Htmlfileurl = $Htmlfile"?
+ $Htmlfileurl = Unixify::unixify($Htmlfile);
+
}
my $pwd = getcwd();
@@ -510,18 +513,23 @@ sub anchorify {
sub _save_page {
my ($modspec, $modname) = @_;
+ # need to make sure all tests work on windows, clean up docs in this file, clean up test cases and filenames,
+
# Remove Podroot from path
- foreach my $p (@Podpath) {
- my $beg_path = File::Spec->catdir($Podroot, $p);
- # Replace $Podroot/$p with $p
- if ($beg_path eq substr($modspec, 0, length($beg_path), $p)) {
- last; # Keep replacement
+ 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;
}
}
+ # Convert path to unix style path
+ $modspec = Unixify::unixify($modspec);
+
my ($file, $dir) = fileparse($modspec, qr/\.[^.]*/); # strip .ext
- $Pages{$modname} = File::Spec::Unix->catdir( # convert '\'s to '/'s and such
- File::Spec->splitdir($dir . $file));
+ $Pages{$modname} = $dir.$file;
}
1;
@@ -532,6 +540,7 @@ use warnings;
use base 'Pod::Simple::XHTML';
use File::Spec;
+use File::Spec::Unix;
__PACKAGE__->_accessorize(
'htmldir',
@@ -585,17 +594,19 @@ sub resolve_pod_page_link {
$path = $self->pages->{$to};
}
- # catdir takes care of a leading '//', so I use it here. Note that if I
- # used catfile instead, not only would leading double rootdirs have to be
- # simplified, but then $url could be relative, not absolute. In an effort
- # to stick to the original Pod::Html, I want to keep $url absolute until
- # the test for Htmlfileurl ne '', in which it might be relativezed.
- my $url = File::Spec->catdir($self->htmlroot, $path);
+ # 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( Unixify::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($self->htmldir.$url, $self->htmlfileurl);
+ $url = relativize_url(
+ File::Spec::Unix->catdir( Unixify::unixify($self->htmldir), $url),
+ $self->htmlfileurl # already unixified
+ );
}
return $url . ".html$section";
@@ -632,3 +643,21 @@ sub relativize_url {
}
1;
+
+package Unixify;
+use warnings;
+use strict;
+
+use File::Spec;
+use File::Spec::Unix;
+
+sub unixify {
+ my $full_path = shift;
+ return '' unless $full_path;
+
+ my ($vol, $dir, $file) = File::Spec->splitpath($full_path);
+ return File::Spec::Unix->catfile( # change \s to /s and such
+ File::Spec->splitdir($dir.$file)); # ignore $vol(ume)
+}
+
+1;
diff --git a/ext/Pod-Html/t/htmlcrossref.t b/ext/Pod-Html/t/htmlcrossref.t
index 2ef56b02ab..0fcc665fae 100644
--- a/ext/Pod-Html/t/htmlcrossref.t
+++ b/ext/Pod-Html/t/htmlcrossref.t
@@ -6,18 +6,19 @@ BEGIN {
use strict;
use Test::More tests => 1;
+use File::Spec::Functions;
use File::Spec;
use Cwd;
-# XXX Is there a better way to do this? I need a relative url to cwd because of
-# --podpath and --podroot
-# Remove root dir from path
-my $relcwd = substr(Cwd::cwd(), length(File::Spec->rootdir()));
+my ($v, $d) = splitpath(cwd, 1);
+my $relcwd = substr($d, length(File::Spec->rootdir()));
+
+my $podpath = catdir($relcwd, 't') . ":" . catdir($relcwd, 'test.lib');
convert_n_test("htmlcrossref", "html cross references",
- "--podpath=$relcwd/t:$relcwd/test.lib",
- "--podroot=/",
+ "--podpath=$podpath",
+ "--podroot=$v".File::Spec->rootdir,
"--quiet",
);
@@ -53,21 +54,21 @@ __DATA__
<p><a href="#section1">&quot;section1&quot;</a></p>
-<p><a href="[CURRENTWORKINGDIRECTORY]/t/htmllink.html#section-2">&quot;section 2&quot; in htmllink</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="[CURRENTWORKINGDIRECTORY]/test.lib/perlvar.html">perlvar</a></p>
+<p><a href="/[RELCURRENTWORKINGDIRECTORY]/test.lib/perlvar.html">perlvar</a></p>
-<p><a href="[CURRENTWORKINGDIRECTORY]/test.lib/perlvar.html#pod-">&quot;$&quot;&quot; in perlvar</a></p>
+<p><a href="/[RELCURRENTWORKINGDIRECTORY]/test.lib/perlvar.html#pod-">&quot;$&quot;&quot; in perlvar</a></p>
<p><code>perlvar</code></p>
<p><code>perlvar/$&quot;</code></p>
-<p><a href="[CURRENTWORKINGDIRECTORY]/test.lib/perlpodspec.html#First:">&quot;First:&quot; in perlpodspec</a></p>
+<p><a href="/[RELCURRENTWORKINGDIRECTORY]/test.lib/perlpodspec.html#First:">&quot;First:&quot; in perlpodspec</a></p>
<p><code>perlpodspec/First:</code></p>
diff --git a/ext/Pod-Html/t/htmldir.t b/ext/Pod-Html/t/htmldir.t
index e11f31817c..2a0fc7c8c4 100644
--- a/ext/Pod-Html/t/htmldir.t
+++ b/ext/Pod-Html/t/htmldir.t
@@ -6,20 +6,21 @@ BEGIN {
use strict;
use Test::More tests => 2;
+use File::Spec::Functions;
use File::Spec;
use Cwd;
-# XXX Is there a better way to do this? I need a relative url to cwd because of
-# --podpath and --podroot
-# Remove root dir from path
-my $relcwd = substr(Cwd::cwd(), length(File::Spec->rootdir()));
+my ($v, $d) = splitpath(cwd(), 1);
+my $relcwd = substr($d, length(File::Spec->rootdir()));
my $data_pos = tell DATA; # to read <DATA> twice
+my $podpath = catdir($relcwd, 't') . ":" . catfile($relcwd, 'test.lib');
+
convert_n_test("htmldir", "test --htmldir and --htmlroot 1a",
- "--podpath=$relcwd/t:$relcwd/test.lib",
- "--podroot=/",
+ "--podpath=$podpath",
+ "--podroot=$v".File::Spec->rootdir,
# "--podpath=t",
# "--htmlroot=/test/dir",
"--htmldir=t",
@@ -27,10 +28,12 @@ convert_n_test("htmldir", "test --htmldir and --htmlroot 1a",
seek DATA, $data_pos, 0; # to read <DATA> twice (expected output is the same)
+my $htmldir = catfile $relcwd, 't';
+
convert_n_test("htmldir", "test --htmldir and --htmlroot 1b",
"--podpath=$relcwd",
- "--podroot=/",
- "--htmldir=$relcwd/t",
+ "--podroot=$v".File::Spec->rootdir,
+ "--htmldir=$htmldir",
"--htmlroot=/",
);
@@ -61,13 +64,13 @@ __DATA__
<p>Normal text, a <a>link</a> to nowhere,</p>
-<p>a link to <a href="[CURRENTWORKINGDIRECTORY]/test.lib/perlvar.html">perlvar</a>,</p>
+<p>a link to <a href="/[RELCURRENTWORKINGDIRECTORY]/test.lib/perlvar.html">perlvar</a>,</p>
-<p><a href="[CURRENTWORKINGDIRECTORY]/t/htmlescp.html">htmlescp</a>,</p>
+<p><a href="/[RELCURRENTWORKINGDIRECTORY]/t/htmlescp.html">htmlescp</a>,</p>
-<p><a href="[CURRENTWORKINGDIRECTORY]/t/htmlfeature.html#Another-Head-1">&quot;Another Head 1&quot; in htmlfeature</a>,</p>
+<p><a href="/[RELCURRENTWORKINGDIRECTORY]/t/htmlfeature.html#Another-Head-1">&quot;Another Head 1&quot; in htmlfeature</a>,</p>
-<p>and another <a href="[CURRENTWORKINGDIRECTORY]/t/htmlfeature.html#Another-Head-1">&quot;Another Head 1&quot; in htmlfeature</a>.</p>
+<p>and another <a href="/[RELCURRENTWORKINGDIRECTORY]/t/htmlfeature.html#Another-Head-1">&quot;Another Head 1&quot; in htmlfeature</a>.</p>
</body>
diff --git a/ext/Pod-Html/t/htmldir2.t b/ext/Pod-Html/t/htmldir2.t
index 592bffd9f9..0ac8c8766b 100644
--- a/ext/Pod-Html/t/htmldir2.t
+++ b/ext/Pod-Html/t/htmldir2.t
@@ -9,7 +9,7 @@ use Test::More tests => 3;
use Cwd;
-my $cwd = Cwd::cwd();
+my $cwd = cwd();
my $data_pos = tell DATA; # to read <DATA> twice
convert_n_test("htmldir2", "test --htmldir and --htmlroot 2a",
diff --git a/ext/Pod-Html/t/htmldir3.t b/ext/Pod-Html/t/htmldir3.t
index e5f6b79002..229925d010 100644
--- a/ext/Pod-Html/t/htmldir3.t
+++ b/ext/Pod-Html/t/htmldir3.t
@@ -6,28 +6,33 @@ BEGIN {
use strict;
use Test::More tests => 2;
+use File::Spec::Functions;
use File::Spec;
use Cwd;
-# XXX Is there a better way to do this? I need a relative url to cwd because of
-# --podpath and --podroot
-# Remove root dir from path
-my $relcwd = substr(Cwd::cwd(), length(File::Spec->rootdir()));
+my $cwd = cwd();
+
+my ($v, $d) = splitpath($cwd, 1);
+my $relcwd = substr($d, length(File::Spec->rootdir()));
my $data_pos = tell DATA; # to read <DATA> twice
+my $htmldir = catdir $cwd, 't', ''; # test removal trailing slash
+
convert_n_test("htmldir3", "test --htmldir and --htmlroot 3a",
"--podpath=$relcwd",
- "--podroot=/",
- "--htmldir=/$relcwd/t/", # test removal trailing slash
+ "--podroot=$v".File::Spec->rootdir,
+ "--htmldir=$htmldir",
);
seek DATA, $data_pos, 0; # to read <DATA> twice (expected output is the same)
+my $podpath = catdir $relcwd, 't';
+
convert_n_test("htmldir3", "test --htmldir and --htmlroot 3b",
- "--podpath=$relcwd/t",
- "--podroot=/",
+ "--podpath=$podpath",
+ "--podroot=$v".File::Spec->rootdir,
"--htmldir=t",
"--outfile=t/htmldir3.html",
);
diff --git a/ext/Pod-Html/t/htmldir4.t b/ext/Pod-Html/t/htmldir4.t
index d430eae6f2..1221586269 100644
--- a/ext/Pod-Html/t/htmldir4.t
+++ b/ext/Pod-Html/t/htmldir4.t
@@ -6,24 +6,27 @@ BEGIN {
use strict;
use Test::More tests => 2;
+use File::Spec::Functions ':ALL';
use Cwd;
-my $cwd = Cwd::cwd();
+my $cwd = cwd();
my $data_pos = tell DATA; # to read <DATA> twice
convert_n_test("htmldir4", "test --htmldir and --htmlroot 4a",
"--podpath=t",
"--htmldir=t",
- "--outfile=t/htmldir4.html",
+ "--outfile=".catfile 't', 'htmldir4.html',
);
seek DATA, $data_pos, 0; # to read <DATA> twice (expected output is the same)
+my $htmldir = catdir $cwd, 't';
+
convert_n_test("htmldir4", "test --htmldir and --htmlroot 4b",
"--podpath=t",
"--podroot=$cwd",
- "--htmldir=$cwd/t",
+ "--htmldir=$htmldir",
"--norecurse",
);
diff --git a/ext/Pod-Html/t/htmldir5.t b/ext/Pod-Html/t/htmldir5.t
index 63d6b7a4bc..eb997c6702 100644
--- a/ext/Pod-Html/t/htmldir5.t
+++ b/ext/Pod-Html/t/htmldir5.t
@@ -6,12 +6,13 @@ BEGIN {
use strict;
use Test::More tests => 1;
+use File::Spec::Functions;
use Cwd;
+my $cwd = catdir cwd(); # catdir converts path separators to that of the OS
+ # running the test
-my $cwd = Cwd::cwd();
-
-convert_n_test("htmldir5", "test --htmldir and --htmlroot 5a",
+convert_n_test("htmldir5", "test --htmldir and --htmlroot 5",
"--podpath=t:test.lib",
"--podroot=$cwd",
"--htmldir=$cwd",
diff --git a/ext/Pod-Html/t/htmlfeature.t b/ext/Pod-Html/t/htmlfeature.t
index cebe6b1e24..cff6489e30 100644
--- a/ext/Pod-Html/t/htmlfeature.t
+++ b/ext/Pod-Html/t/htmlfeature.t
@@ -1,5 +1,5 @@
#!/usr/bin/perl -w # -*- perl -*-
-require Cwd;
+use Cwd;
BEGIN {
require "t/pod2html-lib.pl";
@@ -7,14 +7,16 @@ BEGIN {
use strict;
use Test::More tests => 1;
+use File::Spec::Functions;
-my $cwd = Cwd::cwd();
+my $cwd = cwd();
+my $htmldir = catdir $cwd, 't';
convert_n_test("htmlfeature", "misc pod-html features",
"--backlink",
"--css=style.css",
"--header", # no styling b/c of --ccs
- "--htmldir=$cwd/t",
+ "--htmldir=$htmldir",
"--noindex",
"--podpath=t",
"--podroot=$cwd",
diff --git a/ext/Pod-Html/t/htmlfeature2.t b/ext/Pod-Html/t/htmlfeature2.t
index 9f9e90b622..e095b8037c 100644
--- a/ext/Pod-Html/t/htmlfeature2.t
+++ b/ext/Pod-Html/t/htmlfeature2.t
@@ -1,5 +1,5 @@
#!/usr/bin/perl -w # -*- perl -*-
-require Cwd;
+use Cwd;
BEGIN {
require "t/pod2html-lib.pl";
@@ -8,7 +8,7 @@ BEGIN {
use strict;
use Test::More tests => 1;
-my $cwd = Cwd::cwd();
+my $cwd = cwd();
convert_n_test("htmlfeature2", "misc pod-html features 2",
"--backlink",
diff --git a/ext/Pod-Html/t/pod2html-lib.pl b/ext/Pod-Html/t/pod2html-lib.pl
index c3e284a28d..36d7a6293b 100644
--- a/ext/Pod-Html/t/pod2html-lib.pl
+++ b/ext/Pod-Html/t/pod2html-lib.pl
@@ -1,16 +1,14 @@
require Cwd;
require Pod::Html;
require Config;
-use File::Spec::Functions;
+use File::Spec::Functions ':ALL';
sub convert_n_test {
my($podfile, $testname, @p2h_args) = @_;
my $cwd = Cwd::cwd();
- # XXX Is there a better way to do this? I need a relative url to cwd because of
- # --podpath and --podroot
- # Remove root dir from path
- my $rel_cwd = substr($cwd, length(File::Spec->rootdir()));
+ my ($vol, $dir) = splitpath($cwd, 1);
+ my $relcwd = substr($dir, length(File::Spec->rootdir()));
my $new_dir = catdir $cwd, "t";
my $infile = catfile $new_dir, "$podfile.pod";
@@ -22,7 +20,7 @@ sub convert_n_test {
"--outfile=$outfile",
"--podpath=t",
"--htmlroot=/",
- "--podroot=$cwd",
+ "--podroot=".catpath($vol,$cwd,''),
@p2h_args,
);
@@ -33,8 +31,7 @@ sub convert_n_test {
# expected
$expect = <DATA>;
$expect =~ s/\[PERLADMIN\]/$Config::Config{perladmin}/;
- $expect =~ s/\[CURRENTWORKINGDIRECTORY\]/$cwd/g;
- $expect =~ s/\[RELCURRENTWORKINGDIRECTORY\]/$rel_cwd/g;
+ $expect =~ s/\[RELCURRENTWORKINGDIRECTORY\]/$relcwd/g;
if (ord("A") == 193) { # EBCDIC.
$expect =~ s/item_mat_3c_21_3e/item_mat_4c_5a_6e/;
}