diff options
author | Marc Green <marcgreen@cpan.org> | 2011-07-01 09:47:11 -0400 |
---|---|---|
committer | Marc Green <marcgreen@cpan.org> | 2011-10-31 13:26:42 -0400 |
commit | 7c41f1eab9d2e151aad59f8e95f914ad932afcbd (patch) | |
tree | fb0643bc3fa9f49c448716c3021a2c78f3ef811f /ext | |
parent | 042c2bc8aafe40de8820e3d79b96a237b9989292 (diff) | |
download | perl-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.pm | 59 | ||||
-rw-r--r-- | ext/Pod-Html/t/htmlcrossref.t | 21 | ||||
-rw-r--r-- | ext/Pod-Html/t/htmldir.t | 27 | ||||
-rw-r--r-- | ext/Pod-Html/t/htmldir2.t | 2 | ||||
-rw-r--r-- | ext/Pod-Html/t/htmldir3.t | 21 | ||||
-rw-r--r-- | ext/Pod-Html/t/htmldir4.t | 9 | ||||
-rw-r--r-- | ext/Pod-Html/t/htmldir5.t | 7 | ||||
-rw-r--r-- | ext/Pod-Html/t/htmlfeature.t | 8 | ||||
-rw-r--r-- | ext/Pod-Html/t/htmlfeature2.t | 4 | ||||
-rw-r--r-- | ext/Pod-Html/t/pod2html-lib.pl | 13 |
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">"section1"</a></p> -<p><a href="[CURRENTWORKINGDIRECTORY]/t/htmllink.html#section-2">"section 2" in htmllink</a></p> +<p><a href="/[RELCURRENTWORKINGDIRECTORY]/t/htmllink.html#section-2">"section 2" in htmllink</a></p> <p><a href="#item1">"item1"</a></p> <p><a href="#non-existant-section">"non existant section"</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-">"$"" in perlvar</a></p> +<p><a href="/[RELCURRENTWORKINGDIRECTORY]/test.lib/perlvar.html#pod-">"$"" in perlvar</a></p> <p><code>perlvar</code></p> <p><code>perlvar/$"</code></p> -<p><a href="[CURRENTWORKINGDIRECTORY]/test.lib/perlpodspec.html#First:">"First:" in perlpodspec</a></p> +<p><a href="/[RELCURRENTWORKINGDIRECTORY]/test.lib/perlpodspec.html#First:">"First:" 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">"Another Head 1" in htmlfeature</a>,</p> +<p><a href="/[RELCURRENTWORKINGDIRECTORY]/t/htmlfeature.html#Another-Head-1">"Another Head 1" in htmlfeature</a>,</p> -<p>and another <a href="[CURRENTWORKINGDIRECTORY]/t/htmlfeature.html#Another-Head-1">"Another Head 1" in htmlfeature</a>.</p> +<p>and another <a href="/[RELCURRENTWORKINGDIRECTORY]/t/htmlfeature.html#Another-Head-1">"Another Head 1" 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/; } |