From: Information Service <info@lingo.kiev.ua>
Date: Wed, 9 Oct 2002 07:17:00 +0000 (+0400)
Subject: [perl #17751] File::Spec::Win32::canonpath patch try#3
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=cc23144fb7132c5baf97c1abe756f338a4d71959;p=p5sagit%2Fp5-mst-13.2.git

[perl #17751] File::Spec::Win32::canonpath patch try#3
Message-ID: <3DA39FAC.85471200@lingo.kiev.ua>

p4raw-id: //depot/perl@17997
---

diff --git a/lib/File/Spec/Win32.pm b/lib/File/Spec/Win32.pm
index 791b004..7c22758 100644
--- a/lib/File/Spec/Win32.pm
+++ b/lib/File/Spec/Win32.pm
@@ -113,11 +113,16 @@ sub path {
 
 No physical check on the filesystem, but a logical cleanup of a
 path. On UNIX eliminated successive slashes and successive "/.".
+On Win32 makes 
+
+	dir1\dir2\dir3\..\..\dir4 -> \dir\dir4 and even
+	dir1\dir2\dir3\...\dir4   -> \dir\dir4
 
 =cut
 
 sub canonpath {
     my ($self,$path) = @_;
+    my $orig_path = $path;
     $path =~ s/^([a-z]:)/\u$1/s;
     $path =~ s|/|\\|g;
     $path =~ s|([^\\])\\+|$1\\|g;                  # xx\\\\xx  -> xx\xx
@@ -125,6 +130,38 @@ sub canonpath {
     $path =~ s|^(\.\\)+||s unless $path eq ".\\";  # .\xx      -> xx
     $path =~ s|\\\Z(?!\n)||
              unless $path =~ m#^([A-Z]:)?\\\Z(?!\n)#s;   # xx\       -> xx
+	# xx1/xx2/xx3/../../xx -> xx1/xx
+	$path =~ s|\\\.\.\.\\|\\\.\.\\\.\.\\|g; # \...\ is 2 levels up
+	$path =~ s|^\.\.\.\\|\.\.\\\.\.\\|g;    # ...\ is 2 levels up
+	return $path if $path =~ m|^\.\.|;      # skip relative paths
+	return $path unless $path =~ /\.\./;    # too few .'s to cleanup
+	return $path if $path =~ /\.\.\.\./;    # too many .'s to cleanup
+	return $path if $orig_path =~ m|^\Q/../\E|
+			        and $orig_path =~ m|\/$|;  # don't do /../dirs/ 
+			        						   # when called from rel2abs()
+			        						   # for ../dirs/
+	my ($vol,$dirs,$file) = $self->splitpath($path);
+	my @dirs = $self->splitdir($dirs);
+	my (@base_dirs, @path_dirs);
+	my $dest = \@base_dirs;
+	for my $dir (@dirs){
+		$dest = \@path_dirs if $dir eq $self->updir;
+		push @$dest, $dir;
+	}
+	# for each .. in @path_dirs pop one item from 
+	# @base_dirs
+	while (my $dir = shift @path_dirs){ 
+		unless ($dir eq $self->updir){
+			unshift @path_dirs, $dir;
+			last;
+		}
+		pop @base_dirs;
+	}
+	$path = $self->catpath( 
+		$vol, 
+		$self->catdir(@base_dirs, @path_dirs), 
+		$file
+    );
     return $path;
 }
 
diff --git a/lib/File/Spec/t/Spec.t b/lib/File/Spec/t/Spec.t
index 35b2e6f..b6331ce 100644
--- a/lib/File/Spec/t/Spec.t
+++ b/lib/File/Spec/t/Spec.t
@@ -202,8 +202,12 @@ if ($^O eq 'MacOS') {
 [ "Win32->canonpath('////')",           '\\\\\\'              ],
 [ "Win32->canonpath('//')",             '\\'                  ],
 [ "Win32->canonpath('/.')",             '\\.'                 ],
-[ "Win32->canonpath('//a/b/../../c')",  '\\\\a\\b\\..\\..\\c' ],
-[ "Win32->canonpath('//a/../../c')",    '\\\\a\\..\\..\\c'    ],
+[ "Win32->canonpath('//a/b/../../c')",  '\\\\a\\b\\c'         ],
+[ "Win32->canonpath('//a/b/c/../d')",   '\\\\a\\b\\d'         ],
+[ "Win32->canonpath('//a/b/c/../../d')",'\\\\a\\b\\d'         ],
+[ "Win32->canonpath('//a/b/c/.../d')",  '\\\\a\\b\\d'         ],
+[ "Win32->canonpath('/a/b/c/../../d')", '\\a\\d'              ],
+[ "Win32->canonpath('/a/b/c/.../d')",   '\\a\\d'              ],
 
 ## Hmmm, we should test missing and relative base paths some day...
 ## would need to cd to a known place, get the cwd() and use it I
@@ -226,13 +230,12 @@ if ($^O eq 'MacOS') {
 [ "Win32->rel2abs('temp','C:/')",                       'C:\\temp'                        ],
 [ "Win32->rel2abs('temp','C:/a')",                      'C:\\a\\temp'                     ],
 [ "Win32->rel2abs('temp','C:/a/')",                     'C:\\a\\temp'                     ],
-[ "Win32->rel2abs('../','C:/')",                        'C:\\..'                          ],
-[ "Win32->rel2abs('../','C:/a')",                       'C:\\a\\..'                       ],
+[ "Win32->rel2abs('../','C:/')",                        'C:\\'                            ],
+[ "Win32->rel2abs('../','C:/a')",                       'C:\\'                            ],
 [ "Win32->rel2abs('temp','//prague_main/work/')",       '\\\\prague_main\\work\\temp'     ],
-[ "Win32->rel2abs('../temp','//prague_main/work/')",    '\\\\prague_main\\work\\..\\temp' ],
+[ "Win32->rel2abs('../temp','//prague_main/work/')",    '\\\\prague_main\\work\\temp'     ],
 [ "Win32->rel2abs('temp','//prague_main/work')",        '\\\\prague_main\\work\\temp'     ],
-[ "Win32->rel2abs('../','//prague_main/work')",         '\\\\prague_main\\work\\..'       ],
-
+[ "Win32->rel2abs('../','//prague_main/work')",         '\\\\prague_main\\work'           ],
 
 [ "VMS->catfile('a','b','c')",         '[.a.b]c'  ],
 [ "VMS->catfile('a','b','[]c')",       '[.a.b]c'  ],