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