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