On Tue, Feb 7, 2012 at 7:17 AM, Nicholas Clark <n...@ccl4.org> wrote:
> On Tue, Feb 07, 2012 at 12:30:07PM +0000, Nicholas Clark wrote:
>
>> and that calls File::Spec::Unix->catfile(), which on Win32 looks like
>> this:
>
> Nick, you muppet. The code File::Spec::Unix->catfile() can't end up in
> Win32's catfile. The cause is slightly earlier in _save_page
>
> # 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;
> }
> }
>
> and *that* above is a call to File::Spec::Win32::catdir() when on Win32,
>
> [code continues with the lines just below]
>
>> Pod::HTML seems to find the current directory by the same route.
>> The cache is written from %Pages. Entries to %Pages are written here:
>>
>> # Convert path to unix style path
>> $modspec = Unixify::unixify($modspec);
>>
>> my ($file, $dir) = fileparse($modspec, qr/\.[^.]*/); # strip .ext
>> $Pages{$modname} = $dir.$file;
>
>
> and catdir() tail calls into _canon_cat()
>
>
>> and in turn, _canon_cat starts like this:
>>
>> sub _canon_cat # @path -> path
>> {
>> my ($first, @rest) = @_;
>>
>> my $volume = $first =~ s{ \A ([A-Za-z]:) ([\\/]?) }{}x # drive letter
>> ? ucfirst( $1 ).( $2 ? "\\" : "" )
>> : $first =~ s{ \A (?:\\\\|//) ([^\\/]+)
>> (?: [\\/] ([^\\/]+) )?
>> [\\/]? }{}xs # UNC volume
>> ? "\\\\$1".( defined $2 ? "\\$2" : "" )."\\"
>> : $first =~ s{ \A [\\/] }{}x # root dir
>> ? "\\"
>> : "";
>> my $path = join "\\", $first, @rest;
>>
>>
>> and *that*, I think is why "d:" becomes "D:"
>
> and I'm still not sure about:
>
>> *) why this didn't show up on the smoker. Is it possible on Win32 to globally
>> configure whether the reported name of the second HD is "d:" or "D:"?
FWIW, none of the tests depending on _save_page or the home-grown
unixify has ever passed on VMS. I got them passing with the
following, but then they failed on OS X, so I didn't push them and
I've never gotten back to them. The unixify implementation is
basically lifted from CPANPLUS.
--- lib/Pod/Html.pm;-0 2011-11-20 21:06:12 -0600
+++ lib/Pod/Html.pm 2011-12-04 18:10:17 -0600
@@ -521,7 +521,8 @@ sub _save_page {
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);
+ my (undef, undef, $file) = File::Spec->splitpath($modspec);
+ $modspec = File::Spec->catfile($podpath, $file);
last;
}
}
--- lib/Pod/Html.pm;-0 2011-11-20 21:06:12 -0600
+++ lib/Pod/Html.pm 2011-12-04 18:10:17 -0600
@@ -657,8 +657,21 @@ sub unixify {
my $full_path = shift;
return '' unless $full_path;
- 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 = File::Spec->splitdir($dirs);
+ if (defined($vol) && $vol) {
+ $vol =~ s/:$//;
+
+ if( $dirs[0] ) {
+ unshift @dirs, $vol;
+ }
+ else {
+ $dirs[0] = $vol;
+ }
+ }
+ unshift @dirs, '' if File::Spec->file_name_is_absolute($full_path);
+ return File::Spec::Unix->catfile(File::Spec::Unix->catdir(@dirs),
+ $file);
}
1;
