avoid MakeMaker setting $^W=1

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

diff --git a/lib/File/Find.pm b/lib/File/Find.pm
index 56ab798..42905de 100644 (file)
--- a/lib/File/Find.pm
+++ b/lib/File/Find.pm
@@ -1,5 +1,5 @@
 package File::Find;
-require 5.000;
+use 5.005_64;
 require Exporter;
 require Cwd;
 
@@ -53,12 +53,12 @@ If either I<follow> or I<follow_fast> is in effect:
 
 =over 6
 
-=item
+=item *
 
 It is guarantueed that an I<lstat> has been called before the user's
 I<wanted()> function is called. This enables fast file checks involving S< _>.
 
-=item
+=item *
 
 There is a variable C<$File::Find::fullname> which holds the absolute
 pathname of the file with all symbolic links resolved
@@ -122,6 +122,10 @@ When <follow> or <follow_fast> are in effect there is also a
 C<$File::Find::fullname>.
 The function may set C<$File::Find::prune> to prune the tree
 unless C<bydepth> was specified.
+Unless C<follow> or C<follow_fast> is specified, for compatibility
+reasons (find.pl, find2perl) there are in addition the following globals
+available: C<$File::Find::topdir>, C<$File::Find::topdev>, C<$File::Find::topino>,
+C<$File::Find::topmode> and C<$File::Find::topnlink>.
 
 This library is useful for the C<find2perl> tool, which when fed,
 
@@ -266,7 +270,7 @@ sub Follow_SymLink($) {
     return $AbsName;
 }
 
-use vars qw/ $dir $name $fullname $prune /;
+our($dir, $name, $fullname, $prune);
 sub _find_dir_symlnk($$$);
 sub _find_dir($$$);
 
