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