Some escapes were mentioned twice, although they're not qr//-specific

[p5sagit/p5-mst-13.2.git] / lib / File / Find.pm

diff --git a/lib/File/Find.pm b/lib/File/Find.pm
index 9c81c6a..06fe587 100644 (file)
--- a/lib/File/Find.pm
+++ b/lib/File/Find.pm
@@ -3,7 +3,7 @@ use 5.006;
 use strict;
 use warnings;
 use warnings::register;
-our $VERSION = '1.10';
+our $VERSION = '1.11';
 require Exporter;
 require Cwd;
 
@@ -56,7 +56,7 @@ C<&wanted> function on each file or subdirectory in the directory.
   finddepth(\&wanted,  @directories);
   finddepth(\%options, @directories);
 
-C<finddepth()> works just like C<find()> except that is invokes the
+C<finddepth()> works just like C<find()> except that it invokes the
 C<&wanted> function for a directory I<after> invoking it for the
 directory's contents.  It does a postorder traversal instead of a
 preorder traversal, working from the bottom of the directory tree up
@@ -215,6 +215,9 @@ through a collection of variables.
 
 =back
 
+The above variables have all been localized and may be changed without
+effecting data outside of the wanted function.
+
 For example, when examining the file F</some/path/foo.ext> you will have:
 
     $File::Find::dir  = /some/path/
@@ -237,18 +240,6 @@ table below summarizes all variants:
               /etc               /                 /etc
               /etc/x             /etc              /etc/x
 
-Do not modify these variables. If you want to use C<$_>, it must
-be restored to its initial value before returning from the
-function. C<local> may be used for this purpose:
-
-  sub callback {
-    open my $fh, '<', $_ or die "Cannot open $_ for input: $!\n";
-    local $_; # localize $_ for the remainder of the routine
-    while (<$fh>) {
-      # manipulate $_
-    }
-    # $_ will be restored upon leaving
-  }
 
 When <follow> or <follow_fast> are in effect, there is
 also a C<$File::Find::fullname>.  The function may set
@@ -612,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};
@@ -679,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);
                }
            }
@@ -695,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;
            }
@@ -789,6 +796,16 @@ 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/" );
+    } 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 {
        $dir_pref= ( $p_dir eq '/' ? '/' : "$p_dir/" );
@@ -889,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
@@ -962,6 +987,17 @@ sub _find_dir($$$) {
                $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/";
@@ -1121,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
@@ -1128,7 +1172,7 @@ sub _find_dir_symlnk($$$) {
 
            # ignore if invalid symlink
            unless (defined $new_loc) {
-               if ($dangling_symlinks) {
+               if (!defined -l _ && $dangling_symlinks) {
                    if (ref $dangling_symlinks eq 'CODE') {
                        $dangling_symlinks->($FN, $dir_pref);
                    } else {
@@ -1144,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 {