From: Craig A. Berry <craigberry@mac.com>
Date: Sat, 6 Oct 2007 18:28:59 +0000 (+0000)
Subject: Add symlink support to Cwd::_vms_abs_path.
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=617299157e790993f5e44437d5a60d79f697645c;p=p5sagit%2Fp5-mst-13.2.git

Add symlink support to Cwd::_vms_abs_path.

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

diff --git a/ext/Cwd/t/cwd.t b/ext/Cwd/t/cwd.t
index 4ec7b9a..148682a 100644
--- a/ext/Cwd/t/cwd.t
+++ b/ext/Cwd/t/cwd.t
@@ -173,14 +173,18 @@ SKIP: {
 
     my $abs_path      =  Cwd::abs_path("linktest");
     my $fast_abs_path =  Cwd::fast_abs_path("linktest");
-    my $want          =  File::Spec->catdir("t", $Test_Dir);
+    my $want          =  quotemeta(
+                             File::Spec->rel2abs(
+			         $ENV{PERL_CORE} ? $Test_Dir : File::Spec->catdir('t', $Test_Dir)
+                                                )
+                                  );
 
-    like($abs_path,      qr|$want$|);
-    like($fast_abs_path, qr|$want$|);
-    like(Cwd::_perl_abs_path("linktest"), qr|$want$|) if $EXTRA_ABSPATH_TESTS;
+    like($abs_path,      qr|$want$|i);
+    like($fast_abs_path, qr|$want$|i);
+    like(Cwd::_perl_abs_path("linktest"), qr|$want$|i) if $EXTRA_ABSPATH_TESTS;
 
     rmtree($test_dirs[0], 0, 0);
-    unlink "linktest";
+    1 while unlink "linktest";
 }
 
 if ($ENV{PERL_CORE}) {
diff --git a/lib/Cwd.pm b/lib/Cwd.pm
index a4ef00c..2053f05 100644
--- a/lib/Cwd.pm
+++ b/lib/Cwd.pm
@@ -171,7 +171,7 @@ use strict;
 use Exporter;
 use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION);
 
-$VERSION = '3.25';
+$VERSION = '3.25_01';
 
 @ISA = qw/ Exporter /;
 @EXPORT = qw(cwd getcwd fastcwd fastgetcwd);
@@ -644,11 +644,19 @@ sub _vms_cwd {
 
 sub _vms_abs_path {
     return $ENV{'DEFAULT'} unless @_;
+    my $path = shift;
 
-    # may need to turn foo.dir into [.foo]
-    my $path = VMS::Filespec::pathify($_[0]);
-    $path = $_[0] unless defined $path;
+    if (-l $path) {
+        my $link_target = readlink($path);
+        die "Can't resolve link $path: $!" unless defined $link_target;
+	    
+        return _vms_abs_path($link_target);
+    }
 
+    # may need to turn foo.dir into [.foo]
+    my $pathified = VMS::Filespec::pathify($path);
+    $path = $pathified if defined $pathified;
+	
     return VMS::Filespec::rmsexpand($path);
 }