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