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.21';
   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 Note that you may mix directories and (non-directory) files in the list of
 284 directories to be searched by the C<wanted()> function.
 285
 286     find(\&wanted, "./foo", "./bar", "./baz/epsilon");
 287
 288 In the example above, no file in F<./baz/> other than F<./baz/epsilon> will be
 289 evaluated by C<wanted()>.
 290
 291 See also the script C<pfind> on CPAN for a nice application of this
 292 module.
 293
 294 =head1 WARNINGS
 295
 296 If you run your program with the C<-w> switch, or if you use the
 297 C<warnings> pragma, File::Find will report warnings for several weird
 298 situations. You can disable these warnings by putting the statement
 299
 300     no warnings 'File::Find';
 301
 302 in the appropriate scope. See L<perllexwarn> for more info about lexical
 303 warnings.
 304
 305 =head1 CAVEAT
 306
 307 =over 2
 308
 309 =item $dont_use_nlink
 310
 311 You can set the variable C<$File::Find::dont_use_nlink> to 1, if you want to
 312 force File::Find to always stat directories. This was used for file systems
 313 that do not have an C<nlink> count matching the number of sub-directories.
 314 Examples are ISO-9660 (CD-ROM), AFS, HPFS (OS/2 file system), FAT (DOS file
 315 system) and a couple of others.
 316
 317 You shouldn't need to set this variable, since File::Find should now detect
 318 such file systems on-the-fly and switch itself to using stat. This works even
 319 for parts of your file system, like a mounted CD-ROM.
 320
 321 If you do set C<$File::Find::dont_use_nlink> to 1, you will notice slow-downs.
 322
 323 =item symlinks
 324
 325 Be aware that the option to follow symbolic links can be dangerous.
 326 Depending on the structure of the directory tree (including symbolic
 327 links to directories) you might traverse a given (physical) directory
 328 more than once (only if C<follow_fast> is in effect).
 329 Furthermore, deleting or changing files in a symbolically linked directory
 330 might cause very unpleasant surprises, since you delete or change files
 331 in an unknown directory.
 332
 333 =back
 334
 335 =head1 BUGS AND CAVEATS
 336
 337 Despite the name of the C<finddepth()> function, both C<find()> and
 338 C<finddepth()> perform a depth-first search of the directory
 339 hierarchy.
 340
 341 =head1 HISTORY
 342
 343 File::Find used to produce incorrect results if called recursively.
 344 During the development of perl 5.8 this bug was fixed.
 345 The first fixed version of File::Find was 1.01.
 346
 347 =head1 SEE ALSO
 348
 349 find, find2perl.
 350
 351 =cut
 352
 353 our @ISA = qw(Exporter);
 354 our @EXPORT = qw(find finddepth);
 355
 356
 357 use strict;
 358 my $Is_VMS;
 359 my $Is_Win32;
 360
 361 require File::Basename;
 362 require File::Spec;
 363
 364 # Should ideally be my() not our() but local() currently
 365 # refuses to operate on lexicals
 366
 367 our %SLnkSeen;
 368 our ($wanted_callback, $avoid_nlink, $bydepth, $no_chdir, $follow,
 369     $follow_skip, $full_check, $untaint, $untaint_skip, $untaint_pat,
 370     $pre_process, $post_process, $dangling_symlinks);
 371
 372 sub contract_name {
 373     my ($cdir,$fn) = @_;
 374
 375     return substr($cdir,0,rindex($cdir,'/')) if $fn eq $File::Find::current_dir;
 376
 377     $cdir = substr($cdir,0,rindex($cdir,'/')+1);
 378
 379     $fn =~ s|^\./||;
 380
 381     my $abs_name= $cdir . $fn;
 382
 383     if (substr($fn,0,3) eq '../') {
 384        1 while $abs_name =~ s!/[^/]*/\.\./+!/!;
 385     }
 386
 387     return $abs_name;
 388 }
 389
 390 sub PathCombine($$) {
 391     my ($Base,$Name) = @_;
 392     my $AbsName;
 393
 394     if (substr($Name,0,1) eq '/') {
 395         $AbsName= $Name;
 396     }
 397     else {
 398         $AbsName= contract_name($Base,$Name);
 399     }
 400
 401     # (simple) check for recursion
 402     my $newlen= length($AbsName);
 403     if ($newlen <= length($Base)) {
 404         if (($newlen == length($Base) || substr($Base,$newlen,1) eq '/')
 405             && $AbsName eq substr($Base,0,$newlen))
 406         {
 407             return undef;
 408         }
 409     }
 410     return $AbsName;
 411 }
 412
 413 sub Follow_SymLink($) {
 414     my ($AbsName) = @_;
 415
 416     my ($NewName,$DEV, $INO);
 417     ($DEV, $INO)= lstat $AbsName;
 418
 419     while (-l _) {
 420         if ($SLnkSeen{$DEV, $INO}++) {
 421             if ($follow_skip < 2) {
 422                 die "$AbsName is encountered a second time";
 423             }
 424             else {
 425                 return undef;
 426             }
 427         }
 428         $NewName= PathCombine($AbsName, readlink($AbsName));
 429         unless(defined $NewName) {
 430             if ($follow_skip < 2) {
 431                 die "$AbsName is a recursive symbolic link";
 432             }
 433             else {
 434                 return undef;
 435             }
 436         }
 437         else {
 438             $AbsName= $NewName;
 439         }
 440         ($DEV, $INO) = lstat($AbsName);
 441         return undef unless defined $DEV;  #  dangling symbolic link
 442     }
 443
 444     if ($full_check && defined $DEV && $SLnkSeen{$DEV, $INO}++) {
 445         if ( ($follow_skip < 1) || ((-d _) && ($follow_skip < 2)) ) {
 446             die "$AbsName encountered a second time";
 447         }
 448         else {
 449             return undef;
 450         }
 451     }
 452
 453     return $AbsName;
 454 }
 455
 456 our($dir, $name, $fullname, $prune);
 457 sub _find_dir_symlnk($$$);
 458 sub _find_dir($$$);
 459
 460 # check whether or not a scalar variable is tainted
 461 # (code straight from the Camel, 3rd ed., page 561)
 462 sub is_tainted_pp {
 463     my $arg = shift;
 464     my $nada = substr($arg, 0, 0); # zero-length
 465     local $@;
 466     eval { eval "# $nada" };
 467     return length($@) != 0;
 468 }
 469
 470 sub _find_opt {
 471     my $wanted = shift;
 472     die "invalid top directory" unless defined $_[0];
 473
 474     # This function must local()ize everything because callbacks may
 475     # call find() or finddepth()
 476
 477     local %SLnkSeen;
 478     local ($wanted_callback, $avoid_nlink, $bydepth, $no_chdir, $follow,
 479         $follow_skip, $full_check, $untaint, $untaint_skip, $untaint_pat,
 480         $pre_process, $post_process, $dangling_symlinks);
 481     local($dir, $name, $fullname, $prune);
 482     local *_ = \my $a;
 483
 484     my $cwd            = $wanted->{bydepth} ? Cwd::fastcwd() : Cwd::getcwd();
 485     if ($Is_VMS) {
 486         # VMS returns this by default in VMS format which just doesn't
 487         # work for the rest of this module.
 488         $cwd = VMS::Filespec::unixpath($cwd);
 489
 490         # Apparently this is not expected to have a trailing space.
 491         # To attempt to make VMS/UNIX conversions mostly reversable,
 492         # a trailing slash is needed.  The run-time functions ignore the
 493         # resulting double slash, but it causes the perl tests to fail.
 494         $cwd =~ s#/\z##;
 495
 496         # This comes up in upper case now, but should be lower.
 497         # In the future this could be exact case, no need to change.
 498     }
 499     my $cwd_untainted  = $cwd;
 500     my $check_t_cwd    = 1;
 501     $wanted_callback   = $wanted->{wanted};
 502     $bydepth           = $wanted->{bydepth};
 503     $pre_process       = $wanted->{preprocess};
 504     $post_process      = $wanted->{postprocess};
 505     $no_chdir          = $wanted->{no_chdir};
 506     $full_check        = $Is_Win32 ? 0 : $wanted->{follow};
 507     $follow            = $Is_Win32 ? 0 :
 508                              $full_check || $wanted->{follow_fast};
 509     $follow_skip       = $wanted->{follow_skip};
 510     $untaint           = $wanted->{untaint};
 511     $untaint_pat       = $wanted->{untaint_pattern};
 512     $untaint_skip      = $wanted->{untaint_skip};
 513     $dangling_symlinks = $wanted->{dangling_symlinks};
 514
 515     # for compatibility reasons (find.pl, find2perl)
 516     local our ($topdir, $topdev, $topino, $topmode, $topnlink);
 517
 518     # a symbolic link to a directory doesn't increase the link count
 519     $avoid_nlink      = $follow || $File::Find::dont_use_nlink;
 520
 521     my ($abs_dir, $Is_Dir);
 522
 523     Proc_Top_Item:
 524     foreach my $TOP (@_) {
 525         my $top_item = $TOP;
 526
 527         ($topdev,$topino,$topmode,$topnlink) = $follow ? stat $top_item : lstat $top_item;
 528
 529         if ($Is_Win32) {
 530             $top_item =~ s|[/\\]\z||
 531               unless $top_item =~ m{^(?:\w:)?[/\\]$};
 532         }
 533         else {
 534             $top_item =~ s|/\z|| unless $top_item eq '/';
 535         }
 536
 537         $Is_Dir= 0;
 538
 539         if ($follow) {
 540
 541             if (substr($top_item,0,1) eq '/') {
 542                 $abs_dir = $top_item;
 543             }
 544             elsif ($top_item eq $File::Find::current_dir) {
 545                 $abs_dir = $cwd;
 546             }
 547             else {  # care about any  ../
 548                 $top_item =~ s/\.dir\z//i if $Is_VMS;
 549                 $abs_dir = contract_name("$cwd/",$top_item);
 550             }
 551             $abs_dir= Follow_SymLink($abs_dir);
 552             unless (defined $abs_dir) {
 553                 if ($dangling_symlinks) {
 554                     if (ref $dangling_symlinks eq 'CODE') {
 555                         $dangling_symlinks->($top_item, $cwd);
 556                     } else {
 557                         warnings::warnif "$top_item is a dangling symbolic link\n";
 558                     }
 559                 }
 560                 next Proc_Top_Item;
 561             }
 562
 563             if (-d _) {
 564                 $top_item =~ s/\.dir\z//i if $Is_VMS;
 565                 _find_dir_symlnk($wanted, $abs_dir, $top_item);
 566                 $Is_Dir= 1;
 567             }
 568         }
 569         else { # no follow
 570             $topdir = $top_item;
 571             unless (defined $topnlink) {
 572                 warnings::warnif "Can't stat $top_item: $!\n";
 573                 next Proc_Top_Item;
 574             }
 575             if (-d _) {
 576                 $top_item =~ s/\.dir\z//i if $Is_VMS;
 577                 _find_dir($wanted, $top_item, $topnlink);
 578                 $Is_Dir= 1;
 579             }
 580             else {
 581                 $abs_dir= $top_item;
 582             }
 583         }
 584
 585         unless ($Is_Dir) {
 586             unless (($_,$dir) = File::Basename::fileparse($abs_dir)) {
 587                 ($dir,$_) = ('./', $top_item);
 588             }
 589
 590             $abs_dir = $dir;
 591             if (( $untaint ) && (is_tainted($dir) )) {
 592                 ( $abs_dir ) = $dir =~ m|$untaint_pat|;
 593                 unless (defined $abs_dir) {
 594                     if ($untaint_skip == 0) {
 595                         die "directory $dir is still tainted";
 596                     }
 597                     else {
 598                         next Proc_Top_Item;
 599                     }
 600                 }
 601             }
 602
 603             unless ($no_chdir || chdir $abs_dir) {
 604                 warnings::warnif "Couldn't chdir $abs_dir: $!\n";
 605                 next Proc_Top_Item;
 606             }
 607
 608             $name = $abs_dir . $_; # $File::Find::name
 609             $_ = $name if $no_chdir;
 610
 611             { $wanted_callback->() }; # protect against wild "next"
 612
 613         }
 614
 615         unless ( $no_chdir ) {
 616             if ( ($check_t_cwd) && (($untaint) && (is_tainted($cwd) )) ) {
 617                 ( $cwd_untainted ) = $cwd =~ m|$untaint_pat|;
 618                 unless (defined $cwd_untainted) {
 619                     die "insecure cwd in find(depth)";
 620                 }
 621                 $check_t_cwd = 0;
 622             }
 623             unless (chdir $cwd_untainted) {
 624                 die "Can't cd to $cwd: $!\n";
 625             }
 626         }
 627     }
 628 }
 629
 630 # API:
 631 #  $wanted
 632 #  $p_dir :  "parent directory"
 633 #  $nlink :  what came back from the stat
 634 # preconditions:
 635 #  chdir (if not no_chdir) to dir
 636
 637 sub _find_dir($$$) {
 638     my ($wanted, $p_dir, $nlink) = @_;
 639     my ($CdLvl,$Level) = (0,0);
 640     my @Stack;
 641     my @filenames;
 642     my ($subcount,$sub_nlink);
 643     my $SE= [];
 644     my $dir_name= $p_dir;
 645     my $dir_pref;
 646     my $dir_rel = $File::Find::current_dir;
 647     my $tainted = 0;
 648     my $no_nlink;
 649
 650     if ($Is_Win32) {
 651         $dir_pref
 652           = ($p_dir =~ m{^(?:\w:[/\\]?|[/\\])$} ? $p_dir : "$p_dir/" );
 653     } elsif ($Is_VMS) {
 654
 655         #       VMS is returning trailing .dir on directories
 656         #       and trailing . on files and symbolic links
 657         #       in UNIX syntax.
 658         #
 659
 660         $p_dir =~ s/\.(dir)?$//i unless $p_dir eq '.';
 661
 662         $dir_pref = ($p_dir =~ m/[\]>]+$/ ? $p_dir : "$p_dir/" );
 663     }
 664     else {
 665         $dir_pref= ( $p_dir eq '/' ? '/' : "$p_dir/" );
 666     }
 667
 668     local ($dir, $name, $prune, *DIR);
 669
 670     unless ( $no_chdir || ($p_dir eq $File::Find::current_dir)) {
 671         my $udir = $p_dir;
 672         if (( $untaint ) && (is_tainted($p_dir) )) {
 673             ( $udir ) = $p_dir =~ m|$untaint_pat|;
 674             unless (defined $udir) {
 675                 if ($untaint_skip == 0) {
 676                     die "directory $p_dir is still tainted";
 677                 }
 678                 else {
 679                     return;
 680                 }
 681             }
 682         }
 683         unless (chdir ($Is_VMS && $udir !~ /[\/\[<]+/ ? "./$udir" : $udir)) {
 684             warnings::warnif "Can't cd to $udir: $!\n";
 685             return;
 686         }
 687     }
 688
 689     # push the starting directory
 690     push @Stack,[$CdLvl,$p_dir,$dir_rel,-1]  if  $bydepth;
 691
 692     while (defined $SE) {
 693         unless ($bydepth) {
 694             $dir= $p_dir; # $File::Find::dir
 695             $name= $dir_name; # $File::Find::name
 696             $_= ($no_chdir ? $dir_name : $dir_rel ); # $_
 697             # prune may happen here
 698             $prune= 0;
 699             { $wanted_callback->() };   # protect against wild "next"
 700             next if $prune;
 701         }
 702
 703         # change to that directory
 704         unless ($no_chdir || ($dir_rel eq $File::Find::current_dir)) {
 705             my $udir= $dir_rel;
 706             if ( ($untaint) && (($tainted) || ($tainted = is_tainted($dir_rel) )) ) {
 707                 ( $udir ) = $dir_rel =~ m|$untaint_pat|;
 708                 unless (defined $udir) {
 709                     if ($untaint_skip == 0) {
 710                         die "directory (" . ($p_dir ne '/' ? $p_dir : '') . "/) $dir_rel is still tainted";
 711                     } else { # $untaint_skip == 1
 712                         next;
 713                     }
 714                 }
 715             }
 716             unless (chdir ($Is_VMS && $udir !~ /[\/\[<]+/ ? "./$udir" : $udir)) {
 717                 warnings::warnif "Can't cd to (" .
 718                     ($p_dir ne '/' ? $p_dir : '') . "/) $udir: $!\n";
 719                 next;
 720             }
 721             $CdLvl++;
 722         }
 723
 724         $dir= $dir_name; # $File::Find::dir
 725
 726         # Get the list of files in the current directory.
 727         unless (opendir DIR, ($no_chdir ? $dir_name : $File::Find::current_dir)) {
 728             warnings::warnif "Can't opendir($dir_name): $!\n";
 729             next;
 730         }
 731         @filenames = readdir DIR;
 732         closedir(DIR);
 733         @filenames = $pre_process->(@filenames) if $pre_process;
 734         push @Stack,[$CdLvl,$dir_name,"",-2]   if $post_process;
 735
 736         # default: use whatever was specified
 737         # (if $nlink >= 2, and $avoid_nlink == 0, this will switch back)
 738         $no_nlink = $avoid_nlink;
 739         # if dir has wrong nlink count, force switch to slower stat method
 740         $no_nlink = 1 if ($nlink < 2);
 741
 742         if ($nlink == 2 && !$no_nlink) {
 743             # This dir has no subdirectories.
 744             for my $FN (@filenames) {
 745                 if ($Is_VMS) {
 746                 # Big hammer here - Compensate for VMS trailing . and .dir
 747                 # No win situation until this is changed, but this
 748                 # will handle the majority of the cases with breaking the fewest
 749
 750                     $FN =~ s/\.dir\z//i;
 751                     $FN =~ s#\.$## if ($FN ne '.');
 752                 }
 753                 next if $FN =~ $File::Find::skip_pattern;
 754
 755                 $name = $dir_pref . $FN; # $File::Find::name
 756                 $_ = ($no_chdir ? $name : $FN); # $_
 757                 { $wanted_callback->() }; # protect against wild "next"
 758             }
 759
 760         }
 761         else {
 762             # This dir has subdirectories.
 763             $subcount = $nlink - 2;
 764
 765             # HACK: insert directories at this position. so as to preserve
 766             # the user pre-processed ordering of files.
 767             # EG: directory traversal is in user sorted order, not at random.
 768             my $stack_top = @Stack;
 769
 770             for my $FN (@filenames) {
 771                 next if $FN =~ $File::Find::skip_pattern;
 772                 if ($subcount > 0 || $no_nlink) {
 773                     # Seen all the subdirs?
 774                     # check for directoriness.
 775                     # stat is faster for a file in the current directory
 776                     $sub_nlink = (lstat ($no_chdir ? $dir_pref . $FN : $FN))[3];
 777
 778                     if (-d _) {
 779                         --$subcount;
 780                         $FN =~ s/\.dir\z//i if $Is_VMS;
 781                         # HACK: replace push to preserve dir traversal order
 782                         #push @Stack,[$CdLvl,$dir_name,$FN,$sub_nlink];
 783                         splice @Stack, $stack_top, 0,
 784                                  [$CdLvl,$dir_name,$FN,$sub_nlink];
 785                     }
 786                     else {
 787                         $name = $dir_pref . $FN; # $File::Find::name
 788                         $_= ($no_chdir ? $name : $FN); # $_
 789                         { $wanted_callback->() }; # protect against wild "next"
 790                     }
 791                 }
 792                 else {
 793                     $name = $dir_pref . $FN; # $File::Find::name
 794                     $_= ($no_chdir ? $name : $FN); # $_
 795                     { $wanted_callback->() }; # protect against wild "next"
 796                 }
 797             }
 798         }
 799     }
 800     continue {
 801         while ( defined ($SE = pop @Stack) ) {
 802             ($Level, $p_dir, $dir_rel, $nlink) = @$SE;
 803             if ($CdLvl > $Level && !$no_chdir) {
 804                 my $tmp;
 805                 if ($Is_VMS) {
 806                     $tmp = '[' . ('-' x ($CdLvl-$Level)) . ']';
 807                 }
 808                 else {
 809                     $tmp = join('/',('..') x ($CdLvl-$Level));
 810                 }
 811                 die "Can't cd to $tmp from $dir_name"
 812                     unless chdir ($tmp);
 813                 $CdLvl = $Level;
 814             }
 815
 816             if ($Is_Win32) {
 817                 $dir_name = ($p_dir =~ m{^(?:\w:[/\\]?|[/\\])$}
 818                     ? "$p_dir$dir_rel" : "$p_dir/$dir_rel");
 819                 $dir_pref = "$dir_name/";
 820             }
 821             elsif ($^O eq 'VMS') {
 822                 if ($p_dir =~ m/[\]>]+$/) {
 823                     $dir_name = $p_dir;
 824                     $dir_name =~ s/([\]>]+)$/.$dir_rel$1/;
 825                     $dir_pref = $dir_name;
 826                 }
 827                 else {
 828                     $dir_name = "$p_dir/$dir_rel";
 829                     $dir_pref = "$dir_name/";
 830                 }
 831             }
 832             else {
 833                 $dir_name = ($p_dir eq '/' ? "/$dir_rel" : "$p_dir/$dir_rel");
 834                 $dir_pref = "$dir_name/";
 835             }
 836
 837             if ( $nlink == -2 ) {
 838                 $name = $dir = $p_dir; # $File::Find::name / dir
 839                 $_ = $File::Find::current_dir;
 840                 $post_process->();              # End-of-directory processing
 841             }
 842             elsif ( $nlink < 0 ) {  # must be finddepth, report dirname now
 843                 $name = $dir_name;
 844                 if ( substr($name,-2) eq '/.' ) {
 845                     substr($name, length($name) == 2 ? -1 : -2) = '';
 846                 }
 847                 $dir = $p_dir;
 848                 $_ = ($no_chdir ? $dir_name : $dir_rel );
 849                 if ( substr($_,-2) eq '/.' ) {
 850                     substr($_, length($_) == 2 ? -1 : -2) = '';
 851                 }
 852                 { $wanted_callback->() }; # protect against wild "next"
 853              }
 854              else {
 855                 push @Stack,[$CdLvl,$p_dir,$dir_rel,-1]  if  $bydepth;
 856                 last;
 857             }
 858         }
 859     }
 860 }
 861
 862
 863 # API:
 864 #  $wanted
 865 #  $dir_loc : absolute location of a dir
 866 #  $p_dir   : "parent directory"
 867 # preconditions:
 868 #  chdir (if not no_chdir) to dir
 869
 870 sub _find_dir_symlnk($$$) {
 871     my ($wanted, $dir_loc, $p_dir) = @_; # $dir_loc is the absolute directory
 872     my @Stack;
 873     my @filenames;
 874     my $new_loc;
 875     my $updir_loc = $dir_loc; # untainted parent directory
 876     my $SE = [];
 877     my $dir_name = $p_dir;
 878     my $dir_pref;
 879     my $loc_pref;
 880     my $dir_rel = $File::Find::current_dir;
 881     my $byd_flag; # flag for pending stack entry if $bydepth
 882     my $tainted = 0;
 883     my $ok = 1;
 884
 885     $dir_pref = ( $p_dir   eq '/' ? '/' : "$p_dir/" );
 886     $loc_pref = ( $dir_loc eq '/' ? '/' : "$dir_loc/" );
 887
 888     local ($dir, $name, $fullname, $prune, *DIR);
 889
 890     unless ($no_chdir) {
 891         # untaint the topdir
 892         if (( $untaint ) && (is_tainted($dir_loc) )) {
 893             ( $updir_loc ) = $dir_loc =~ m|$untaint_pat|; # parent dir, now untainted
 894              # once untainted, $updir_loc is pushed on the stack (as parent directory);
 895             # hence, we don't need to untaint the parent directory every time we chdir
 896             # to it later
 897             unless (defined $updir_loc) {
 898                 if ($untaint_skip == 0) {
 899                     die "directory $dir_loc is still tainted";
 900                 }
 901                 else {
 902                     return;
 903                 }
 904             }
 905         }
 906         $ok = chdir($updir_loc) unless ($p_dir eq $File::Find::current_dir);
 907         unless ($ok) {
 908             warnings::warnif "Can't cd to $updir_loc: $!\n";
 909             return;
 910         }
 911     }
 912
 913     push @Stack,[$dir_loc,$updir_loc,$p_dir,$dir_rel,-1]  if  $bydepth;
 914
 915     while (defined $SE) {
 916
 917         unless ($bydepth) {
 918             # change (back) to parent directory (always untainted)
 919             unless ($no_chdir) {
 920                 unless (chdir $updir_loc) {
 921                     warnings::warnif "Can't cd to $updir_loc: $!\n";
 922                     next;
 923                 }
 924             }
 925             $dir= $p_dir; # $File::Find::dir
 926             $name= $dir_name; # $File::Find::name
 927             $_= ($no_chdir ? $dir_name : $dir_rel ); # $_
 928             $fullname= $dir_loc; # $File::Find::fullname
 929             # prune may happen here
 930             $prune= 0;
 931             lstat($_); # make sure  file tests with '_' work
 932             { $wanted_callback->() }; # protect against wild "next"
 933             next if $prune;
 934         }
 935
 936         # change to that directory
 937         unless ($no_chdir || ($dir_rel eq $File::Find::current_dir)) {
 938             $updir_loc = $dir_loc;
 939             if ( ($untaint) && (($tainted) || ($tainted = is_tainted($dir_loc) )) ) {
 940                 # untaint $dir_loc, what will be pushed on the stack as (untainted) parent dir
 941                 ( $updir_loc ) = $dir_loc =~ m|$untaint_pat|;
 942                 unless (defined $updir_loc) {
 943                     if ($untaint_skip == 0) {
 944                         die "directory $dir_loc is still tainted";
 945                     }
 946                     else {
 947                         next;
 948                     }
 949                 }
 950             }
 951             unless (chdir $updir_loc) {
 952                 warnings::warnif "Can't cd to $updir_loc: $!\n";
 953                 next;
 954             }
 955         }
 956
 957         $dir = $dir_name; # $File::Find::dir
 958
 959         # Get the list of files in the current directory.
 960         unless (opendir DIR, ($no_chdir ? $dir_loc : $File::Find::current_dir)) {
 961             warnings::warnif "Can't opendir($dir_loc): $!\n";
 962             next;
 963         }
 964         @filenames = readdir DIR;
 965         closedir(DIR);
 966
 967         for my $FN (@filenames) {
 968             if ($Is_VMS) {
 969             # Big hammer here - Compensate for VMS trailing . and .dir
 970             # No win situation until this is changed, but this
 971             # will handle the majority of the cases with breaking the fewest.
 972
 973                 $FN =~ s/\.dir\z//i;
 974                 $FN =~ s#\.$## if ($FN ne '.');
 975             }
 976             next if $FN =~ $File::Find::skip_pattern;
 977
 978             # follow symbolic links / do an lstat
 979             $new_loc = Follow_SymLink($loc_pref.$FN);
 980
 981             # ignore if invalid symlink
 982             unless (defined $new_loc) {
 983                 if (!defined -l _ && $dangling_symlinks) {
 984                     if (ref $dangling_symlinks eq 'CODE') {
 985                         $dangling_symlinks->($FN, $dir_pref);
 986                     } else {
 987                         warnings::warnif "$dir_pref$FN is a dangling symbolic link\n";
 988                     }
 989                 }
 990
 991                 $fullname = undef;
 992                 $name = $dir_pref . $FN;
 993                 $_ = ($no_chdir ? $name : $FN);
 994                 { $wanted_callback->() };
 995                 next;
 996             }
 997
 998             if (-d _) {
 999                 if ($Is_VMS) {
1000                     $FN =~ s/\.dir\z//i;
1001                     $FN =~ s#\.$## if ($FN ne '.');
1002                     $new_loc =~ s/\.dir\z//i;
1003                     $new_loc =~ s#\.$## if ($new_loc ne '.');
1004                 }
1005                 push @Stack,[$new_loc,$updir_loc,$dir_name,$FN,1];
1006             }
1007             else {
1008                 $fullname = $new_loc; # $File::Find::fullname
1009                 $name = $dir_pref . $FN; # $File::Find::name
1010                 $_ = ($no_chdir ? $name : $FN); # $_
1011                 { $wanted_callback->() }; # protect against wild "next"
1012             }
1013         }
1014
1015     }
1016     continue {
1017         while (defined($SE = pop @Stack)) {
1018             ($dir_loc, $updir_loc, $p_dir, $dir_rel, $byd_flag) = @$SE;
1019             $dir_name = ($p_dir eq '/' ? "/$dir_rel" : "$p_dir/$dir_rel");
1020             $dir_pref = "$dir_name/";
1021             $loc_pref = "$dir_loc/";
1022             if ( $byd_flag < 0 ) {  # must be finddepth, report dirname now
1023                 unless ($no_chdir || ($dir_rel eq $File::Find::current_dir)) {
1024                     unless (chdir $updir_loc) { # $updir_loc (parent dir) is always untainted
1025                         warnings::warnif "Can't cd to $updir_loc: $!\n";
1026                         next;
1027                     }
1028                 }
1029                 $fullname = $dir_loc; # $File::Find::fullname
1030                 $name = $dir_name; # $File::Find::name
1031                 if ( substr($name,-2) eq '/.' ) {
1032                     substr($name, length($name) == 2 ? -1 : -2) = ''; # $File::Find::name
1033                 }
1034                 $dir = $p_dir; # $File::Find::dir
1035                 $_ = ($no_chdir ? $dir_name : $dir_rel); # $_
1036                 if ( substr($_,-2) eq '/.' ) {
1037                     substr($_, length($_) == 2 ? -1 : -2) = '';
1038                 }
1039
1040                 lstat($_); # make sure file tests with '_' work
1041                 { $wanted_callback->() }; # protect against wild "next"
1042             }
1043             else {
1044                 push @Stack,[$dir_loc, $updir_loc, $p_dir, $dir_rel,-1]  if  $bydepth;
1045                 last;
1046             }
1047         }
1048     }
1049 }
1050
1051
1052 sub wrap_wanted {
1053     my $wanted = shift;
1054     if ( ref($wanted) eq 'HASH' ) {
1055         unless( exists $wanted->{wanted} and ref( $wanted->{wanted} ) eq 'CODE' ) {
1056             die 'no &wanted subroutine given';
1057         }
1058         if ( $wanted->{follow} || $wanted->{follow_fast}) {
1059             $wanted->{follow_skip} = 1 unless defined $wanted->{follow_skip};
1060         }
1061         if ( $wanted->{untaint} ) {
1062             $wanted->{untaint_pattern} = $File::Find::untaint_pattern
1063                 unless defined $wanted->{untaint_pattern};
1064             $wanted->{untaint_skip} = 0 unless defined $wanted->{untaint_skip};
1065         }
1066         return $wanted;
1067     }
1068     elsif( ref( $wanted ) eq 'CODE' ) {
1069         return { wanted => $wanted };
1070     }
1071     else {
1072        die 'no &wanted subroutine given';
1073     }
1074 }
1075
1076 sub find {
1077     my $wanted = shift;
1078     _find_opt(wrap_wanted($wanted), @_);
1079 }
1080
1081 sub finddepth {
1082     my $wanted = wrap_wanted(shift);
1083     $wanted->{bydepth} = 1;
1084     _find_opt($wanted, @_);
1085 }
1086
1087 # default
1088 $File::Find::skip_pattern    = qr/^\.{1,2}\z/;
1089 $File::Find::untaint_pattern = qr|^([-+@\w./]+)$|;
1090
1091 # These are hard-coded for now, but may move to hint files.
1092 if ($^O eq 'VMS') {
1093     $Is_VMS = 1;
1094     $File::Find::dont_use_nlink  = 1;
1095 }
1096 elsif ($^O eq 'MSWin32') {
1097     $Is_Win32 = 1;
1098 }
1099
1100 # this _should_ work properly on all platforms
1101 # where File::Find can be expected to work
1102 $File::Find::current_dir = File::Spec->curdir || '.';
1103
1104 $File::Find::dont_use_nlink = 1
1105     if $^O eq 'os2' || $^O eq 'dos' || $^O eq 'amigaos' || $Is_Win32 ||
1106        $^O eq 'interix' || $^O eq 'cygwin' || $^O eq 'epoc' || $^O eq 'qnx' ||
1107            $^O eq 'nto';
1108
1109 # Set dont_use_nlink in your hint file if your system's stat doesn't
1110 # report the number of links in a directory as an indication
1111 # of the number of files.
1112 # See, e.g. hints/machten.sh for MachTen 2.2.
1113 unless ($File::Find::dont_use_nlink) {
1114     require Config;
1115     $File::Find::dont_use_nlink = 1 if ($Config::Config{'dont_use_nlink'});
1116 }
1117
1118 # We need a function that checks if a scalar is tainted. Either use the
1119 # Scalar::Util module's tainted() function or our (slower) pure Perl
1120 # fallback is_tainted_pp()
1121 {
1122     local $@;
1123     eval { require Scalar::Util };
1124     *is_tainted = $@ ? \&is_tainted_pp : \&Scalar::Util::tainted;
1125 }
1126
1127 1;