lib/File/Find.pm

   1 package File::Find;
   2 use 5.005_64;
   3 require Exporter;
   4 require Cwd;
   5
   6 =head1 NAME
   7
   8 find - traverse a file tree
   9
  10 finddepth - traverse a directory structure depth-first
  11
  12 =head1 SYNOPSIS
  13
  14     use File::Find;
  15     find(\&wanted, '/foo', '/bar');
  16     sub wanted { ... }
  17
  18     use File::Find;
  19     finddepth(\&wanted, '/foo', '/bar');
  20     sub wanted { ... }
  21
  22     use File::Find;
  23     find({ wanted => \&process, follow => 1 }, '.');
  24
  25 =head1 DESCRIPTION
  26
  27 The first argument to find() is either a hash reference describing the
  28 operations to be performed for each file, or a code reference.
  29
  30 Here are the possible keys for the hash:
  31
  32 =over 3
  33
  34 =item C<wanted>
  35
  36 The value should be a code reference.  This code reference is called
  37 I<the wanted() function> below.
  38
  39 =item C<bydepth>
  40
  41 Reports the name of a directory only AFTER all its entries
  42 have been reported.  Entry point finddepth() is a shortcut for
  43 specifying C<{ bydepth => 1 }> in the first argument of find().
  44
  45 =item C<preprocess>
  46
  47 The value should be a code reference.  This code reference is used to
  48 preprocess a directory; it is called after readdir() but before the loop that
  49 calls the wanted() function.  It is called with a list of strings and is
  50 expected to return a list of strings.  The code can be used to sort the
  51 strings alphabetically, numerically, or to filter out directory entries based
  52 on their name alone.
  53
  54 =item C<postprocess>
  55
  56 The value should be a code reference.  It is invoked just before leaving the
  57 current directory.  It is called in void context with no arguments.  The name
  58 of the current directory is in $File::Find::dir.  This hook is handy for
  59 summarizing a directory, such as calculating its disk usage.
  60
  61 =item C<follow>
  62
  63 Causes symbolic links to be followed. Since directory trees with symbolic
  64 links (followed) may contain files more than once and may even have
  65 cycles, a hash has to be built up with an entry for each file.
  66 This might be expensive both in space and time for a large
  67 directory tree. See I<follow_fast> and I<follow_skip> below.
  68 If either I<follow> or I<follow_fast> is in effect:
  69
  70 =over 6
  71
  72 =item *
  73
  74 It is guaranteed that an I<lstat> has been called before the user's
  75 I<wanted()> function is called. This enables fast file checks involving S< _>.
  76
  77 =item *
  78
  79 There is a variable C<$File::Find::fullname> which holds the absolute
  80 pathname of the file with all symbolic links resolved
  81
  82 =back
  83
  84 =item C<follow_fast>
  85
  86 This is similar to I<follow> except that it may report some files more
  87 than once.  It does detect cycles, however.  Since only symbolic links
  88 have to be hashed, this is much cheaper both in space and time.  If
  89 processing a file more than once (by the user's I<wanted()> function)
  90 is worse than just taking time, the option I<follow> should be used.
  91
  92 =item C<follow_skip>
  93
  94 C<follow_skip==1>, which is the default, causes all files which are
  95 neither directories nor symbolic links to be ignored if they are about
  96 to be processed a second time. If a directory or a symbolic link
  97 are about to be processed a second time, File::Find dies.
  98 C<follow_skip==0> causes File::Find to die if any file is about to be
  99 processed a second time.
 100 C<follow_skip==2> causes File::Find to ignore any duplicate files and
 101 dirctories but to proceed normally otherwise.
 102
 103
 104 =item C<no_chdir>
 105
 106 Does not C<chdir()> to each directory as it recurses. The wanted()
 107 function will need to be aware of this, of course. In this case,
 108 C<$_> will be the same as C<$File::Find::name>.
 109
 110 =item C<untaint>
 111
 112 If find is used in taint-mode (-T command line switch or if EUID != UID
 113 or if EGID != GID) then internally directory names have to be untainted
 114 before they can be cd'ed to. Therefore they are checked against a regular
 115 expression I<untaint_pattern>.  Note that all names passed to the
 116 user's I<wanted()> function are still tainted.
 117
 118 =item C<untaint_pattern>
 119
 120 See above. This should be set using the C<qr> quoting operator.
 121 The default is set to  C<qr|^([-+@\w./]+)$|>.
 122 Note that the parantheses are vital.
 123
 124 =item C<untaint_skip>
 125
 126 If set, directories (subtrees) which fail the I<untaint_pattern>
 127 are skipped. The default is to 'die' in such a case.
 128
 129 =back
 130
 131 The wanted() function does whatever verifications you want.
 132 C<$File::Find::dir> contains the current directory name, and C<$_> the
 133 current filename within that directory.  C<$File::Find::name> contains
 134 the complete pathname to the file. You are chdir()'d to
 135 C<$File::Find::dir> when the function is called, unless C<no_chdir>
 136 was specified.  When <follow> or <follow_fast> are in effect, there is
 137 also a C<$File::Find::fullname>.  The function may set
 138 C<$File::Find::prune> to prune the tree unless C<bydepth> was
 139 specified.  Unless C<follow> or C<follow_fast> is specified, for
 140 compatibility reasons (find.pl, find2perl) there are in addition the
 141 following globals available: C<$File::Find::topdir>,
 142 C<$File::Find::topdev>, C<$File::Find::topino>,
 143 C<$File::Find::topmode> and C<$File::Find::topnlink>.
 144
 145 This library is useful for the C<find2perl> tool, which when fed,
 146
 147     find2perl / -name .nfs\* -mtime +7 \
 148         -exec rm -f {} \; -o -fstype nfs -prune
 149
 150 produces something like:
 151
 152     sub wanted {
 153         /^\.nfs.*\z/s &&
 154         (($dev, $ino, $mode, $nlink, $uid, $gid) = lstat($_)) &&
 155         int(-M _) > 7 &&
 156         unlink($_)
 157         ||
 158         ($nlink || (($dev, $ino, $mode, $nlink, $uid, $gid) = lstat($_))) &&
 159         $dev < 0 &&
 160         ($File::Find::prune = 1);
 161     }
 162
 163 Set the variable C<$File::Find::dont_use_nlink> if you're using AFS,
 164 since AFS cheats.
 165
 166
 167 Here's another interesting wanted function.  It will find all symlinks
 168 that don't resolve:
 169
 170     sub wanted {
 171          -l && !-e && print "bogus link: $File::Find::name\n";
 172     }
 173
 174 See also the script C<pfind> on CPAN for a nice application of this
 175 module.
 176
 177 =head1 CAVEAT
 178
 179 Be aware that the option to follow symbolic links can be dangerous.
 180 Depending on the structure of the directory tree (including symbolic
 181 links to directories) you might traverse a given (physical) directory
 182 more than once (only if C<follow_fast> is in effect).
 183 Furthermore, deleting or changing files in a symbolically linked directory
 184 might cause very unpleasant surprises, since you delete or change files
 185 in an unknown directory.
 186
 187
 188 =cut
 189
 190 @ISA = qw(Exporter);
 191 @EXPORT = qw(find finddepth);
 192
 193
 194 use strict;
 195 my $Is_VMS;
 196
 197 require File::Basename;
 198
 199 my %SLnkSeen;
 200 my ($wanted_callback, $avoid_nlink, $bydepth, $no_chdir, $follow,
 201     $follow_skip, $full_check, $untaint, $untaint_skip, $untaint_pat,
 202     $pre_process, $post_process);
 203
 204 sub contract_name {
 205     my ($cdir,$fn) = @_;
 206
 207     return substr($cdir,0,rindex($cdir,'/')) if $fn eq '.';
 208
 209     $cdir = substr($cdir,0,rindex($cdir,'/')+1);
 210
 211     $fn =~ s|^\./||;
 212
 213     my $abs_name= $cdir . $fn;
 214
 215     if (substr($fn,0,3) eq '../') {
 216         do 1 while ($abs_name=~ s|/(?>[^/]+)/\.\./|/|);
 217     }
 218
 219     return $abs_name;
 220 }
 221
 222
 223 sub PathCombine($$) {
 224     my ($Base,$Name) = @_;
 225     my $AbsName;
 226
 227     if (substr($Name,0,1) eq '/') {
 228         $AbsName= $Name;
 229     }
 230     else {
 231         $AbsName= contract_name($Base,$Name);
 232     }
 233
 234     # (simple) check for recursion
 235     my $newlen= length($AbsName);
 236     if ($newlen <= length($Base)) {
 237         if (($newlen == length($Base) || substr($Base,$newlen,1) eq '/')
 238             && $AbsName eq substr($Base,0,$newlen))
 239         {
 240             return undef;
 241         }
 242     }
 243     return $AbsName;
 244 }
 245
 246 sub Follow_SymLink($) {
 247     my ($AbsName) = @_;
 248
 249     my ($NewName,$DEV, $INO);
 250     ($DEV, $INO)= lstat $AbsName;
 251
 252     while (-l _) {
 253         if ($SLnkSeen{$DEV, $INO}++) {
 254             if ($follow_skip < 2) {
 255                 die "$AbsName is encountered a second time";
 256             }
 257             else {
 258                 return undef;
 259             }
 260         }
 261         $NewName= PathCombine($AbsName, readlink($AbsName));
 262         unless(defined $NewName) {
 263             if ($follow_skip < 2) {
 264                 die "$AbsName is a recursive symbolic link";
 265             }
 266             else {
 267                 return undef;
 268             }
 269         }
 270         else {
 271             $AbsName= $NewName;
 272         }
 273         ($DEV, $INO) = lstat($AbsName);
 274         return undef unless defined $DEV;  #  dangling symbolic link
 275     }
 276
 277     if ($full_check && $SLnkSeen{$DEV, $INO}++) {
 278         if ($follow_skip < 1) {
 279             die "$AbsName encountered a second time";
 280         }
 281         else {
 282             return undef;
 283         }
 284     }
 285
 286     return $AbsName;
 287 }
 288
 289 our($dir, $name, $fullname, $prune);
 290 sub _find_dir_symlnk($$$);
 291 sub _find_dir($$$);
 292
 293 sub _find_opt {
 294     my $wanted = shift;
 295     die "invalid top directory" unless defined $_[0];
 296
 297     my $cwd           = $wanted->{bydepth} ? Cwd::fastcwd() : Cwd::cwd();
 298     my $cwd_untainted = $cwd;
 299     $wanted_callback  = $wanted->{wanted};
 300     $bydepth          = $wanted->{bydepth};
 301     $pre_process      = $wanted->{preprocess};
 302     $post_process     = $wanted->{postprocess};
 303     $no_chdir         = $wanted->{no_chdir};
 304     $full_check       = $wanted->{follow};
 305     $follow           = $full_check || $wanted->{follow_fast};
 306     $follow_skip      = $wanted->{follow_skip};
 307     $untaint          = $wanted->{untaint};
 308     $untaint_pat      = $wanted->{untaint_pattern};
 309     $untaint_skip     = $wanted->{untaint_skip};
 310
 311     # for compatability reasons (find.pl, find2perl)
 312     our ($topdir, $topdev, $topino, $topmode, $topnlink);
 313
 314     # a symbolic link to a directory doesn't increase the link count
 315     $avoid_nlink      = $follow || $File::Find::dont_use_nlink;
 316
 317     if ( $untaint ) {
 318         $cwd_untainted= $1 if $cwd_untainted =~ m|$untaint_pat|;
 319         die "insecure cwd in find(depth)"  unless defined($cwd_untainted);
 320     }
 321
 322     my ($abs_dir, $Is_Dir);
 323
 324     Proc_Top_Item:
 325     foreach my $TOP (@_) {
 326         my $top_item = $TOP;
 327         $top_item =~ s|/\z|| unless $top_item eq '/';
 328         $Is_Dir= 0;
 329
 330         ($topdev,$topino,$topmode,$topnlink) = stat $top_item;
 331
 332         if ($follow) {
 333             if (substr($top_item,0,1) eq '/') {
 334                 $abs_dir = $top_item;
 335             }
 336             elsif ($top_item eq '.') {
 337                 $abs_dir = $cwd;
 338             }
 339             else {  # care about any  ../
 340                 $abs_dir = contract_name("$cwd/",$top_item);
 341             }
 342             $abs_dir= Follow_SymLink($abs_dir);
 343             unless (defined $abs_dir) {
 344                 warn "$top_item is a dangling symbolic link\n";
 345                 next Proc_Top_Item;
 346             }
 347             if (-d _) {
 348                 _find_dir_symlnk($wanted, $abs_dir, $top_item);
 349                 $Is_Dir= 1;
 350             }
 351         }
 352         else { # no follow
 353             $topdir = $top_item;
 354             unless (defined $topnlink) {
 355                 warn "Can't stat $top_item: $!\n";
 356                 next Proc_Top_Item;
 357             }
 358             if (-d _) {
 359                 $top_item =~ s/\.dir\z// if $Is_VMS;
 360                 _find_dir($wanted, $top_item, $topnlink);
 361                 $Is_Dir= 1;
 362             }
 363             else {
 364                 $abs_dir= $top_item;
 365             }
 366         }
 367
 368         unless ($Is_Dir) {
 369             unless (($_,$dir) = File::Basename::fileparse($abs_dir)) {
 370                 ($dir,$_) = ('./', $top_item);
 371             }
 372
 373             $abs_dir = $dir;
 374             if ($untaint) {
 375                 my $abs_dir_save = $abs_dir;
 376                 $abs_dir = $1 if $abs_dir =~ m|$untaint_pat|;
 377                 unless (defined $abs_dir) {
 378                     if ($untaint_skip == 0) {
 379                         die "directory $abs_dir_save is still tainted";
 380                     }
 381                     else {
 382                         next Proc_Top_Item;
 383                     }
 384                 }
 385             }
 386
 387             unless ($no_chdir or chdir $abs_dir) {
 388                 warn "Couldn't chdir $abs_dir: $!\n";
 389                 next Proc_Top_Item;
 390             }
 391
 392             $name = $abs_dir . $_;
 393
 394             { &$wanted_callback }; # protect against wild "next"
 395
 396         }
 397
 398         $no_chdir or chdir $cwd_untainted;
 399     }
 400 }
 401
 402 # API:
 403 #  $wanted
 404 #  $p_dir :  "parent directory"
 405 #  $nlink :  what came back from the stat
 406 # preconditions:
 407 #  chdir (if not no_chdir) to dir
 408
 409 sub _find_dir($$$) {
 410     my ($wanted, $p_dir, $nlink) = @_;
 411     my ($CdLvl,$Level) = (0,0);
 412     my @Stack;
 413     my @filenames;
 414     my ($subcount,$sub_nlink);
 415     my $SE= [];
 416     my $dir_name= $p_dir;
 417     my $dir_pref= ( $p_dir eq '/' ? '/' : "$p_dir/" );
 418     my $dir_rel= '.';      # directory name relative to current directory
 419
 420     local ($dir, $name, $prune, *DIR);
 421
 422     unless ($no_chdir or $p_dir eq '.') {
 423         my $udir = $p_dir;
 424         if ($untaint) {
 425             $udir = $1 if $p_dir =~ m|$untaint_pat|;
 426             unless (defined $udir) {
 427                 if ($untaint_skip == 0) {
 428                     die "directory $p_dir is still tainted";
 429                 }
 430                 else {
 431                     return;
 432                 }
 433             }
 434         }
 435         unless (chdir $udir) {
 436             warn "Can't cd to $udir: $!\n";
 437             return;
 438         }
 439     }
 440
 441     push @Stack,[$CdLvl,$p_dir,$dir_rel,-1]  if  $bydepth;
 442
 443     while (defined $SE) {
 444         unless ($bydepth) {
 445             $dir= $p_dir;
 446             $name= $dir_name;
 447             $_= ($no_chdir ? $dir_name : $dir_rel );
 448             # prune may happen here
 449             $prune= 0;
 450             { &$wanted_callback };      # protect against wild "next"
 451             next if $prune;
 452         }
 453
 454         # change to that directory
 455         unless ($no_chdir or $dir_rel eq '.') {
 456             my $udir= $dir_rel;
 457             if ($untaint) {
 458                 $udir = $1 if $dir_rel =~ m|$untaint_pat|;
 459                 unless (defined $udir) {
 460                     if ($untaint_skip == 0) {
 461                         die "directory ("
 462                             . ($p_dir ne '/' ? $p_dir : '')
 463                             . "/) $dir_rel is still tainted";
 464                     }
 465                 }
 466             }
 467             unless (chdir $udir) {
 468                 warn "Can't cd to ("
 469                     . ($p_dir ne '/' ? $p_dir : '')
 470                     . "/) $udir : $!\n";
 471                 next;
 472             }
 473             $CdLvl++;
 474         }
 475
 476         $dir= $dir_name;
 477
 478         # Get the list of files in the current directory.
 479         unless (opendir DIR, ($no_chdir ? $dir_name : '.')) {
 480             warn "Can't opendir($dir_name): $!\n";
 481             next;
 482         }
 483         @filenames = readdir DIR;
 484         closedir(DIR);
 485         @filenames = &$pre_process(@filenames) if $pre_process;
 486         push @Stack,[$CdLvl,$dir_name,"",-2]   if $post_process;
 487
 488         if ($nlink == 2 && !$avoid_nlink) {
 489             # This dir has no subdirectories.
 490             for my $FN (@filenames) {
 491                 next if $FN =~ /^\.{1,2}\z/;
 492
 493                 $name = $dir_pref . $FN;
 494                 $_ = ($no_chdir ? $name : $FN);
 495                 { &$wanted_callback }; # protect against wild "next"
 496             }
 497
 498         }
 499         else {
 500             # This dir has subdirectories.
 501             $subcount = $nlink - 2;
 502
 503             for my $FN (@filenames) {
 504                 next if $FN =~ /^\.{1,2}\z/;
 505                 if ($subcount > 0 || $avoid_nlink) {
 506                     # Seen all the subdirs?
 507                     # check for directoriness.
 508                     # stat is faster for a file in the current directory
 509                     $sub_nlink = (lstat ($no_chdir ? $dir_pref . $FN : $FN))[3];
 510
 511                     if (-d _) {
 512                         --$subcount;
 513                         $FN =~ s/\.dir\z// if $Is_VMS;
 514                         push @Stack,[$CdLvl,$dir_name,$FN,$sub_nlink];
 515                     }
 516                     else {
 517                         $name = $dir_pref . $FN;
 518                         $_= ($no_chdir ? $name : $FN);
 519                         { &$wanted_callback }; # protect against wild "next"
 520                     }
 521                 }
 522                 else {
 523                     $name = $dir_pref . $FN;
 524                     $_= ($no_chdir ? $name : $FN);
 525                     { &$wanted_callback }; # protect against wild "next"
 526                 }
 527             }
 528         }
 529     }
 530     continue {
 531         while ( defined ($SE = pop @Stack) ) {
 532             ($Level, $p_dir, $dir_rel, $nlink) = @$SE;
 533             if ($CdLvl > $Level && !$no_chdir) {
 534                 my $tmp = join('/',('..') x ($CdLvl-$Level));
 535                 die "Can't cd to $dir_name" . $tmp
 536                     unless chdir ($tmp);
 537                 $CdLvl = $Level;
 538             }
 539             $dir_name = ($p_dir eq '/' ? "/$dir_rel" : "$p_dir/$dir_rel");
 540             $dir_pref = "$dir_name/";
 541             if ( $nlink == -2 ) {
 542                 $name = $dir = $p_dir;
 543                 $_ = ".";
 544                 &$post_process;         # End-of-directory processing
 545             } elsif ( $nlink < 0 ) {  # must be finddepth, report dirname now
 546                 $name = $dir_name;
 547                 if ( substr($name,-2) eq '/.' ) {
 548                   $name =~ s|/\.$||;
 549                 }
 550                 $dir = $p_dir;
 551                 $_ = ($no_chdir ? $dir_name : $dir_rel );
 552                 if ( substr($_,-2) eq '/.' ) {
 553                   s|/\.$||;
 554                 }
 555                 { &$wanted_callback }; # protect against wild "next"
 556             } else {
 557                 push @Stack,[$CdLvl,$p_dir,$dir_rel,-1]  if  $bydepth;
 558                 last;
 559             }
 560         }
 561     }
 562 }
 563
 564
 565 # API:
 566 #  $wanted
 567 #  $dir_loc : absolute location of a dir
 568 #  $p_dir   : "parent directory"
 569 # preconditions:
 570 #  chdir (if not no_chdir) to dir
 571
 572 sub _find_dir_symlnk($$$) {
 573     my ($wanted, $dir_loc, $p_dir) = @_;
 574     my @Stack;
 575     my @filenames;
 576     my $new_loc;
 577     my $pdir_loc = $dir_loc;
 578     my $SE = [];
 579     my $dir_name = $p_dir;
 580     my $dir_pref = ( $p_dir   eq '/' ? '/' : "$p_dir/" );
 581     my $loc_pref = ( $dir_loc eq '/' ? '/' : "$dir_loc/" );
 582     my $dir_rel = '.';          # directory name relative to current directory
 583     my $byd_flag;               # flag for pending stack entry if $bydepth
 584
 585     local ($dir, $name, $fullname, $prune, *DIR);
 586
 587     unless ($no_chdir or $p_dir eq '.') {
 588         my $udir = $dir_loc;
 589         if ($untaint) {
 590             $udir = $1 if $dir_loc =~ m|$untaint_pat|;
 591             unless (defined $udir) {
 592                 if ($untaint_skip == 0) {
 593                     die "directory $dir_loc is still tainted";
 594                 }
 595                 else {
 596                     return;
 597                 }
 598             }
 599         }
 600         unless (chdir $udir) {
 601             warn "Can't cd to $udir: $!\n";
 602             return;
 603         }
 604     }
 605
 606     push @Stack,[$dir_loc,$pdir_loc,$p_dir,$dir_rel,-1]  if  $bydepth;
 607
 608     while (defined $SE) {
 609
 610         unless ($bydepth) {
 611             # change to parent directory
 612             unless ($no_chdir) {
 613                 my $udir = $pdir_loc;
 614                 if ($untaint) {
 615                     $udir = $1 if $pdir_loc =~ m|$untaint_pat|;
 616                 }
 617                 unless (chdir $udir) {
 618                     warn "Can't cd to $udir: $!\n";
 619                     next;
 620                 }
 621             }
 622             $dir= $p_dir;
 623             $name= $dir_name;
 624             $_= ($no_chdir ? $dir_name : $dir_rel );
 625             $fullname= $dir_loc;
 626             # prune may happen here
 627             $prune= 0;
 628             lstat($_); # make sure  file tests with '_' work
 629             { &$wanted_callback }; # protect against wild "next"
 630             next if  $prune;
 631         }
 632
 633         # change to that directory
 634         unless ($no_chdir or $dir_rel eq '.') {
 635             my $udir = $dir_loc;
 636             if ($untaint) {
 637                 $udir = $1 if $dir_loc =~ m|$untaint_pat|;
 638                 unless (defined $udir ) {
 639                     if ($untaint_skip == 0) {
 640                         die "directory $dir_loc is still tainted";
 641                     }
 642                     else {
 643                         next;
 644                     }
 645                 }
 646             }
 647             unless (chdir $udir) {
 648                 warn "Can't cd to $udir: $!\n";
 649                 next;
 650             }
 651         }
 652
 653         $dir = $dir_name;
 654
 655         # Get the list of files in the current directory.
 656         unless (opendir DIR, ($no_chdir ? $dir_loc : '.')) {
 657             warn "Can't opendir($dir_loc): $!\n";
 658             next;
 659         }
 660         @filenames = readdir DIR;
 661         closedir(DIR);
 662
 663         for my $FN (@filenames) {
 664             next if $FN =~ /^\.{1,2}\z/;
 665
 666             # follow symbolic links / do an lstat
 667             $new_loc = Follow_SymLink($loc_pref.$FN);
 668
 669             # ignore if invalid symlink
 670             next unless defined $new_loc;
 671
 672             if (-d _) {
 673                 push @Stack,[$new_loc,$dir_loc,$dir_name,$FN,1];
 674             }
 675             else {
 676                 $fullname = $new_loc;
 677                 $name = $dir_pref . $FN;
 678                 $_ = ($no_chdir ? $name : $FN);
 679                 { &$wanted_callback }; # protect against wild "next"
 680             }
 681         }
 682
 683     }
 684     continue {
 685         while (defined($SE = pop @Stack)) {
 686             ($dir_loc, $pdir_loc, $p_dir, $dir_rel, $byd_flag) = @$SE;
 687             $dir_name = ($p_dir eq '/' ? "/$dir_rel" : "$p_dir/$dir_rel");
 688             $dir_pref = "$dir_name/";
 689             $loc_pref = "$dir_loc/";
 690             if ( $byd_flag < 0 ) {  # must be finddepth, report dirname now
 691                 unless ($no_chdir or $dir_rel eq '.') {
 692                     my $udir = $pdir_loc;
 693                     if ($untaint) {
 694                         $udir = $1 if $dir_loc =~ m|$untaint_pat|;
 695                     }
 696                     unless (chdir $udir) {
 697                         warn "Can't cd to $udir: $!\n";
 698                         next;
 699                     }
 700                 }
 701                 $fullname = $dir_loc;
 702                 $name = $dir_name;
 703                 if ( substr($name,-2) eq '/.' ) {
 704                   $name =~ s|/\.$||;
 705                 }
 706                 $dir = $p_dir;
 707                 $_ = ($no_chdir ? $dir_name : $dir_rel);
 708                 if ( substr($_,-2) eq '/.' ) {
 709                   s|/\.$||;
 710                 }
 711
 712                 lstat($_); # make sure  file tests with '_' work
 713                 { &$wanted_callback }; # protect against wild "next"
 714             } else {
 715                 push @Stack,[$dir_loc, $pdir_loc, $p_dir, $dir_rel,-1]  if  $bydepth;
 716                 last;
 717             }
 718         }
 719     }
 720 }
 721
 722
 723 sub wrap_wanted {
 724     my $wanted = shift;
 725     if ( ref($wanted) eq 'HASH' ) {
 726         if ( $wanted->{follow} || $wanted->{follow_fast}) {
 727             $wanted->{follow_skip} = 1 unless defined $wanted->{follow_skip};
 728         }
 729         if ( $wanted->{untaint} ) {
 730             $wanted->{untaint_pattern} = qr|^([-+@\w./]+)$|
 731                 unless defined $wanted->{untaint_pattern};
 732             $wanted->{untaint_skip} = 0 unless defined $wanted->{untaint_skip};
 733         }
 734         return $wanted;
 735     }
 736     else {
 737         return { wanted => $wanted };
 738     }
 739 }
 740
 741 sub find {
 742     my $wanted = shift;
 743     _find_opt(wrap_wanted($wanted), @_);
 744     %SLnkSeen= ();  # free memory
 745 }
 746
 747 sub finddepth {
 748     my $wanted = wrap_wanted(shift);
 749     $wanted->{bydepth} = 1;
 750     _find_opt($wanted, @_);
 751     %SLnkSeen= ();  # free memory
 752 }
 753
 754 # These are hard-coded for now, but may move to hint files.
 755 if ($^O eq 'VMS') {
 756     $Is_VMS = 1;
 757     $File::Find::dont_use_nlink = 1;
 758 }
 759
 760 $File::Find::dont_use_nlink = 1
 761     if $^O eq 'os2' || $^O eq 'dos' || $^O eq 'amigaos' || $^O eq 'MSWin32' ||
 762        $^O eq 'cygwin';
 763
 764 # Set dont_use_nlink in your hint file if your system's stat doesn't
 765 # report the number of links in a directory as an indication
 766 # of the number of files.
 767 # See, e.g. hints/machten.sh for MachTen 2.2.
 768 unless ($File::Find::dont_use_nlink) {
 769     require Config;
 770     $File::Find::dont_use_nlink = 1 if ($Config::Config{'dont_use_nlink'});
 771 }
 772
 773 1;