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