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.09';
   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 toC<$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         if ($Is_MacOS) {
 627             ($topdev,$topino,$topmode,$topnlink) = $follow ? stat $top_item : lstat $top_item;
 628             $top_item = ":$top_item"
 629                 if ( (-d _) && ( $top_item !~ /:/ ) );
 630         }
 631         else {
 632             $top_item =~ s|/\z|| unless $top_item eq '/';
 633             ($topdev,$topino,$topmode,$topnlink) = $follow ? stat $top_item : lstat $top_item;
 634         }
 635
 636         $Is_Dir= 0;
 637
 638         if ($follow) {
 639
 640             if ($Is_MacOS) {
 641                 $cwd = "$cwd:" unless ($cwd =~ /:$/); # for safety
 642
 643                 if ($top_item eq $File::Find::current_dir) {
 644                     $abs_dir = $cwd;
 645                 }
 646                 else {
 647                     $abs_dir = contract_name_Mac($cwd, $top_item);
 648                     unless (defined $abs_dir) {
 649                         warnings::warnif "Can't determine absolute path for $top_item (No such file or directory)\n";
 650                         next Proc_Top_Item;
 651                     }
 652                 }
 653
 654             }
 655             else {
 656                 if (substr($top_item,0,1) eq '/') {
 657                     $abs_dir = $top_item;
 658                 }
 659                 elsif ($top_item eq $File::Find::current_dir) {
 660                     $abs_dir = $cwd;
 661                 }
 662                 else {  # care about any  ../
 663                     $abs_dir = contract_name("$cwd/",$top_item);
 664                 }
 665             }
 666             $abs_dir= Follow_SymLink($abs_dir);
 667             unless (defined $abs_dir) {
 668                 if ($dangling_symlinks) {
 669                     if (ref $dangling_symlinks eq 'CODE') {
 670                         $dangling_symlinks->($top_item, $cwd);
 671                     } else {
 672                         warnings::warnif "$top_item is a dangling symbolic link\n";
 673                     }
 674                 }
 675                 next Proc_Top_Item;
 676             }
 677
 678             if (-d _) {
 679                 _find_dir_symlnk($wanted, $abs_dir, $top_item);
 680                 $Is_Dir= 1;
 681             }
 682         }
 683         else { # no follow
 684             $topdir = $top_item;
 685             unless (defined $topnlink) {
 686                 warnings::warnif "Can't stat $top_item: $!\n";
 687                 next Proc_Top_Item;
 688             }
 689             if (-d _) {
 690                 $top_item =~ s/\.dir\z//i if $Is_VMS;
 691                 _find_dir($wanted, $top_item, $topnlink);
 692                 $Is_Dir= 1;
 693             }
 694             else {
 695                 $abs_dir= $top_item;
 696             }
 697         }
 698
 699         unless ($Is_Dir) {
 700             unless (($_,$dir) = File::Basename::fileparse($abs_dir)) {
 701                 if ($Is_MacOS) {
 702                     ($dir,$_) = (':', $top_item); # $File::Find::dir, $_
 703                 }
 704                 else {
 705                     ($dir,$_) = ('./', $top_item);
 706                 }
 707             }
 708
 709             $abs_dir = $dir;
 710             if (( $untaint ) && (is_tainted($dir) )) {
 711                 ( $abs_dir ) = $dir =~ m|$untaint_pat|;
 712                 unless (defined $abs_dir) {
 713                     if ($untaint_skip == 0) {
 714                         die "directory $dir is still tainted";
 715                     }
 716                     else {
 717                         next Proc_Top_Item;
 718                     }
 719                 }
 720             }
 721
 722             unless ($no_chdir || chdir $abs_dir) {
 723                 warnings::warnif "Couldn't chdir $abs_dir: $!\n";
 724                 next Proc_Top_Item;
 725             }
 726
 727             $name = $abs_dir . $_; # $File::Find::name
 728             $_ = $name if $no_chdir;
 729
 730             { $wanted_callback->() }; # protect against wild "next"
 731
 732         }
 733
 734         unless ( $no_chdir ) {
 735             if ( ($check_t_cwd) && (($untaint) && (is_tainted($cwd) )) ) {
 736                 ( $cwd_untainted ) = $cwd =~ m|$untaint_pat|;
 737                 unless (defined $cwd_untainted) {
 738                     die "insecure cwd in find(depth)";
 739                 }
 740                 $check_t_cwd = 0;
 741             }
 742             unless (chdir $cwd_untainted) {
 743                 die "Can't cd to $cwd: $!\n";
 744             }
 745         }
 746     }
 747 }
 748
 749 # API:
 750 #  $wanted
 751 #  $p_dir :  "parent directory"
 752 #  $nlink :  what came back from the stat
 753 # preconditions:
 754 #  chdir (if not no_chdir) to dir
 755
 756 sub _find_dir($$$) {
 757     my ($wanted, $p_dir, $nlink) = @_;
 758     my ($CdLvl,$Level) = (0,0);
 759     my @Stack;
 760     my @filenames;
 761     my ($subcount,$sub_nlink);
 762     my $SE= [];
 763     my $dir_name= $p_dir;
 764     my $dir_pref;
 765     my $dir_rel = $File::Find::current_dir;
 766     my $tainted = 0;
 767     my $no_nlink;
 768
 769     if ($Is_MacOS) {
 770         $dir_pref= ($p_dir =~ /:$/) ? $p_dir : "$p_dir:"; # preface
 771     }
 772     else {
 773         $dir_pref= ( $p_dir eq '/' ? '/' : "$p_dir/" );
 774     }
 775
 776     local ($dir, $name, $prune, *DIR);
 777
 778     unless ( $no_chdir || ($p_dir eq $File::Find::current_dir)) {
 779         my $udir = $p_dir;
 780         if (( $untaint ) && (is_tainted($p_dir) )) {
 781             ( $udir ) = $p_dir =~ m|$untaint_pat|;
 782             unless (defined $udir) {
 783                 if ($untaint_skip == 0) {
 784                     die "directory $p_dir is still tainted";
 785                 }
 786                 else {
 787                     return;
 788                 }
 789             }
 790         }
 791         unless (chdir ($Is_VMS && $udir !~ /[\/\[<]+/ ? "./$udir" : $udir)) {
 792             warnings::warnif "Can't cd to $udir: $!\n";
 793             return;
 794         }
 795     }
 796
 797     # push the starting directory
 798     push @Stack,[$CdLvl,$p_dir,$dir_rel,-1]  if  $bydepth;
 799
 800     if ($Is_MacOS) {
 801         $p_dir = $dir_pref;  # ensure trailing ':'
 802     }
 803
 804     while (defined $SE) {
 805         unless ($bydepth) {
 806             $dir= $p_dir; # $File::Find::dir
 807             $name= $dir_name; # $File::Find::name
 808             $_= ($no_chdir ? $dir_name : $dir_rel ); # $_
 809             # prune may happen here
 810             $prune= 0;
 811             { $wanted_callback->() };   # protect against wild "next"
 812             next if $prune;
 813         }
 814
 815         # change to that directory
 816         unless ($no_chdir || ($dir_rel eq $File::Find::current_dir)) {
 817             my $udir= $dir_rel;
 818             if ( ($untaint) && (($tainted) || ($tainted = is_tainted($dir_rel) )) ) {
 819                 ( $udir ) = $dir_rel =~ m|$untaint_pat|;
 820                 unless (defined $udir) {
 821                     if ($untaint_skip == 0) {
 822                         if ($Is_MacOS) {
 823                             die "directory ($p_dir) $dir_rel is still tainted";
 824                         }
 825                         else {
 826                             die "directory (" . ($p_dir ne '/' ? $p_dir : '') . "/) $dir_rel is still tainted";
 827                         }
 828                     } else { # $untaint_skip == 1
 829                         next;
 830                     }
 831                 }
 832             }
 833             unless (chdir ($Is_VMS && $udir !~ /[\/\[<]+/ ? "./$udir" : $udir)) {
 834                 if ($Is_MacOS) {
 835                     warnings::warnif "Can't cd to ($p_dir) $udir: $!\n";
 836                 }
 837                 else {
 838                     warnings::warnif "Can't cd to (" .
 839                         ($p_dir ne '/' ? $p_dir : '') . "/) $udir: $!\n";
 840                 }
 841                 next;
 842             }
 843             $CdLvl++;
 844         }
 845
 846         if ($Is_MacOS) {
 847             $dir_name = "$dir_name:" unless ($dir_name =~ /:$/);
 848         }
 849
 850         $dir= $dir_name; # $File::Find::dir
 851
 852         # Get the list of files in the current directory.
 853         unless (opendir DIR, ($no_chdir ? $dir_name : $File::Find::current_dir)) {
 854             warnings::warnif "Can't opendir($dir_name): $!\n";
 855             next;
 856         }
 857         @filenames = readdir DIR;
 858         closedir(DIR);
 859         @filenames = $pre_process->(@filenames) if $pre_process;
 860         push @Stack,[$CdLvl,$dir_name,"",-2]   if $post_process;
 861
 862         # default: use whatever was specifid
 863         # (if $nlink >= 2, and $avoid_nlink == 0, this will switch back)
 864         $no_nlink = $avoid_nlink;
 865         # if dir has wrong nlink count, force switch to slower stat method
 866         $no_nlink = 1 if ($nlink < 2);
 867
 868         if ($nlink == 2 && !$no_nlink) {
 869             # This dir has no subdirectories.
 870             for my $FN (@filenames) {
 871                 next if $FN =~ $File::Find::skip_pattern;
 872
 873                 $name = $dir_pref . $FN; # $File::Find::name
 874                 $_ = ($no_chdir ? $name : $FN); # $_
 875                 { $wanted_callback->() }; # protect against wild "next"
 876             }
 877
 878         }
 879         else {
 880             # This dir has subdirectories.
 881             $subcount = $nlink - 2;
 882
 883             # HACK: insert directories at this position. so as to preserve
 884             # the user pre-processed ordering of files.
 885             # EG: directory traversal is in user sorted order, not at random.
 886             my $stack_top = @Stack;
 887
 888             for my $FN (@filenames) {
 889                 next if $FN =~ $File::Find::skip_pattern;
 890                 if ($subcount > 0 || $no_nlink) {
 891                     # Seen all the subdirs?
 892                     # check for directoriness.
 893                     # stat is faster for a file in the current directory
 894                     $sub_nlink = (lstat ($no_chdir ? $dir_pref . $FN : $FN))[3];
 895
 896                     if (-d _) {
 897                         --$subcount;
 898                         $FN =~ s/\.dir\z//i if $Is_VMS;
 899                         # HACK: replace push to preserve dir traversal order
 900                         #push @Stack,[$CdLvl,$dir_name,$FN,$sub_nlink];
 901                         splice @Stack, $stack_top, 0,
 902                                  [$CdLvl,$dir_name,$FN,$sub_nlink];
 903                     }
 904                     else {
 905                         $name = $dir_pref . $FN; # $File::Find::name
 906                         $_= ($no_chdir ? $name : $FN); # $_
 907                         { $wanted_callback->() }; # protect against wild "next"
 908                     }
 909                 }
 910                 else {
 911                     $name = $dir_pref . $FN; # $File::Find::name
 912                     $_= ($no_chdir ? $name : $FN); # $_
 913                     { $wanted_callback->() }; # protect against wild "next"
 914                 }
 915             }
 916         }
 917     }
 918     continue {
 919         while ( defined ($SE = pop @Stack) ) {
 920             ($Level, $p_dir, $dir_rel, $nlink) = @$SE;
 921             if ($CdLvl > $Level && !$no_chdir) {
 922                 my $tmp;
 923                 if ($Is_MacOS) {
 924                     $tmp = (':' x ($CdLvl-$Level)) . ':';
 925                 }
 926                 else {
 927                     $tmp = join('/',('..') x ($CdLvl-$Level));
 928                 }
 929                 die "Can't cd to $dir_name" . $tmp
 930                     unless chdir ($tmp);
 931                 $CdLvl = $Level;
 932             }
 933
 934             if ($Is_MacOS) {
 935                 # $pdir always has a trailing ':', except for the starting dir,
 936                 # where $dir_rel eq ':'
 937                 $dir_name = "$p_dir$dir_rel";
 938                 $dir_pref = "$dir_name:";
 939             }
 940             else {
 941                 $dir_name = ($p_dir eq '/' ? "/$dir_rel" : "$p_dir/$dir_rel");
 942                 $dir_pref = "$dir_name/";
 943             }
 944
 945             if ( $nlink == -2 ) {
 946                 $name = $dir = $p_dir; # $File::Find::name / dir
 947                 $_ = $File::Find::current_dir;
 948                 $post_process->();              # End-of-directory processing
 949             }
 950             elsif ( $nlink < 0 ) {  # must be finddepth, report dirname now
 951                 $name = $dir_name;
 952                 if ($Is_MacOS) {
 953                     if ($dir_rel eq ':') { # must be the top dir, where we started
 954                         $name =~ s|:$||; # $File::Find::name
 955                         $p_dir = "$p_dir:" unless ($p_dir =~ /:$/);
 956                     }
 957                     $dir = $p_dir; # $File::Find::dir
 958                     $_ = ($no_chdir ? $name : $dir_rel); # $_
 959                 }
 960                 else {
 961                     if ( substr($name,-2) eq '/.' ) {
 962                         substr($name, length($name) == 2 ? -1 : -2) = '';
 963                     }
 964                     $dir = $p_dir;
 965                     $_ = ($no_chdir ? $dir_name : $dir_rel );
 966                     if ( substr($_,-2) eq '/.' ) {
 967                         substr($_, length($_) == 2 ? -1 : -2) = '';
 968                     }
 969                 }
 970                 { $wanted_callback->() }; # protect against wild "next"
 971              }
 972              else {
 973                 push @Stack,[$CdLvl,$p_dir,$dir_rel,-1]  if  $bydepth;
 974                 last;
 975             }
 976         }
 977     }
 978 }
 979
 980
 981 # API:
 982 #  $wanted
 983 #  $dir_loc : absolute location of a dir
 984 #  $p_dir   : "parent directory"
 985 # preconditions:
 986 #  chdir (if not no_chdir) to dir
 987
 988 sub _find_dir_symlnk($$$) {
 989     my ($wanted, $dir_loc, $p_dir) = @_; # $dir_loc is the absolute directory
 990     my @Stack;
 991     my @filenames;
 992     my $new_loc;
 993     my $updir_loc = $dir_loc; # untainted parent directory
 994     my $SE = [];
 995     my $dir_name = $p_dir;
 996     my $dir_pref;
 997     my $loc_pref;
 998     my $dir_rel = $File::Find::current_dir;
 999     my $byd_flag; # flag for pending stack entry if $bydepth
1000     my $tainted = 0;
1001     my $ok = 1;
1002
1003     if ($Is_MacOS) {
1004         $dir_pref = ($p_dir =~ /:$/) ? "$p_dir" : "$p_dir:";
1005         $loc_pref = ($dir_loc =~ /:$/) ? "$dir_loc" : "$dir_loc:";
1006     } else {
1007         $dir_pref = ( $p_dir   eq '/' ? '/' : "$p_dir/" );
1008         $loc_pref = ( $dir_loc eq '/' ? '/' : "$dir_loc/" );
1009     }
1010
1011     local ($dir, $name, $fullname, $prune, *DIR);
1012
1013     unless ($no_chdir) {
1014         # untaint the topdir
1015         if (( $untaint ) && (is_tainted($dir_loc) )) {
1016             ( $updir_loc ) = $dir_loc =~ m|$untaint_pat|; # parent dir, now untainted
1017              # once untainted, $updir_loc is pushed on the stack (as parent directory);
1018             # hence, we don't need to untaint the parent directory every time we chdir
1019             # to it later
1020             unless (defined $updir_loc) {
1021                 if ($untaint_skip == 0) {
1022                     die "directory $dir_loc is still tainted";
1023                 }
1024                 else {
1025                     return;
1026                 }
1027             }
1028         }
1029         $ok = chdir($updir_loc) unless ($p_dir eq $File::Find::current_dir);
1030         unless ($ok) {
1031             warnings::warnif "Can't cd to $updir_loc: $!\n";
1032             return;
1033         }
1034     }
1035
1036     push @Stack,[$dir_loc,$updir_loc,$p_dir,$dir_rel,-1]  if  $bydepth;
1037
1038     if ($Is_MacOS) {
1039         $p_dir = $dir_pref; # ensure trailing ':'
1040     }
1041
1042     while (defined $SE) {
1043
1044         unless ($bydepth) {
1045             # change (back) to parent directory (always untainted)
1046             unless ($no_chdir) {
1047                 unless (chdir $updir_loc) {
1048                     warnings::warnif "Can't cd to $updir_loc: $!\n";
1049                     next;
1050                 }
1051             }
1052             $dir= $p_dir; # $File::Find::dir
1053             $name= $dir_name; # $File::Find::name
1054             $_= ($no_chdir ? $dir_name : $dir_rel ); # $_
1055             $fullname= $dir_loc; # $File::Find::fullname
1056             # prune may happen here
1057             $prune= 0;
1058             lstat($_); # make sure  file tests with '_' work
1059             { $wanted_callback->() }; # protect against wild "next"
1060             next if $prune;
1061         }
1062
1063         # change to that directory
1064         unless ($no_chdir || ($dir_rel eq $File::Find::current_dir)) {
1065             $updir_loc = $dir_loc;
1066             if ( ($untaint) && (($tainted) || ($tainted = is_tainted($dir_loc) )) ) {
1067                 # untaint $dir_loc, what will be pushed on the stack as (untainted) parent dir
1068                 ( $updir_loc ) = $dir_loc =~ m|$untaint_pat|;
1069                 unless (defined $updir_loc) {
1070                     if ($untaint_skip == 0) {
1071                         die "directory $dir_loc is still tainted";
1072                     }
1073                     else {
1074                         next;
1075                     }
1076                 }
1077             }
1078             unless (chdir $updir_loc) {
1079                 warnings::warnif "Can't cd to $updir_loc: $!\n";
1080                 next;
1081             }
1082         }
1083
1084         if ($Is_MacOS) {
1085             $dir_name = "$dir_name:" unless ($dir_name =~ /:$/);
1086         }
1087
1088         $dir = $dir_name; # $File::Find::dir
1089
1090         # Get the list of files in the current directory.
1091         unless (opendir DIR, ($no_chdir ? $dir_loc : $File::Find::current_dir)) {
1092             warnings::warnif "Can't opendir($dir_loc): $!\n";
1093             next;
1094         }
1095         @filenames = readdir DIR;
1096         closedir(DIR);
1097
1098         for my $FN (@filenames) {
1099             next if $FN =~ $File::Find::skip_pattern;
1100
1101             # follow symbolic links / do an lstat
1102             $new_loc = Follow_SymLink($loc_pref.$FN);
1103
1104             # ignore if invalid symlink
1105             unless (defined $new_loc) {
1106                 if ($dangling_symlinks) {
1107                     if (ref $dangling_symlinks eq 'CODE') {
1108                         $dangling_symlinks->($FN, $dir_pref);
1109                     } else {
1110                         warnings::warnif "$dir_pref$FN is a dangling symbolic link\n";
1111                     }
1112                 }
1113
1114                 $fullname = undef;
1115                 $name = $dir_pref . $FN;
1116                 $_ = ($no_chdir ? $name : $FN);
1117                 { $wanted_callback->() };
1118                 next;
1119             }
1120
1121             if (-d _) {
1122                 push @Stack,[$new_loc,$updir_loc,$dir_name,$FN,1];
1123             }
1124             else {
1125                 $fullname = $new_loc; # $File::Find::fullname
1126                 $name = $dir_pref . $FN; # $File::Find::name
1127                 $_ = ($no_chdir ? $name : $FN); # $_
1128                 { $wanted_callback->() }; # protect against wild "next"
1129             }
1130         }
1131
1132     }
1133     continue {
1134         while (defined($SE = pop @Stack)) {
1135             ($dir_loc, $updir_loc, $p_dir, $dir_rel, $byd_flag) = @$SE;
1136             if ($Is_MacOS) {
1137                 # $p_dir always has a trailing ':', except for the starting dir,
1138                 # where $dir_rel eq ':'
1139                 $dir_name = "$p_dir$dir_rel";
1140                 $dir_pref = "$dir_name:";
1141                 $loc_pref = ($dir_loc =~ /:$/) ? $dir_loc : "$dir_loc:";
1142             }
1143             else {
1144                 $dir_name = ($p_dir eq '/' ? "/$dir_rel" : "$p_dir/$dir_rel");
1145                 $dir_pref = "$dir_name/";
1146                 $loc_pref = "$dir_loc/";
1147             }
1148             if ( $byd_flag < 0 ) {  # must be finddepth, report dirname now
1149                 unless ($no_chdir || ($dir_rel eq $File::Find::current_dir)) {
1150                     unless (chdir $updir_loc) { # $updir_loc (parent dir) is always untainted
1151                         warnings::warnif "Can't cd to $updir_loc: $!\n";
1152                         next;
1153                     }
1154                 }
1155                 $fullname = $dir_loc; # $File::Find::fullname
1156                 $name = $dir_name; # $File::Find::name
1157                 if ($Is_MacOS) {
1158                     if ($dir_rel eq ':') { # must be the top dir, where we started
1159                         $name =~ s|:$||; # $File::Find::name
1160                         $p_dir = "$p_dir:" unless ($p_dir =~ /:$/);
1161                     }
1162                     $dir = $p_dir; # $File::Find::dir
1163                      $_ = ($no_chdir ? $name : $dir_rel); # $_
1164                 }
1165                 else {
1166                     if ( substr($name,-2) eq '/.' ) {
1167                         substr($name, length($name) == 2 ? -1 : -2) = ''; # $File::Find::name
1168                     }
1169                     $dir = $p_dir; # $File::Find::dir
1170                     $_ = ($no_chdir ? $dir_name : $dir_rel); # $_
1171                     if ( substr($_,-2) eq '/.' ) {
1172                         substr($_, length($_) == 2 ? -1 : -2) = '';
1173                     }
1174                 }
1175
1176                 lstat($_); # make sure file tests with '_' work
1177                 { $wanted_callback->() }; # protect against wild "next"
1178             }
1179             else {
1180                 push @Stack,[$dir_loc, $updir_loc, $p_dir, $dir_rel,-1]  if  $bydepth;
1181                 last;
1182             }
1183         }
1184     }
1185 }
1186
1187
1188 sub wrap_wanted {
1189     my $wanted = shift;
1190     if ( ref($wanted) eq 'HASH' ) {
1191         if ( $wanted->{follow} || $wanted->{follow_fast}) {
1192             $wanted->{follow_skip} = 1 unless defined $wanted->{follow_skip};
1193         }
1194         if ( $wanted->{untaint} ) {
1195             $wanted->{untaint_pattern} = $File::Find::untaint_pattern
1196                 unless defined $wanted->{untaint_pattern};
1197             $wanted->{untaint_skip} = 0 unless defined $wanted->{untaint_skip};
1198         }
1199         return $wanted;
1200     }
1201     else {
1202         return { wanted => $wanted };
1203     }
1204 }
1205
1206 sub find {
1207     my $wanted = shift;
1208     _find_opt(wrap_wanted($wanted), @_);
1209 }
1210
1211 sub finddepth {
1212     my $wanted = wrap_wanted(shift);
1213     $wanted->{bydepth} = 1;
1214     _find_opt($wanted, @_);
1215 }
1216
1217 # default
1218 $File::Find::skip_pattern    = qr/^\.{1,2}\z/;
1219 $File::Find::untaint_pattern = qr|^([-+@\w./]+)$|;
1220
1221 # These are hard-coded for now, but may move to hint files.
1222 if ($^O eq 'VMS') {
1223     $Is_VMS = 1;
1224     $File::Find::dont_use_nlink  = 1;
1225 }
1226 elsif ($^O eq 'MacOS') {
1227     $Is_MacOS = 1;
1228     $File::Find::dont_use_nlink  = 1;
1229     $File::Find::skip_pattern    = qr/^Icon\015\z/;
1230     $File::Find::untaint_pattern = qr|^(.+)$|;
1231 }
1232
1233 # this _should_ work properly on all platforms
1234 # where File::Find can be expected to work
1235 $File::Find::current_dir = File::Spec->curdir || '.';
1236
1237 $File::Find::dont_use_nlink = 1
1238     if $^O eq 'os2' || $^O eq 'dos' || $^O eq 'amigaos' || $^O eq 'MSWin32' ||
1239        $^O eq 'interix' || $^O eq 'cygwin' || $^O eq 'epoc' || $^O eq 'qnx' ||
1240            $^O eq 'nto';
1241
1242 # Set dont_use_nlink in your hint file if your system's stat doesn't
1243 # report the number of links in a directory as an indication
1244 # of the number of files.
1245 # See, e.g. hints/machten.sh for MachTen 2.2.
1246 unless ($File::Find::dont_use_nlink) {
1247     require Config;
1248     $File::Find::dont_use_nlink = 1 if ($Config::Config{'dont_use_nlink'});
1249 }
1250
1251 # We need a function that checks if a scalar is tainted. Either use the
1252 # Scalar::Util module's tainted() function or our (slower) pure Perl
1253 # fallback is_tainted_pp()
1254 {
1255     local $@;
1256     eval { require Scalar::Util };
1257     *is_tainted = $@ ? \&is_tainted_pp : \&Scalar::Util::tainted;
1258 }
1259
1260 1;