source: for-distributions/trunk/bin/windows/perl/lib/File/Find.pm@ 14489

Last change on this file since 14489 was 14489, checked in by oranfry, 17 years ago

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