lib/File/Find.pm

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