Skip Menu |
 

This queue is for tickets about the PathTools CPAN distribution.

Report information
The Basics
Id: 43299
Status: resolved
Priority: 0/
Queue: PathTools

People
Owner: Nobody in particular
Requestors: cberry [...] cpan.org
Cc:
AdminCc:

Bug Information
Severity: Important
Broken in: (no value)
Fixed in: (no value)



Subject: [PATCH] recognized colon delimiter on VMS
Download (untitled) / with headers
text/plain 790b
The attached patch is a follow-up to John Malmberg's RT #42153, which I see has already been applied. This one does two things. 1.) When identifying a VMS format file spec based on delimiters, include colon (C<:>) in the list of delimiters. It is perfectly valid to have a filespec with only a colon and no other delimiters in it. sys$scratch:foo.txt is the equivalent of /tmp/foo.txt, and there were circumstances where File::Spec->catfile('sys$scratch:', 'foo.txt') would give you [.sys$scratch:]foo.txt, which is invalid. Recognizing the colon makes it do the right thing in these cases. 2.) In the same regexes affected by #1, add a negative look-behind assertion to prevent delimiter characters that have been escaped with a caret (C<^>) from being treated as delimiters.
Subject: vms_fspec_colon.patch.txt
--- lib/File/Spec/VMS.pm;-0 Fri Jan 9 16:38:13 2009 +++ lib/File/Spec/VMS.pm Sat Feb 14 17:45:42 2009 @@ -202,13 +202,13 @@ sub catdir { $path_unix = 1 if ($path =~ m#/#); $path_unix = 1 if ($path =~ /^\.\.?$/); my $path_vms = 0; - $path_vms = 1 if ($path =~ m#[\[<\]]#); + $path_vms = 1 if ($path =~ m#(?<!\^)[\[<\]:]#); $path_vms = 1 if ($path =~ /^--?$/); my $dir_unix = 0; $dir_unix = 1 if ($dir =~ m#/#); $dir_unix = 1 if ($dir =~ /^\.\.?$/); my $dir_vms = 0; - $dir_vms = 1 if ($dir =~ m#[\[<\]]#); + $dir_vms = 1 if ($dir =~ m#(?<!\^)[\[<\]:]#); $dir_vms = 1 if ($dir =~ /^--?$/); my $unix_mode = 0; @@ -318,7 +318,7 @@ sub catdir { $dir_unix = 1 if ($dir =~ m#/#); $dir_unix = 1 if ($dir =~ /^\.\.?$/); my $dir_vms = 0; - $dir_vms = 1 if ($dir =~ m#[\[<\]]#); + $dir_vms = 1 if ($dir =~ m#(?<!\^)[\[<\]:]#); $dir_vms = 1 if ($dir =~ /^--?$/); if ($dir_vms == $dir_unix) { @@ -366,7 +366,7 @@ sub catfile { # of the specification in order to merge them. $file_unix = 1 if ($tfile =~ m#/#); $file_unix = 1 if ($tfile =~ /^\.\.?$/); - $file_vms = 1 if ($tfile =~ m#[\[<\]]#); + $file_vms = 1 if ($tfile =~ m#(?<!\^)[\[<\]:]#); $file_vms = 1 if ($tfile =~ /^--?$/); # We may know for sure what the format is. @@ -390,7 +390,7 @@ sub catfile { my $tdir = $files[$i]; my $tdir_vms = 0; my $tdir_unix = 0; - $tdir_vms = 1 if ($tdir =~ m#[\[<\]]#); + $tdir_vms = 1 if ($tdir =~ m#(?<!\^)[\[<\]:]#); $tdir_unix = 1 if ($tdir =~ m#/#); $tdir_unix = 1 if ($tdir =~ /^\.\.?$/); @@ -414,9 +414,7 @@ sub catfile { # if the spath ends with a directory delimiter and the file is bare, # then just concat them. - # FIX-ME: In VMS format "[]<>:" are not delimiters if preceded by '^' - # Quite a bit of Perl does not know that yet. - if ($spath =~ /^[^\)\]\/:>]+\)\Z(?!\n)/s && basename($file) eq $file) { + if ($spath =~ /^(?<!\^)[^\)\]\/:>]+\)\Z(?!\n)/s && basename($file) eq $file) { $rslt = "$spath$file"; } else { if ($efs) { @@ -427,7 +425,7 @@ sub catfile { $spath_unix = 1 if ($spath =~ m#/#); $spath_unix = 1 if ($spath =~ /^\.\.?$/); my $spath_vms = 0; - $spath_vms = 1 if ($spath =~ m#[\[<\]]#); + $spath_vms = 1 if ($spath =~ m#(?<!\^)[\[<\]:]#); $spath_vms = 1 if ($spath =~ /^--?$/); # Assume VMS mode @@ -548,7 +546,7 @@ sub rootdir { Returns a string representation of the first writable directory from the following list or '' if none are writable: - /tmp if C<DECC$FILENAME_REPORT_UNIX> is enabled. + /tmp if C<DECC$FILENAME_UNIX_REPORT> is enabled. sys$scratch: $ENV{TMPDIR} @@ -638,7 +636,7 @@ sub splitpath { my $vmsify_path = vmsify($path); if ($efs) { my $path_vms = 0; - $path_vms = 1 if ($path =~ m#[\[<\]]#); + $path_vms = 1 if ($path =~ m#(?<!\^)[\[<\]:]#); $path_vms = 1 if ($path =~ /^--?$/); if (!$path_vms) { return $self->SUPER::splitpath($path, $nofile); @@ -699,7 +697,7 @@ sub splitdir { # [--. ==> [-.-. # .--] ==> .-.-] # [--] ==> [-.-] - $dirspec = "[$dirspec]" unless $dirspec =~ /[\[<]/; # make legal + $dirspec = "[$dirspec]" unless $dirspec =~ /(?<!\^)[\[<]/; # make legal $dirspec =~ s/^(\[|<)\./$1/; @dirs = split /(?<!\^)\./, vmspath($dirspec); $dirs[0] =~ s/^[\[<]//s; $dirs[-1] =~ s/[\]>]\Z(?!\n)//s; @@ -724,7 +722,7 @@ sub catpath { $dir_unix = 1 if ($dir =~ m#/#); $dir_unix = 1 if ($dir =~ /^\.\.?$/); my $dir_vms = 0; - $dir_vms = 1 if ($dir =~ m#[\[<\]]#); + $dir_vms = 1 if ($dir =~ m#(?<!\^)[\[<\]:]#); $dir_vms = 1 if ($dir =~ /^--?$/); if ($efs && (length($dev) == 0)) { @@ -787,7 +785,7 @@ sub abs2rel { $path_unix = 1 if ($path =~ m#/#); $path_unix = 1 if ($path =~ /^\.\.?$/); my $path_vms = 0; - $path_vms = 1 if ($path =~ m#[\[<\]]#); + $path_vms = 1 if ($path =~ m#(?<!\^)[\[<\]:]#); $path_vms = 1 if ($path =~ /^--?$/); my $unix_mode = 0; @@ -803,7 +801,7 @@ sub abs2rel { if (defined $base) { $base_unix = 1 if ($base =~ m#/#); $base_unix = 1 if ($base =~ /^\.\.?$/); - $base_vms = 1 if ($base =~ m#[\[<\]]#); + $base_vms = 1 if ($base =~ m#(?<!\^)[\[<\]:]#); $base_vms = 1 if ($base =~ /^--?$/); if ($path_vms == $path_unix) { @@ -923,7 +921,7 @@ sub rel2abs { $path_unix = 1 if ($path =~ m#/#); $path_unix = 1 if ($path =~ /^\.\.?$/); my $path_vms = 0; - $path_vms = 1 if ($path =~ m#[\[<\]]#); + $path_vms = 1 if ($path =~ m#(?<!\^)[\[<\]:]#); $path_vms = 1 if ($path =~ /^--?$/); my $unix_mode = 0; @@ -939,7 +937,7 @@ sub rel2abs { if (defined $base) { $base_unix = 1 if ($base =~ m#/#); $base_unix = 1 if ($base =~ /^\.\.?$/); - $base_vms = 1 if ($base =~ m#[\[<\]]#); + $base_vms = 1 if ($base =~ m#(?<!\^)[\[<\]:]#); $base_vms = 1 if ($base =~ /^--?$/); # If we could not determine the path mode, see if we can find out @@ -981,7 +979,7 @@ sub rel2abs { if ($efs) { # base may have changed, so need to look up format again. if ($unix_mode) { - $base_vms = 1 if ($base =~ m#[\[<\]]#); + $base_vms = 1 if ($base =~ m#(?<!\^)[\[<\]:]#); $base_vms = 1 if ($base =~ /^--?$/); $base = unixpath($base) if $base_vms; $base .= '/' unless ($base =~ m#/$#);
Download (untitled) / with headers
text/plain 256b
This change is in the development release that was just uploaded to CPAN. Sorry for the slowness in applying this. In fact, I pulled your commit from core, which is the preferred way of doing things now that the core is the canonical repository. --Steffen


This service is sponsored and maintained by Best Practical Solutions and runs on Perl.org infrastructure.

Please report any issues with rt.cpan.org to rt-cpan-admin@bestpractical.com.