diff options
author | John E. Malmberg <wb8tyw@qsl.net> | 2007-08-11 18:44:44 -0500 |
---|---|---|
committer | Craig A. Berry <craigberry@mac.com> | 2007-08-13 03:04:37 +0000 |
commit | a1ccf0c4149bb99ed14901ae02b811f242bba527 (patch) | |
tree | 9cd047a2b86748b1b3162454094f9f32eecc1d71 /lib/File/Find.pm | |
parent | 679ad62ddea1877bd96eafca271767acf6241fd7 (diff) | |
download | perl-a1ccf0c4149bb99ed14901ae02b811f242bba527.tar.gz |
[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
Diffstat (limited to 'lib/File/Find.pm')
-rw-r--r-- | lib/File/Find.pm | 46 |
1 files changed, 46 insertions, 0 deletions
diff --git a/lib/File/Find.pm b/lib/File/Find.pm index a923a6c582..06fe587ae9 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 { |