From: John E. Malmberg <wb8tyw@qsl.net>
Date: Sat, 11 Aug 2007 23:44:44 +0000 (-0500)
Subject: [patch@31670]File/Find.pm Find.t - VMS Symbolic Links Part 2 of ?
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=a1ccf0c4149bb99ed14901ae02b811f242bba527;p=p5sagit%2Fp5-mst-13.2.git

[patch@31670]File/Find.pm Find.t - VMS Symbolic Links Part 2 of ?
	From: "John E. Malmberg" <wb8tyw@qsl.net>
	Message-id: <46BE903C.90403@qsl.net>

VMS-specific File::Find changes to support symlinks

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

diff --git a/lib/File/Find.pm b/lib/File/Find.pm
index a923a6c..06fe587 100644
--- a/lib/File/Find.pm
+++ b/lib/File/Find.pm
@@ -603,6 +603,20 @@ sub _find_opt {
     local *_ = \my $a;
 
     my $cwd            = $wanted->{bydepth} ? Cwd::fastcwd() : Cwd::getcwd();
+    if ($Is_VMS) {
+	# VMS returns this by default in VMS format which just doesn't
+	# work for the rest of this module.
+	$cwd = VMS::Filespec::unixpath($cwd);
+
+	# Apparently this is not expected to have a trailing space.
+	# To attempt to make VMS/UNIX conversions mostly reversable,
+	# a trailing slash is needed.  The run-time functions ignore the
+	# resulting double slash, but it causes the perl tests to fail.
+        $cwd =~ s#/\z##;
+
+	# This comes up in upper case now, but should be lower.
+	# In the future this could be exact case, no need to change.
+    }
     my $cwd_untainted  = $cwd;
     my $check_t_cwd    = 1;
     $wanted_callback   = $wanted->{wanted};
@@ -670,6 +684,7 @@ sub _find_opt {
 		    $abs_dir = $cwd;
 		}
 		else {  # care about any  ../
+		    $top_item =~ s/\.dir\z//i if $Is_VMS;
 		    $abs_dir = contract_name("$cwd/",$top_item);
 		}
 	    }
@@ -686,6 +701,7 @@ sub _find_opt {
 	    }
 
 	    if (-d _) {
+		$top_item =~ s/\.dir\z//i if $Is_VMS;
 		_find_dir_symlnk($wanted, $abs_dir, $top_item);
 		$Is_Dir= 1;
 	    }
@@ -781,6 +797,14 @@ sub _find_dir($$$) {
     } elsif ($^O eq 'MSWin32') {
 	$dir_pref = ($p_dir =~ m|\w:/$| ? $p_dir : "$p_dir/" );
     } elsif ($^O eq 'VMS') {
+
+	#	VMS is returning trailing .dir on directories
+	#	and trailing . on files and symbolic links
+	#	in UNIX syntax.
+	#
+
+	$p_dir =~ s/\.(dir)?$//i unless $p_dir eq '.';
+
 	$dir_pref = ($p_dir =~ m/[\]>]+$/ ? $p_dir : "$p_dir/" );
     }
     else {
@@ -882,6 +906,14 @@ sub _find_dir($$$) {
 	if ($nlink == 2 && !$no_nlink) {
 	    # This dir has no subdirectories.
 	    for my $FN (@filenames) {
+		if ($Is_VMS) {
+		# Big hammer here - Compensate for VMS trailing . and .dir
+		# No win situation until this is changed, but this
+		# will handle the majority of the cases with breaking the fewest
+
+		    $FN =~ s/\.dir\z//i;
+		    $FN =~ s#\.$## if ($FN ne '.');
+		}
 		next if $FN =~ $File::Find::skip_pattern;
 		
 		$name = $dir_pref . $FN; # $File::Find::name
@@ -1125,6 +1157,14 @@ sub _find_dir_symlnk($$$) {
 	closedir(DIR);
 
 	for my $FN (@filenames) {
+	    if ($Is_VMS) {
+	    # Big hammer here - Compensate for VMS trailing . and .dir
+	    # No win situation until this is changed, but this
+	    # will handle the majority of the cases with breaking the fewest.
+
+		$FN =~ s/\.dir\z//i;
+		$FN =~ s#\.$## if ($FN ne '.');
+	    }
 	    next if $FN =~ $File::Find::skip_pattern;
 
 	    # follow symbolic links / do an lstat
@@ -1148,6 +1188,12 @@ sub _find_dir_symlnk($$$) {
 	    }
 
 	    if (-d _) {
+		if ($Is_VMS) {
+		    $FN =~ s/\.dir\z//i;
+		    $FN =~ s#\.$## if ($FN ne '.');
+		    $new_loc =~ s/\.dir\z//i;
+		    $new_loc =~ s#\.$## if ($new_loc ne '.');
+		}
 		push @Stack,[$new_loc,$updir_loc,$dir_name,$FN,1];
 	    }
 	    else {
diff --git a/lib/File/Find/t/find.t b/lib/File/Find/t/find.t
index 315ad31..404086e 100644
--- a/lib/File/Find/t/find.t
+++ b/lib/File/Find/t/find.t
@@ -124,6 +124,7 @@ sub MkDir($$) {
 sub wanted_File_Dir {
     printf "# \$File::Find::dir => '$File::Find::dir'\t\$_ => '$_'\n";
     s#\.$## if ($^O eq 'VMS' && $_ ne '.');
+    s/(.dir)?$//i if ($^O eq 'VMS' && -d _);
     Check( $Expect_File{$_} );
     if ( $FastFileTests_OK ) {
         delete $Expect_File{ $_} 
@@ -701,7 +702,7 @@ if ( $symlink_exists ) {
     undef $@;
     eval {File::Find::find( {wanted => \&simple_wanted, follow => 1,
                              no_chdir => 1}, topdir('fa') ); };
-    Check( $@ =~ m|for_find[:/]fa[:/]faa[:/]faa_sl is a recursive symbolic link| );  
+    Check( $@ =~ m|for_find[:/]fa[:/]faa[:/]faa_sl is a recursive symbolic link|i );  
     unlink file_path('fa', 'faa', 'faa_sl'); 
 
 
@@ -718,7 +719,7 @@ if ( $symlink_exists ) {
                                   follow_skip => 0, no_chdir => 1},
                                   topdir('fa') );};
 
-    Check( $@ =~ m|for_find[:/]fa[:/]fa_ord encountered a second time| );
+    Check( $@ =~ m|for_find[:/]fa[:/]fa_ord encountered a second time|i );
 
 
     # no_chdir is in effect, hence we use file_path_name to specify
@@ -767,7 +768,7 @@ if ( $symlink_exists ) {
                             follow_skip => 0, no_chdir => 1},
                             topdir('fa') );};
 
-    Check( $@ =~ m|for_find[:/]fa[:/]faa[:/]? encountered a second time| );
+    Check( $@ =~ m|for_find[:/]fa[:/]faa[:/]? encountered a second time|i );
 
   
     undef $@;
@@ -776,7 +777,7 @@ if ( $symlink_exists ) {
                             follow_skip => 1, no_chdir => 1},
                             topdir('fa') );};
 
-    Check( $@ =~ m|for_find[:/]fa[:/]faa[:/]? encountered a second time| );  
+    Check( $@ =~ m|for_find[:/]fa[:/]faa[:/]? encountered a second time|i );  
 
     # no_chdir is in effect, hence we use file_path_name to specify
     # the expected paths for %Expect_File