This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
For VMS, a belated entry into the $^O jungle that is File::Find::_find_dir.
authorCraig A. Berry <craigberry@mac.com>
Sat, 27 Jan 2007 17:19:12 +0000 (17:19 +0000)
committerCraig A. Berry <craigberry@mac.com>
Sat, 27 Jan 2007 17:19:12 +0000 (17:19 +0000)
p4raw-id: //depot/perl@30035

lib/File/Find.pm

index 77a4bab..a923a6c 100644 (file)
@@ -780,6 +780,8 @@ sub _find_dir($$$) {
        $dir_pref= ($p_dir =~ /:$/) ? $p_dir : "$p_dir:"; # preface
     } elsif ($^O eq 'MSWin32') {
        $dir_pref = ($p_dir =~ m|\w:/$| ? $p_dir : "$p_dir/" );
        $dir_pref= ($p_dir =~ /:$/) ? $p_dir : "$p_dir:"; # preface
     } elsif ($^O eq 'MSWin32') {
        $dir_pref = ($p_dir =~ m|\w:/$| ? $p_dir : "$p_dir/" );
+    } elsif ($^O eq 'VMS') {
+       $dir_pref = ($p_dir =~ m/[\]>]+$/ ? $p_dir : "$p_dir/" );
     }
     else {
        $dir_pref= ( $p_dir eq '/' ? '/' : "$p_dir/" );
     }
     else {
        $dir_pref= ( $p_dir eq '/' ? '/' : "$p_dir/" );
@@ -953,6 +955,17 @@ sub _find_dir($$$) {
                $dir_name = ($p_dir =~ m|\w:/$| ? "$p_dir$dir_rel" : "$p_dir/$dir_rel");
                $dir_pref = "$dir_name/";
            }
                $dir_name = ($p_dir =~ m|\w:/$| ? "$p_dir$dir_rel" : "$p_dir/$dir_rel");
                $dir_pref = "$dir_name/";
            }
+           elsif ($^O eq 'VMS') {
+                if ($p_dir =~ m/[\]>]+$/) {
+                    $dir_name = $p_dir;
+                    $dir_name =~ s/([\]>]+)$/.$dir_rel$1/;
+                    $dir_pref = $dir_name;
+                }
+                else {
+                    $dir_name = "$p_dir/$dir_rel";
+                    $dir_pref = "$dir_name/";
+                }
+           }
            else {
                $dir_name = ($p_dir eq '/' ? "/$dir_rel" : "$p_dir/$dir_rel");
                $dir_pref = "$dir_name/";
            else {
                $dir_name = ($p_dir eq '/' ? "/$dir_rel" : "$p_dir/$dir_rel");
                $dir_pref = "$dir_name/";