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