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