| Subject: | [PATCH] add symlink support to Cwd::_vms_abs_path |
The attached adds symlink support to Cwd::_vms_abs_path. The patch is formulated against
blead and was checked into blead as #32053. I also fiddled with the tests a bit, but they still
pass on OS X as well as now passing on VMS.
| Subject: | cwd.patch.txt |
--- ext/Cwd/t/cwd.t;-0 Tue Jun 13 14:29:01 2006
+++ ext/Cwd/t/cwd.t Sat Oct 6 11:51:08 2007
@@ -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}) {
--- lib/Cwd.pm;-0 Thu Jun 14 09:13:53 2007
+++ lib/Cwd.pm Sat Oct 6 12:10:33 2007
@@ -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);
}