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