lib/File/Find.pm

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