(perl #133673) disable the File::Find nlink optimization by default
[perl.git] / ext / File-Find / lib / File / Find.pm
1 package File::Find;
2 use 5.006;
3 use strict;
4 use warnings;
5 use warnings::register;
6 our $VERSION = '1.35';
7 require Exporter;
8 require Cwd;
9
10 our @ISA = qw(Exporter);
11 our @EXPORT = qw(find finddepth);
12
13
14 use strict;
15 my $Is_VMS;
16 my $Is_Win32;
17
18 require File::Basename;
19 require File::Spec;
20
21 # Should ideally be my() not our() but local() currently
22 # refuses to operate on lexicals
23
24 our %SLnkSeen;
25 our ($wanted_callback, $avoid_nlink, $bydepth, $no_chdir, $follow,
26     $follow_skip, $full_check, $untaint, $untaint_skip, $untaint_pat,
27     $pre_process, $post_process, $dangling_symlinks);
28
29 sub contract_name {
30     my ($cdir,$fn) = @_;
31
32     return substr($cdir,0,rindex($cdir,'/')) if $fn eq $File::Find::current_dir;
33
34     $cdir = substr($cdir,0,rindex($cdir,'/')+1);
35
36     $fn =~ s|^\./||;
37
38     my $abs_name= $cdir . $fn;
39
40     if (substr($fn,0,3) eq '../') {
41        1 while $abs_name =~ s!/[^/]*/\.\./+!/!;
42     }
43
44     return $abs_name;
45 }
46
47 sub PathCombine($$) {
48     my ($Base,$Name) = @_;
49     my $AbsName;
50
51     if (substr($Name,0,1) eq '/') {
52         $AbsName= $Name;
53     }
54     else {
55         $AbsName= contract_name($Base,$Name);
56     }
57
58     # (simple) check for recursion
59     my $newlen= length($AbsName);
60     if ($newlen <= length($Base)) {
61         if (($newlen == length($Base) || substr($Base,$newlen,1) eq '/')
62             && $AbsName eq substr($Base,0,$newlen))
63         {
64             return undef;
65         }
66     }
67     return $AbsName;
68 }
69
70 sub Follow_SymLink($) {
71     my ($AbsName) = @_;
72
73     my ($NewName,$DEV, $INO);
74     ($DEV, $INO)= lstat $AbsName;
75
76     while (-l _) {
77         if ($SLnkSeen{$DEV, $INO}++) {
78             if ($follow_skip < 2) {
79                 die "$AbsName is encountered a second time";
80             }
81             else {
82                 return undef;
83             }
84         }
85         $NewName= PathCombine($AbsName, readlink($AbsName));
86         unless(defined $NewName) {
87             if ($follow_skip < 2) {
88                 die "$AbsName is a recursive symbolic link";
89             }
90             else {
91                 return undef;
92             }
93         }
94         else {
95             $AbsName= $NewName;
96         }
97         ($DEV, $INO) = lstat($AbsName);
98         return undef unless defined $DEV;  #  dangling symbolic link
99     }
100
101     if ($full_check && defined $DEV && $SLnkSeen{$DEV, $INO}++) {
102         if ( ($follow_skip < 1) || ((-d _) && ($follow_skip < 2)) ) {
103             die "$AbsName encountered a second time";
104         }
105         else {
106             return undef;
107         }
108     }
109
110     return $AbsName;
111 }
112
113 our($dir, $name, $fullname, $prune);
114 sub _find_dir_symlnk($$$);
115 sub _find_dir($$$);
116
117 # check whether or not a scalar variable is tainted
118 # (code straight from the Camel, 3rd ed., page 561)
119 sub is_tainted_pp {
120     my $arg = shift;
121     my $nada = substr($arg, 0, 0); # zero-length
122     local $@;
123     eval { eval "# $nada" };
124     return length($@) != 0;
125 }
126
127 sub _find_opt {
128     my $wanted = shift;
129     return unless @_;
130     die "invalid top directory" unless defined $_[0];
131
132     # This function must local()ize everything because callbacks may
133     # call find() or finddepth()
134
135     local %SLnkSeen;
136     local ($wanted_callback, $avoid_nlink, $bydepth, $no_chdir, $follow,
137         $follow_skip, $full_check, $untaint, $untaint_skip, $untaint_pat,
138         $pre_process, $post_process, $dangling_symlinks);
139     local($dir, $name, $fullname, $prune);
140     local *_ = \my $a;
141
142     my $cwd            = $wanted->{bydepth} ? Cwd::fastcwd() : Cwd::getcwd();
143     if ($Is_VMS) {
144         # VMS returns this by default in VMS format which just doesn't
145         # work for the rest of this module.
146         $cwd = VMS::Filespec::unixpath($cwd);
147
148         # Apparently this is not expected to have a trailing space.
149         # To attempt to make VMS/UNIX conversions mostly reversible,
150         # a trailing slash is needed.  The run-time functions ignore the
151         # resulting double slash, but it causes the perl tests to fail.
152         $cwd =~ s#/\z##;
153
154         # This comes up in upper case now, but should be lower.
155         # In the future this could be exact case, no need to change.
156     }
157     my $cwd_untainted  = $cwd;
158     my $check_t_cwd    = 1;
159     $wanted_callback   = $wanted->{wanted};
160     $bydepth           = $wanted->{bydepth};
161     $pre_process       = $wanted->{preprocess};
162     $post_process      = $wanted->{postprocess};
163     $no_chdir          = $wanted->{no_chdir};
164     $full_check        = $Is_Win32 ? 0 : $wanted->{follow};
165     $follow            = $Is_Win32 ? 0 :
166                              $full_check || $wanted->{follow_fast};
167     $follow_skip       = $wanted->{follow_skip};
168     $untaint           = $wanted->{untaint};
169     $untaint_pat       = $wanted->{untaint_pattern};
170     $untaint_skip      = $wanted->{untaint_skip};
171     $dangling_symlinks = $wanted->{dangling_symlinks};
172
173     # for compatibility reasons (find.pl, find2perl)
174     local our ($topdir, $topdev, $topino, $topmode, $topnlink);
175
176     # a symbolic link to a directory doesn't increase the link count
177     $avoid_nlink      = $follow || $File::Find::dont_use_nlink;
178
179     my ($abs_dir, $Is_Dir);
180
181     Proc_Top_Item:
182     foreach my $TOP (@_) {
183         my $top_item = $TOP;
184         $top_item = VMS::Filespec::unixify($top_item) if $Is_VMS;
185
186         ($topdev,$topino,$topmode,$topnlink) = $follow ? stat $top_item : lstat $top_item;
187
188         if ($Is_Win32) {
189             $top_item =~ s|[/\\]\z||
190               unless $top_item =~ m{^(?:\w:)?[/\\]$};
191         }
192         else {
193             $top_item =~ s|/\z|| unless $top_item eq '/';
194         }
195
196         $Is_Dir= 0;
197
198         if ($follow) {
199
200             if (substr($top_item,0,1) eq '/') {
201                 $abs_dir = $top_item;
202             }
203             elsif ($top_item eq $File::Find::current_dir) {
204                 $abs_dir = $cwd;
205             }
206             else {  # care about any  ../
207                 $top_item =~ s/\.dir\z//i if $Is_VMS;
208                 $abs_dir = contract_name("$cwd/",$top_item);
209             }
210             $abs_dir= Follow_SymLink($abs_dir);
211             unless (defined $abs_dir) {
212                 if ($dangling_symlinks) {
213                     if (ref $dangling_symlinks eq 'CODE') {
214                         $dangling_symlinks->($top_item, $cwd);
215                     } else {
216                         warnings::warnif "$top_item is a dangling symbolic link\n";
217                     }
218                 }
219                 next Proc_Top_Item;
220             }
221
222             if (-d _) {
223                 $top_item =~ s/\.dir\z//i if $Is_VMS;
224                 _find_dir_symlnk($wanted, $abs_dir, $top_item);
225                 $Is_Dir= 1;
226             }
227         }
228         else { # no follow
229             $topdir = $top_item;
230             unless (defined $topnlink) {
231                 warnings::warnif "Can't stat $top_item: $!\n";
232                 next Proc_Top_Item;
233             }
234             if (-d _) {
235                 $top_item =~ s/\.dir\z//i if $Is_VMS;
236                 _find_dir($wanted, $top_item, $topnlink);
237                 $Is_Dir= 1;
238             }
239             else {
240                 $abs_dir= $top_item;
241             }
242         }
243
244         unless ($Is_Dir) {
245             unless (($_,$dir) = File::Basename::fileparse($abs_dir)) {
246                 ($dir,$_) = ('./', $top_item);
247             }
248
249             $abs_dir = $dir;
250             if (( $untaint ) && (is_tainted($dir) )) {
251                 ( $abs_dir ) = $dir =~ m|$untaint_pat|;
252                 unless (defined $abs_dir) {
253                     if ($untaint_skip == 0) {
254                         die "directory $dir is still tainted";
255                     }
256                     else {
257                         next Proc_Top_Item;
258                     }
259                 }
260             }
261
262             unless ($no_chdir || chdir $abs_dir) {
263                 warnings::warnif "Couldn't chdir $abs_dir: $!\n";
264                 next Proc_Top_Item;
265             }
266
267             $name = $abs_dir . $_; # $File::Find::name
268             $_ = $name if $no_chdir;
269
270             { $wanted_callback->() }; # protect against wild "next"
271
272         }
273
274         unless ( $no_chdir ) {
275             if ( ($check_t_cwd) && (($untaint) && (is_tainted($cwd) )) ) {
276                 ( $cwd_untainted ) = $cwd =~ m|$untaint_pat|;
277                 unless (defined $cwd_untainted) {
278                     die "insecure cwd in find(depth)";
279                 }
280                 $check_t_cwd = 0;
281             }
282             unless (chdir $cwd_untainted) {
283                 die "Can't cd to $cwd: $!\n";
284             }
285         }
286     }
287 }
288
289 # API:
290 #  $wanted
291 #  $p_dir :  "parent directory"
292 #  $nlink :  what came back from the stat
293 # preconditions:
294 #  chdir (if not no_chdir) to dir
295
296 sub _find_dir($$$) {
297     my ($wanted, $p_dir, $nlink) = @_;
298     my ($CdLvl,$Level) = (0,0);
299     my @Stack;
300     my @filenames;
301     my ($subcount,$sub_nlink);
302     my $SE= [];
303     my $dir_name= $p_dir;
304     my $dir_pref;
305     my $dir_rel = $File::Find::current_dir;
306     my $tainted = 0;
307     my $no_nlink;
308
309     if ($Is_Win32) {
310         $dir_pref
311           = ($p_dir =~ m{^(?:\w:[/\\]?|[/\\])$} ? $p_dir : "$p_dir/" );
312     } elsif ($Is_VMS) {
313
314         #       VMS is returning trailing .dir on directories
315         #       and trailing . on files and symbolic links
316         #       in UNIX syntax.
317         #
318
319         $p_dir =~ s/\.(dir)?$//i unless $p_dir eq '.';
320
321         $dir_pref = ($p_dir =~ m/[\]>]+$/ ? $p_dir : "$p_dir/" );
322     }
323     else {
324         $dir_pref= ( $p_dir eq '/' ? '/' : "$p_dir/" );
325     }
326
327     local ($dir, $name, $prune, *DIR);
328
329     unless ( $no_chdir || ($p_dir eq $File::Find::current_dir)) {
330         my $udir = $p_dir;
331         if (( $untaint ) && (is_tainted($p_dir) )) {
332             ( $udir ) = $p_dir =~ m|$untaint_pat|;
333             unless (defined $udir) {
334                 if ($untaint_skip == 0) {
335                     die "directory $p_dir is still tainted";
336                 }
337                 else {
338                     return;
339                 }
340             }
341         }
342         unless (chdir ($Is_VMS && $udir !~ /[\/\[<]+/ ? "./$udir" : $udir)) {
343             warnings::warnif "Can't cd to $udir: $!\n";
344             return;
345         }
346     }
347
348     # push the starting directory
349     push @Stack,[$CdLvl,$p_dir,$dir_rel,-1]  if  $bydepth;
350
351     while (defined $SE) {
352         unless ($bydepth) {
353             $dir= $p_dir; # $File::Find::dir
354             $name= $dir_name; # $File::Find::name
355             $_= ($no_chdir ? $dir_name : $dir_rel ); # $_
356             # prune may happen here
357             $prune= 0;
358             { $wanted_callback->() };   # protect against wild "next"
359             next if $prune;
360         }
361
362         # change to that directory
363         unless ($no_chdir || ($dir_rel eq $File::Find::current_dir)) {
364             my $udir= $dir_rel;
365             if ( ($untaint) && (($tainted) || ($tainted = is_tainted($dir_rel) )) ) {
366                 ( $udir ) = $dir_rel =~ m|$untaint_pat|;
367                 unless (defined $udir) {
368                     if ($untaint_skip == 0) {
369                         die "directory (" . ($p_dir ne '/' ? $p_dir : '') . "/) $dir_rel is still tainted";
370                     } else { # $untaint_skip == 1
371                         next;
372                     }
373                 }
374             }
375             unless (chdir ($Is_VMS && $udir !~ /[\/\[<]+/ ? "./$udir" : $udir)) {
376                 warnings::warnif "Can't cd to (" .
377                     ($p_dir ne '/' ? $p_dir : '') . "/) $udir: $!\n";
378                 next;
379             }
380             $CdLvl++;
381         }
382
383         $dir= $dir_name; # $File::Find::dir
384
385         # Get the list of files in the current directory.
386         unless (opendir DIR, ($no_chdir ? $dir_name : $File::Find::current_dir)) {
387             warnings::warnif "Can't opendir($dir_name): $!\n";
388             next;
389         }
390         @filenames = readdir DIR;
391         closedir(DIR);
392         @filenames = $pre_process->(@filenames) if $pre_process;
393         push @Stack,[$CdLvl,$dir_name,"",-2]   if $post_process;
394
395         # default: use whatever was specified
396         # (if $nlink >= 2, and $avoid_nlink == 0, this will switch back)
397         $no_nlink = $avoid_nlink;
398         # if dir has wrong nlink count, force switch to slower stat method
399         $no_nlink = 1 if ($nlink < 2);
400
401         if ($nlink == 2 && !$no_nlink) {
402             # This dir has no subdirectories.
403             for my $FN (@filenames) {
404                 if ($Is_VMS) {
405                 # Big hammer here - Compensate for VMS trailing . and .dir
406                 # No win situation until this is changed, but this
407                 # will handle the majority of the cases with breaking the fewest
408
409                     $FN =~ s/\.dir\z//i;
410                     $FN =~ s#\.$## if ($FN ne '.');
411                 }
412                 next if $FN =~ $File::Find::skip_pattern;
413                 
414                 $name = $dir_pref . $FN; # $File::Find::name
415                 $_ = ($no_chdir ? $name : $FN); # $_
416                 { $wanted_callback->() }; # protect against wild "next"
417             }
418
419         }
420         else {
421             # This dir has subdirectories.
422             $subcount = $nlink - 2;
423
424             # HACK: insert directories at this position, so as to preserve
425             # the user pre-processed ordering of files (thus ensuring
426             # directory traversal is in user sorted order, not at random).
427             my $stack_top = @Stack;
428
429             for my $FN (@filenames) {
430                 next if $FN =~ $File::Find::skip_pattern;
431                 if ($subcount > 0 || $no_nlink) {
432                     # Seen all the subdirs?
433                     # check for directoriness.
434                     # stat is faster for a file in the current directory
435                     $sub_nlink = (lstat ($no_chdir ? $dir_pref . $FN : $FN))[3];
436
437                     if (-d _) {
438                         --$subcount;
439                         $FN =~ s/\.dir\z//i if $Is_VMS;
440                         # HACK: replace push to preserve dir traversal order
441                         #push @Stack,[$CdLvl,$dir_name,$FN,$sub_nlink];
442                         splice @Stack, $stack_top, 0,
443                                  [$CdLvl,$dir_name,$FN,$sub_nlink];
444                     }
445                     else {
446                         $name = $dir_pref . $FN; # $File::Find::name
447                         $_= ($no_chdir ? $name : $FN); # $_
448                         { $wanted_callback->() }; # protect against wild "next"
449                     }
450                 }
451                 else {
452                     $name = $dir_pref . $FN; # $File::Find::name
453                     $_= ($no_chdir ? $name : $FN); # $_
454                     { $wanted_callback->() }; # protect against wild "next"
455                 }
456             }
457         }
458     }
459     continue {
460         while ( defined ($SE = pop @Stack) ) {
461             ($Level, $p_dir, $dir_rel, $nlink) = @$SE;
462             if ($CdLvl > $Level && !$no_chdir) {
463                 my $tmp;
464                 if ($Is_VMS) {
465                     $tmp = '[' . ('-' x ($CdLvl-$Level)) . ']';
466                 }
467                 else {
468                     $tmp = join('/',('..') x ($CdLvl-$Level));
469                 }
470                 die "Can't cd to $tmp from $dir_name: $!"
471                     unless chdir ($tmp);
472                 $CdLvl = $Level;
473             }
474
475             if ($Is_Win32) {
476                 $dir_name = ($p_dir =~ m{^(?:\w:[/\\]?|[/\\])$}
477                     ? "$p_dir$dir_rel" : "$p_dir/$dir_rel");
478                 $dir_pref = "$dir_name/";
479             }
480             elsif ($^O eq 'VMS') {
481                 if ($p_dir =~ m/[\]>]+$/) {
482                     $dir_name = $p_dir;
483                     $dir_name =~ s/([\]>]+)$/.$dir_rel$1/;
484                     $dir_pref = $dir_name;
485                 }
486                 else {
487                     $dir_name = "$p_dir/$dir_rel";
488                     $dir_pref = "$dir_name/";
489                 }
490             }
491             else {
492                 $dir_name = ($p_dir eq '/' ? "/$dir_rel" : "$p_dir/$dir_rel");
493                 $dir_pref = "$dir_name/";
494             }
495
496             if ( $nlink == -2 ) {
497                 $name = $dir = $p_dir; # $File::Find::name / dir
498                 $_ = $File::Find::current_dir;
499                 $post_process->();              # End-of-directory processing
500             }
501             elsif ( $nlink < 0 ) {  # must be finddepth, report dirname now
502                 $name = $dir_name;
503                 if ( substr($name,-2) eq '/.' ) {
504                     substr($name, length($name) == 2 ? -1 : -2) = '';
505                 }
506                 $dir = $p_dir;
507                 $_ = ($no_chdir ? $dir_name : $dir_rel );
508                 if ( substr($_,-2) eq '/.' ) {
509                     substr($_, length($_) == 2 ? -1 : -2) = '';
510                 }
511                 { $wanted_callback->() }; # protect against wild "next"
512              }
513              else {
514                 push @Stack,[$CdLvl,$p_dir,$dir_rel,-1]  if  $bydepth;
515                 last;
516             }
517         }
518     }
519 }
520
521
522 # API:
523 #  $wanted
524 #  $dir_loc : absolute location of a dir
525 #  $p_dir   : "parent directory"
526 # preconditions:
527 #  chdir (if not no_chdir) to dir
528
529 sub _find_dir_symlnk($$$) {
530     my ($wanted, $dir_loc, $p_dir) = @_; # $dir_loc is the absolute directory
531     my @Stack;
532     my @filenames;
533     my $new_loc;
534     my $updir_loc = $dir_loc; # untainted parent directory
535     my $SE = [];
536     my $dir_name = $p_dir;
537     my $dir_pref;
538     my $loc_pref;
539     my $dir_rel = $File::Find::current_dir;
540     my $byd_flag; # flag for pending stack entry if $bydepth
541     my $tainted = 0;
542     my $ok = 1;
543
544     $dir_pref = ( $p_dir   eq '/' ? '/' : "$p_dir/" );
545     $loc_pref = ( $dir_loc eq '/' ? '/' : "$dir_loc/" );
546
547     local ($dir, $name, $fullname, $prune, *DIR);
548
549     unless ($no_chdir) {
550         # untaint the topdir
551         if (( $untaint ) && (is_tainted($dir_loc) )) {
552             ( $updir_loc ) = $dir_loc =~ m|$untaint_pat|; # parent dir, now untainted
553              # once untainted, $updir_loc is pushed on the stack (as parent directory);
554             # hence, we don't need to untaint the parent directory every time we chdir
555             # to it later
556             unless (defined $updir_loc) {
557                 if ($untaint_skip == 0) {
558                     die "directory $dir_loc is still tainted";
559                 }
560                 else {
561                     return;
562                 }
563             }
564         }
565         $ok = chdir($updir_loc) unless ($p_dir eq $File::Find::current_dir);
566         unless ($ok) {
567             warnings::warnif "Can't cd to $updir_loc: $!\n";
568             return;
569         }
570     }
571
572     push @Stack,[$dir_loc,$updir_loc,$p_dir,$dir_rel,-1]  if  $bydepth;
573
574     while (defined $SE) {
575
576         unless ($bydepth) {
577             # change (back) to parent directory (always untainted)
578             unless ($no_chdir) {
579                 unless (chdir $updir_loc) {
580                     warnings::warnif "Can't cd to $updir_loc: $!\n";
581                     next;
582                 }
583             }
584             $dir= $p_dir; # $File::Find::dir
585             $name= $dir_name; # $File::Find::name
586             $_= ($no_chdir ? $dir_name : $dir_rel ); # $_
587             $fullname= $dir_loc; # $File::Find::fullname
588             # prune may happen here
589             $prune= 0;
590             lstat($_); # make sure  file tests with '_' work
591             { $wanted_callback->() }; # protect against wild "next"
592             next if $prune;
593         }
594
595         # change to that directory
596         unless ($no_chdir || ($dir_rel eq $File::Find::current_dir)) {
597             $updir_loc = $dir_loc;
598             if ( ($untaint) && (($tainted) || ($tainted = is_tainted($dir_loc) )) ) {
599                 # untaint $dir_loc, what will be pushed on the stack as (untainted) parent dir
600                 ( $updir_loc ) = $dir_loc =~ m|$untaint_pat|;
601                 unless (defined $updir_loc) {
602                     if ($untaint_skip == 0) {
603                         die "directory $dir_loc is still tainted";
604                     }
605                     else {
606                         next;
607                     }
608                 }
609             }
610             unless (chdir $updir_loc) {
611                 warnings::warnif "Can't cd to $updir_loc: $!\n";
612                 next;
613             }
614         }
615
616         $dir = $dir_name; # $File::Find::dir
617
618         # Get the list of files in the current directory.
619         unless (opendir DIR, ($no_chdir ? $dir_loc : $File::Find::current_dir)) {
620             warnings::warnif "Can't opendir($dir_loc): $!\n";
621             next;
622         }
623         @filenames = readdir DIR;
624         closedir(DIR);
625
626         for my $FN (@filenames) {
627             if ($Is_VMS) {
628             # Big hammer here - Compensate for VMS trailing . and .dir
629             # No win situation until this is changed, but this
630             # will handle the majority of the cases with breaking the fewest.
631
632                 $FN =~ s/\.dir\z//i;
633                 $FN =~ s#\.$## if ($FN ne '.');
634             }
635             next if $FN =~ $File::Find::skip_pattern;
636
637             # follow symbolic links / do an lstat
638             $new_loc = Follow_SymLink($loc_pref.$FN);
639
640             # ignore if invalid symlink
641             unless (defined $new_loc) {
642                 if (!defined -l _ && $dangling_symlinks) {
643                 $fullname = undef;
644                     if (ref $dangling_symlinks eq 'CODE') {
645                         $dangling_symlinks->($FN, $dir_pref);
646                     } else {
647                         warnings::warnif "$dir_pref$FN is a dangling symbolic link\n";
648                     }
649                 }
650             else {
651                 $fullname = $loc_pref . $FN;
652             }
653                 $name = $dir_pref . $FN;
654                 $_ = ($no_chdir ? $name : $FN);
655                 { $wanted_callback->() };
656                 next;
657             }
658
659             if (-d _) {
660                 if ($Is_VMS) {
661                     $FN =~ s/\.dir\z//i;
662                     $FN =~ s#\.$## if ($FN ne '.');
663                     $new_loc =~ s/\.dir\z//i;
664                     $new_loc =~ s#\.$## if ($new_loc ne '.');
665                 }
666                 push @Stack,[$new_loc,$updir_loc,$dir_name,$FN,1];
667             }
668             else {
669                 $fullname = $new_loc; # $File::Find::fullname
670                 $name = $dir_pref . $FN; # $File::Find::name
671                 $_ = ($no_chdir ? $name : $FN); # $_
672                 { $wanted_callback->() }; # protect against wild "next"
673             }
674         }
675
676     }
677     continue {
678         while (defined($SE = pop @Stack)) {
679             ($dir_loc, $updir_loc, $p_dir, $dir_rel, $byd_flag) = @$SE;
680             $dir_name = ($p_dir eq '/' ? "/$dir_rel" : "$p_dir/$dir_rel");
681             $dir_pref = "$dir_name/";
682             $loc_pref = "$dir_loc/";
683             if ( $byd_flag < 0 ) {  # must be finddepth, report dirname now
684                 unless ($no_chdir || ($dir_rel eq $File::Find::current_dir)) {
685                     unless (chdir $updir_loc) { # $updir_loc (parent dir) is always untainted
686                         warnings::warnif "Can't cd to $updir_loc: $!\n";
687                         next;
688                     }
689                 }
690                 $fullname = $dir_loc; # $File::Find::fullname
691                 $name = $dir_name; # $File::Find::name
692                 if ( substr($name,-2) eq '/.' ) {
693                     substr($name, length($name) == 2 ? -1 : -2) = ''; # $File::Find::name
694                 }
695                 $dir = $p_dir; # $File::Find::dir
696                 $_ = ($no_chdir ? $dir_name : $dir_rel); # $_
697                 if ( substr($_,-2) eq '/.' ) {
698                     substr($_, length($_) == 2 ? -1 : -2) = '';
699                 }
700
701                 lstat($_); # make sure file tests with '_' work
702                 { $wanted_callback->() }; # protect against wild "next"
703             }
704             else {
705                 push @Stack,[$dir_loc, $updir_loc, $p_dir, $dir_rel,-1]  if  $bydepth;
706                 last;
707             }
708         }
709     }
710 }
711
712
713 sub wrap_wanted {
714     my $wanted = shift;
715     if ( ref($wanted) eq 'HASH' ) {
716         # RT #122547
717         my %valid_options = map {$_ => 1} qw(
718             wanted
719             bydepth
720             preprocess
721             postprocess
722             follow
723             follow_fast
724             follow_skip
725             dangling_symlinks
726             no_chdir
727             untaint
728             untaint_pattern
729             untaint_skip
730         );
731         my @invalid_options = ();
732         for my $v (keys %{$wanted}) {
733             push @invalid_options, $v unless exists $valid_options{$v};
734         }
735         warn "Invalid option(s): @invalid_options" if @invalid_options;
736
737         unless( exists $wanted->{wanted} and ref( $wanted->{wanted} ) eq 'CODE' ) {
738             die 'no &wanted subroutine given';
739         }
740         if ( $wanted->{follow} || $wanted->{follow_fast}) {
741             $wanted->{follow_skip} = 1 unless defined $wanted->{follow_skip};
742         }
743         if ( $wanted->{untaint} ) {
744             $wanted->{untaint_pattern} = $File::Find::untaint_pattern
745             unless defined $wanted->{untaint_pattern};
746             $wanted->{untaint_skip} = 0 unless defined $wanted->{untaint_skip};
747         }
748         return $wanted;
749     }
750     elsif( ref( $wanted ) eq 'CODE' ) {
751         return { wanted => $wanted };
752     }
753     else {
754        die 'no &wanted subroutine given';
755     }
756 }
757
758 sub find {
759     my $wanted = shift;
760     _find_opt(wrap_wanted($wanted), @_);
761 }
762
763 sub finddepth {
764     my $wanted = wrap_wanted(shift);
765     $wanted->{bydepth} = 1;
766     _find_opt($wanted, @_);
767 }
768
769 # default
770 $File::Find::skip_pattern    = qr/^\.{1,2}\z/;
771 $File::Find::untaint_pattern = qr|^([-+@\w./]+)$|;
772
773 # this _should_ work properly on all platforms
774 # where File::Find can be expected to work
775 $File::Find::current_dir = File::Spec->curdir || '.';
776
777 $File::Find::dont_use_nlink = 1;
778
779 # We need a function that checks if a scalar is tainted. Either use the
780 # Scalar::Util module's tainted() function or our (slower) pure Perl
781 # fallback is_tainted_pp()
782 {
783     local $@;
784     eval { require Scalar::Util };
785     *is_tainted = $@ ? \&is_tainted_pp : \&Scalar::Util::tainted;
786 }
787
788 1;
789
790 __END__
791
792 =head1 NAME
793
794 File::Find - Traverse a directory tree.
795
796 =head1 SYNOPSIS
797
798     use File::Find;
799     find(\&wanted, @directories_to_search);
800     sub wanted { ... }
801
802     use File::Find;
803     finddepth(\&wanted, @directories_to_search);
804     sub wanted { ... }
805
806     use File::Find;
807     find({ wanted => \&process, follow => 1 }, '.');
808
809 =head1 DESCRIPTION
810
811 These are functions for searching through directory trees doing work
812 on each file found similar to the Unix I<find> command.  File::Find
813 exports two functions, C<find> and C<finddepth>.  They work similarly
814 but have subtle differences.
815
816 =over 4
817
818 =item B<find>
819
820   find(\&wanted,  @directories);
821   find(\%options, @directories);
822
823 C<find()> does a depth-first search over the given C<@directories> in
824 the order they are given.  For each file or directory found, it calls
825 the C<&wanted> subroutine.  (See below for details on how to use the
826 C<&wanted> function).  Additionally, for each directory found, it will
827 C<chdir()> into that directory and continue the search, invoking the
828 C<&wanted> function on each file or subdirectory in the directory.
829
830 =item B<finddepth>
831
832   finddepth(\&wanted,  @directories);
833   finddepth(\%options, @directories);
834
835 C<finddepth()> works just like C<find()> except that it invokes the
836 C<&wanted> function for a directory I<after> invoking it for the
837 directory's contents.  It does a postorder traversal instead of a
838 preorder traversal, working from the bottom of the directory tree up
839 where C<find()> works from the top of the tree down.
840
841 =back
842
843 =head2 %options
844
845 The first argument to C<find()> is either a code reference to your
846 C<&wanted> function, or a hash reference describing the operations
847 to be performed for each file.  The
848 code reference is described in L</The wanted function> below.
849
850 Here are the possible keys for the hash:
851
852 =over 3
853
854 =item C<wanted>
855
856 The value should be a code reference.  This code reference is
857 described in L</The wanted function> below. The C<&wanted> subroutine is
858 mandatory.
859
860 =item C<bydepth>
861
862 Reports the name of a directory only AFTER all its entries
863 have been reported.  Entry point C<finddepth()> is a shortcut for
864 specifying C<< { bydepth => 1 } >> in the first argument of C<find()>.
865
866 =item C<preprocess>
867
868 The value should be a code reference. This code reference is used to
869 preprocess the current directory. The name of the currently processed
870 directory is in C<$File::Find::dir>. Your preprocessing function is
871 called after C<readdir()>, but before the loop that calls the C<wanted()>
872 function. It is called with a list of strings (actually file/directory
873 names) and is expected to return a list of strings. The code can be
874 used to sort the file/directory names alphabetically, numerically,
875 or to filter out directory entries based on their name alone. When
876 I<follow> or I<follow_fast> are in effect, C<preprocess> is a no-op.
877
878 =item C<postprocess>
879
880 The value should be a code reference. It is invoked just before leaving
881 the currently processed directory. It is called in void context with no
882 arguments. The name of the current directory is in C<$File::Find::dir>. This
883 hook is handy for summarizing a directory, such as calculating its disk
884 usage. When I<follow> or I<follow_fast> are in effect, C<postprocess> is a
885 no-op.
886
887 =item C<follow>
888
889 Causes symbolic links to be followed. Since directory trees with symbolic
890 links (followed) may contain files more than once and may even have
891 cycles, a hash has to be built up with an entry for each file.
892 This might be expensive both in space and time for a large
893 directory tree. See L</follow_fast> and L</follow_skip> below.
894 If either I<follow> or I<follow_fast> is in effect:
895
896 =over 6
897
898 =item *
899
900 It is guaranteed that an I<lstat> has been called before the user's
901 C<wanted()> function is called. This enables fast file checks involving C<_>.
902 Note that this guarantee no longer holds if I<follow> or I<follow_fast>
903 are not set.
904
905 =item *
906
907 There is a variable C<$File::Find::fullname> which holds the absolute
908 pathname of the file with all symbolic links resolved.  If the link is
909 a dangling symbolic link, then fullname will be set to C<undef>.
910
911 =back
912
913 This is a no-op on Win32.
914
915 =item C<follow_fast>
916
917 This is similar to I<follow> except that it may report some files more
918 than once.  It does detect cycles, however.  Since only symbolic links
919 have to be hashed, this is much cheaper both in space and time.  If
920 processing a file more than once (by the user's C<wanted()> function)
921 is worse than just taking time, the option I<follow> should be used.
922
923 This is also a no-op on Win32.
924
925 =item C<follow_skip>
926
927 C<follow_skip==1>, which is the default, causes all files which are
928 neither directories nor symbolic links to be ignored if they are about
929 to be processed a second time. If a directory or a symbolic link
930 are about to be processed a second time, File::Find dies.
931
932 C<follow_skip==0> causes File::Find to die if any file is about to be
933 processed a second time.
934
935 C<follow_skip==2> causes File::Find to ignore any duplicate files and
936 directories but to proceed normally otherwise.
937
938 =item C<dangling_symlinks>
939
940 Specifies what to do with symbolic links whose target doesn't exist.
941 If true and a code reference, will be called with the symbolic link
942 name and the directory it lives in as arguments.  Otherwise, if true
943 and warnings are on, a warning of the form C<"symbolic_link_name is a dangling
944 symbolic link\n"> will be issued.  If false, the dangling symbolic link
945 will be silently ignored.
946
947 =item C<no_chdir>
948
949 Does not C<chdir()> to each directory as it recurses. The C<wanted()>
950 function will need to be aware of this, of course. In this case,
951 C<$_> will be the same as C<$File::Find::name>.
952
953 =item C<untaint>
954
955 If find is used in L<taint-mode|perlsec/Taint mode> (-T command line switch or
956 if EUID != UID or if EGID != GID), then internally directory names have to be
957 untainted before they can be C<chdir>'d to. Therefore they are checked against
958 a regular expression I<untaint_pattern>.  Note that all names passed to the
959 user's C<wanted()> function are still tainted. If this option is used while not
960 in taint-mode, C<untaint> is a no-op.
961
962 =item C<untaint_pattern>
963
964 See above. This should be set using the C<qr> quoting operator.
965 The default is set to C<qr|^([-+@\w./]+)$|>.
966 Note that the parentheses are vital.
967
968 =item C<untaint_skip>
969
970 If set, a directory which fails the I<untaint_pattern> is skipped,
971 including all its sub-directories. The default is to C<die> in such a case.
972
973 =back
974
975 =head2 The wanted function
976
977 The C<wanted()> function does whatever verifications you want on
978 each file and directory.  Note that despite its name, the C<wanted()>
979 function is a generic callback function, and does B<not> tell
980 File::Find if a file is "wanted" or not.  In fact, its return value
981 is ignored.
982
983 The wanted function takes no arguments but rather does its work
984 through a collection of variables.
985
986 =over 4
987
988 =item C<$File::Find::dir> is the current directory name,
989
990 =item C<$_> is the current filename within that directory
991
992 =item C<$File::Find::name> is the complete pathname to the file.
993
994 =back
995
996 The above variables have all been localized and may be changed without
997 affecting data outside of the wanted function.
998
999 For example, when examining the file F</some/path/foo.ext> you will have:
1000
1001     $File::Find::dir  = /some/path/
1002     $_                = foo.ext
1003     $File::Find::name = /some/path/foo.ext
1004
1005 You are chdir()'d to C<$File::Find::dir> when the function is called,
1006 unless C<no_chdir> was specified. Note that when changing to
1007 directories is in effect, the root directory (F</>) is a somewhat
1008 special case inasmuch as the concatenation of C<$File::Find::dir>,
1009 C<'/'> and C<$_> is not literally equal to C<$File::Find::name>. The
1010 table below summarizes all variants:
1011
1012               $File::Find::name  $File::Find::dir  $_
1013  default      /                  /                 .
1014  no_chdir=>0  /etc               /                 etc
1015               /etc/x             /etc              x
1016
1017  no_chdir=>1  /                  /                 /
1018               /etc               /                 /etc
1019               /etc/x             /etc              /etc/x
1020
1021
1022 When C<follow> or C<follow_fast> are in effect, there is
1023 also a C<$File::Find::fullname>.  The function may set
1024 C<$File::Find::prune> to prune the tree unless C<bydepth> was
1025 specified.  Unless C<follow> or C<follow_fast> is specified, for
1026 compatibility reasons (find.pl, find2perl) there are in addition the
1027 following globals available: C<$File::Find::topdir>,
1028 C<$File::Find::topdev>, C<$File::Find::topino>,
1029 C<$File::Find::topmode> and C<$File::Find::topnlink>.
1030
1031 This library is useful for the C<find2perl> tool (distributed as part of the
1032 App-find2perl CPAN distribution), which when fed,
1033
1034   find2perl / -name .nfs\* -mtime +7 \
1035     -exec rm -f {} \; -o -fstype nfs -prune
1036
1037 produces something like:
1038
1039  sub wanted {
1040     /^\.nfs.*\z/s &&
1041     (($dev, $ino, $mode, $nlink, $uid, $gid) = lstat($_)) &&
1042     int(-M _) > 7 &&
1043     unlink($_)
1044     ||
1045     ($nlink || (($dev, $ino, $mode, $nlink, $uid, $gid) = lstat($_))) &&
1046     $dev < 0 &&
1047     ($File::Find::prune = 1);
1048  }
1049
1050 Notice the C<_> in the above C<int(-M _)>: the C<_> is a magical
1051 filehandle that caches the information from the preceding
1052 C<stat()>, C<lstat()>, or filetest.
1053
1054 Here's another interesting wanted function.  It will find all symbolic
1055 links that don't resolve:
1056
1057     sub wanted {
1058          -l && !-e && print "bogus link: $File::Find::name\n";
1059     }
1060
1061 Note that you may mix directories and (non-directory) files in the list of 
1062 directories to be searched by the C<wanted()> function.
1063
1064     find(\&wanted, "./foo", "./bar", "./baz/epsilon");
1065
1066 In the example above, no file in F<./baz/> other than F<./baz/epsilon> will be
1067 evaluated by C<wanted()>.
1068
1069 See also the script C<pfind> on CPAN for a nice application of this
1070 module.
1071
1072 =head1 WARNINGS
1073
1074 If you run your program with the C<-w> switch, or if you use the
1075 C<warnings> pragma, File::Find will report warnings for several weird
1076 situations. You can disable these warnings by putting the statement
1077
1078     no warnings 'File::Find';
1079
1080 in the appropriate scope. See L<warnings> for more info about lexical
1081 warnings.
1082
1083 =head1 CAVEAT
1084
1085 =over 2
1086
1087 =item $dont_use_nlink
1088
1089 You can set the variable C<$File::Find::dont_use_nlink> to 0 if you
1090 are sure the filesystem you are scanning reflects the number of
1091 subdirectories in the parent directory's C<nlink> count.
1092
1093 If you do set C<$File::Find::dont_use_nlink> to 0, you may notice an
1094 improvement in speed at the risk of not recursing into subdirectories
1095 if a filesystem doesn't populate C<nlink> as expected.
1096
1097 C<$File::Find::dont_use_nlink> now defaults to 1 on all platforms.
1098
1099 =item symlinks
1100
1101 Be aware that the option to follow symbolic links can be dangerous.
1102 Depending on the structure of the directory tree (including symbolic
1103 links to directories) you might traverse a given (physical) directory
1104 more than once (only if C<follow_fast> is in effect).
1105 Furthermore, deleting or changing files in a symbolically linked directory
1106 might cause very unpleasant surprises, since you delete or change files
1107 in an unknown directory.
1108
1109 =back
1110
1111 =head1 BUGS AND CAVEATS
1112
1113 Despite the name of the C<finddepth()> function, both C<find()> and
1114 C<finddepth()> perform a depth-first search of the directory
1115 hierarchy.
1116
1117 =head1 HISTORY
1118
1119 File::Find used to produce incorrect results if called recursively.
1120 During the development of perl 5.8 this bug was fixed.
1121 The first fixed version of File::Find was 1.01.
1122
1123 =head1 SEE ALSO
1124
1125 L<find(1)>, find2perl.
1126
1127 =cut