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