lib/File/Find.pm

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