@@ -286,6 +290,8 @@ sub _find_opt {
     $untaint_pat      = $wanted->{untaint_pattern};
     $untaint_skip     = $wanted->{untaint_skip};
 
+    # for compatability reasons (find.pl, find2perl)
+    our ($topdir, $topdev, $topino, $topmode, $topnlink);
 
     # a symbolic link to a directory doesn't increase the link count
     $avoid_nlink      = $follow || $File::Find::dont_use_nlink;
@@ -295,14 +301,16 @@ sub _find_opt {
        die "insecure cwd in find(depth)"  unless defined($cwd_untainted);
     }
     
-    my ($abs_dir, $nlink, $Is_Dir);
+    my ($abs_dir, $Is_Dir);
 
     Proc_Top_Item:
     foreach my $TOP (@_) {
         my $top_item = $TOP;
-        $top_item =~ s|/$||;
+        $top_item =~ s|/$||  unless $top_item eq '/';
         $Is_Dir= 0;
         
+        ($topdev,$topino,$topmode,$topnlink) = stat $top_item;
+
         if ($follow) {
             if (substr($top_item,0,1) eq '/') {
                 $abs_dir = $top_item;
@@ -324,14 +332,14 @@ sub _find_opt {
             }
         }
        else { # no follow
-            $nlink = (lstat $top_item)[3];
-            unless (defined $nlink) {
+            $topdir = $top_item;
+            unless (defined $topnlink) {
                 warn "Can't stat $top_item: $!\n";
                 next Proc_Top_Item;
             }
             if (-d _) {
                $top_item =~ s/\.dir$// if $Is_VMS;
-               _find_dir($wanted, $top_item, $nlink);
+               _find_dir($wanted, $top_item, $topnlink);
                $Is_Dir= 1;
             }
            else {
@@ -388,6 +396,7 @@ sub _find_dir($$$) {
     my ($subcount,$sub_nlink);
     my $SE= [];
     my $dir_name= $p_dir;
+    my $dir_pref= ( $p_dir eq '/' ? '/' : "$p_dir/" );
     my $dir_rel= '.';      # directory name relative to current directory
 
     local ($dir, $name, $prune, *DIR);
@@ -429,12 +438,16 @@ sub _find_dir($$$) {
                $udir = $1 if $dir_rel =~ m|$untaint_pat|;
                unless (defined $udir) {
                    if ($untaint_skip == 0) {
-                       die "directory ($p_dir/) $dir_rel is still tainted";
+                       die "directory ("
+                           . ($p_dir ne '/' ? $p_dir : '')
+                           . "/) $dir_rel is still tainted";
                    }
                }
            }
            unless (chdir $udir) {
-               warn "Can't cd to ($p_dir/) $udir : $!\n";
+               warn "Can't cd to ("
+                   . ($p_dir ne '/' ? $p_dir : '')
+                   . "/) $udir : $!\n";
                next;
            }
            $CdLvl++;
@@ -455,7 +468,7 @@ sub _find_dir($$$) {
            for my $FN (@filenames) {
                next if $FN =~ /^\.{1,2}$/;
                
-               $name = "$dir_name/$FN";
+               $name = $dir_pref . $FN;
                $_ = ($no_chdir ? $name : $FN);
                &$wanted_callback;
            }
@@ -471,7 +484,7 @@ sub _find_dir($$$) {
                    # Seen all the subdirs?
                    # check for directoriness.
                    # stat is faster for a file in the current directory
-                   $sub_nlink = (lstat ($no_chdir ? "$dir_name/$FN" : $FN))[3];
+                   $sub_nlink = (lstat ($no_chdir ? $dir_pref . $FN : $FN))[3];
 
                    if (-d _) {
                        --$subcount;
@@ -479,12 +492,13 @@ sub _find_dir($$$) {
                        push @Stack,[$CdLvl,$dir_name,$FN,$sub_nlink];
                    }
                    else {
-                       $name = "$dir_name/$FN";
+                       $name = $dir_pref . $FN;
                        $_= ($no_chdir ? $name : $FN);
                        &$wanted_callback;
                    }
                }
-               else { $name = "$dir_name/$FN";
+               else {
+                   $name = $dir_pref . $FN;
                    $_= ($no_chdir ? $name : $FN);
                    &$wanted_callback;
                }
@@ -505,7 +519,8 @@ sub _find_dir($$$) {
                    unless  chdir '../' x ($CdLvl-$Level);
                $CdLvl = $Level;
            }
-           $dir_name = "$p_dir/$dir_rel";
+           $dir_name = ($p_dir eq '/' ? "/$dir_rel" : "$p_dir/$dir_rel");
+           $dir_pref = "$dir_name/";
        }
     }
 }
@@ -525,6 +540,8 @@ sub _find_dir_symlnk($$$) {
     my $new_loc;
     my $SE = [];
     my $dir_name = $p_dir;
+    my $dir_pref = ( $p_dir   eq '/' ? '/' : "$p_dir/" );
+    my $loc_pref = ( $dir_loc eq '/' ? '/' : "$dir_loc/" );
     my $dir_rel = '.';         # directory name relative to current directory
 
     local ($dir, $name, $fullname, $prune, *DIR);
@@ -595,7 +612,7 @@ sub _find_dir_symlnk($$$) {
            next if $FN =~ /^\.{1,2}$/;
 
            # follow symbolic links / do an lstat
-           $new_loc= Follow_SymLink("$dir_loc/$FN");
+           $new_loc = Follow_SymLink($loc_pref.$FN);
 
            # ignore if invalid symlink
            next unless defined $new_loc;
@@ -605,7 +622,7 @@ sub _find_dir_symlnk($$$) {
            }
            else {
                $fullname = $new_loc;
-               $name = "$dir_name/$FN";
+               $name = $dir_pref . $FN;
                $_ = ($no_chdir ? $name : $FN);
                &$wanted_callback;
            }
@@ -621,7 +638,9 @@ sub _find_dir_symlnk($$$) {
     continue {
        if (defined($SE = pop @Stack)) {
            ($dir_loc, $p_dir, $dir_rel) = @$SE;
-           $dir_name = "$p_dir/$dir_rel";
+           $dir_name = ($p_dir eq '/' ? "/$dir_rel" : "$p_dir/$dir_rel");
+           $dir_pref = "$dir_name/";
+           $loc_pref = "$dir_loc/";
        }
     }
 }