diff options
author | Craig A. Berry <craigberry@mac.com> | 2012-02-26 09:10:27 -0600 |
---|---|---|
committer | Craig A. Berry <craigberry@mac.com> | 2012-02-28 19:13:42 -0600 |
commit | 1e33ffe43f81ff0cc6660854eb7a901d30fa31c6 (patch) | |
tree | 6081f32cdd46b4103c8166c376ee979be125f549 | |
parent | 12fddd398f7ab89902312f4663cdc9990618bd45 (diff) | |
download | perl-1e33ffe43f81ff0cc6660854eb7a901d30fa31c6.tar.gz |
Better cross-platform unixify for Pod::Html.
This is mostly borrowed from CPANPLUS with additional tweaks to
handle corner cases presented by the Pod::Html tests. It seems
to work on VMS, Windows, and Mac OS X.
Also tweak _save_page to make the call to ab2rel more robust in
the case wherethe base is a special string indicating the current
working directory ('./', '[]', or '.\') rather than a literal path.
-rw-r--r-- | ext/Pod-Html/lib/Pod/Html.pm | 28 |
1 files changed, 25 insertions, 3 deletions
diff --git a/ext/Pod-Html/lib/Pod/Html.pm b/ext/Pod-Html/lib/Pod/Html.pm index 694c5b07e5..aa2e8cbc30 100644 --- a/ext/Pod-Html/lib/Pod/Html.pm +++ b/ext/Pod-Html/lib/Pod/Html.pm @@ -645,7 +645,10 @@ sub _save_page { my ($modspec, $modname) = @_; # Remove Podroot from path - $modspec = File::Spec->abs2rel($modspec, $Podroot); + $modspec = $Podroot eq File::Spec->curdir + ? File::Spec->abs2rel($modspec) + : File::Spec->abs2rel($modspec, + File::Spec->canonpath($Podroot)); # Convert path to unix style path $modspec = Pod::Html::_unixify($modspec); @@ -657,9 +660,28 @@ sub _save_page { sub _unixify { my $full_path = shift; return '' unless $full_path; + return $full_path if $full_path eq '/'; - return File::Spec::Unix->catfile( # change \s to /s and such - File::Spec->splitdir($full_path)); + my ($vol, $dirs, $file) = File::Spec->splitpath($full_path); + my @dirs = $dirs eq File::Spec->curdir() + ? (File::Spec::Unix->curdir()) + : File::Spec->splitdir($dirs); + if (defined($vol) && $vol) { + $vol =~ s/:$// if $^O eq 'VMS'; + + if( $dirs[0] ) { + unshift @dirs, $vol; + } + else { + $dirs[0] = $vol; + } + } + unshift @dirs, '' if File::Spec->file_name_is_absolute($full_path); + return $file unless scalar(@dirs); + $full_path = File::Spec::Unix->catfile(File::Spec::Unix->catdir(@dirs), + $file); + $full_path =~ s|^\/|| if $^O eq 'MSWin32'; # C:/foo works, /C:/foo doesn't + return $full_path; } package Pod::Simple::XHTML::LocalPodLinks; |