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