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