Profile of File/Find.pm

Filename	/usr/share/perl/5.20/File/Find.pm
Statements	Executed 0 statements in 0s

Line	State ments	Time on line	Calls	Time in subs	Code
1					package File::Find;
2					use 5.006;
3					use strict;
4					use warnings;
5					use warnings::register;
6					our $VERSION = '1.27';
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					Note that you may mix directories and (non-directory) files in the list of
284					directories to be searched by the C<wanted()> function.
285
286					find(\&wanted, "./foo", "./bar", "./baz/epsilon");
287
288					In the example above, no file in F<./baz/> other than F<./baz/epsilon> will be
289					evaluated by C<wanted()>.
290
291					See also the script C<pfind> on CPAN for a nice application of this
292					module.
293
294					=head1 WARNINGS
295
296					If you run your program with the C<-w> switch, or if you use the
297					C<warnings> pragma, File::Find will report warnings for several weird
298					situations. You can disable these warnings by putting the statement
299
300					no warnings 'File::Find';
301
302					in the appropriate scope. See L<warnings> for more info about lexical
303					warnings.
304
305					=head1 CAVEAT
306
307					=over 2
308
309					=item $dont_use_nlink
310
311					You can set the variable C<$File::Find::dont_use_nlink> to 1, if you want to
312					force File::Find to always stat directories. This was used for file systems
313					that do not have an C<nlink> count matching the number of sub-directories.
314					Examples are ISO-9660 (CD-ROM), AFS, HPFS (OS/2 file system), FAT (DOS file
315					system) and a couple of others.
316
317					You shouldn't need to set this variable, since File::Find should now detect
318					such file systems on-the-fly and switch itself to using stat. This works even
319					for parts of your file system, like a mounted CD-ROM.
320
321					If you do set C<$File::Find::dont_use_nlink> to 1, you will notice slow-downs.
322
323					=item symlinks
324
325					Be aware that the option to follow symbolic links can be dangerous.
326					Depending on the structure of the directory tree (including symbolic
327					links to directories) you might traverse a given (physical) directory
328					more than once (only if C<follow_fast> is in effect).
329					Furthermore, deleting or changing files in a symbolically linked directory
330					might cause very unpleasant surprises, since you delete or change files
331					in an unknown directory.
332
333					=back
334
335					=head1 BUGS AND CAVEATS
336
337					Despite the name of the C<finddepth()> function, both C<find()> and
338					C<finddepth()> perform a depth-first search of the directory
339					hierarchy.
340
341					=head1 HISTORY
342
343					File::Find used to produce incorrect results if called recursively.
344					During the development of perl 5.8 this bug was fixed.
345					The first fixed version of File::Find was 1.01.
346
347					=head1 SEE ALSO
348
349					find, find2perl.
350
351					=cut
352
353					our @ISA = qw(Exporter);
354					our @EXPORT = qw(find finddepth);
355
356
357					use strict;
358					my $Is_VMS;
359					my $Is_Win32;
360
361					require File::Basename;
362					require File::Spec;
363
364					# Should ideally be my() not our() but local() currently
365					# refuses to operate on lexicals
366
367					our %SLnkSeen;
368					our ($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
372					sub 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
390					sub 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
413					sub 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
456					our($dir, $name, $fullname, $prune);
457					sub _find_dir_symlnk($$$);
458					sub _find_dir($$$);
459
460					# check whether or not a scalar variable is tainted
461					# (code straight from the Camel, 3rd ed., page 561)
462					sub 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
470					sub _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
638					sub _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
871					sub _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
1055					sub 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
1079					sub find {
1080					my $wanted = shift;
1081					_find_opt(wrap_wanted($wanted), @_);
1082					}
1083
1084					sub 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.
1095					if ($^O eq 'VMS') {
1096					$Is_VMS = 1;
1097					$File::Find::dont_use_nlink = 1;
1098					}
1099					elsif ($^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.
1115					unless ($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
1129					1;