This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
[win32] merge change#887 from maintbranch
[perl5.git] / lib / File / Find.pm
CommitLineData
a0d0e21e
LW
1package File::Find;
2require 5.000;
3require Exporter;
10eba763 4use Config;
6280b799
PP
5require Cwd;
6require File::Basename;
7
a0d0e21e 8
f06db76b
AD
9=head1 NAME
10
11find - traverse a file tree
12
13finddepth - traverse a directory structure depth-first
14
15=head1 SYNOPSIS
16
17 use File::Find;
18 find(\&wanted, '/foo','/bar');
19 sub wanted { ... }
237437d0 20
f06db76b
AD
21 use File::Find;
22 finddepth(\&wanted, '/foo','/bar');
23 sub wanted { ... }
24
25=head1 DESCRIPTION
26
6280b799
PP
27The wanted() function does whatever verifications you want.
28$File::Find::dir contains the current directory name, and $_ the
29current filename within that directory. $File::Find::name contains
30C<"$File::Find::dir/$_">. You are chdir()'d to $File::Find::dir when
31the function is called. The function may set $File::Find::prune to
32prune the tree.
f06db76b 33
47a735e8
MDLR
34File::Find assumes that you don't alter the $_ variable. If you do then
35make sure you return it to its original value before exiting your function.
36
237437d0 37This library is primarily for the C<find2perl> tool, which when fed,
f06db76b
AD
38
39 find2perl / -name .nfs\* -mtime +7 \
40 -exec rm -f {} \; -o -fstype nfs -prune
41
42produces something like:
43
44 sub wanted {
45 /^\.nfs.*$/ &&
46 (($dev,$ino,$mode,$nlink,$uid,$gid) = lstat($_)) &&
47 int(-M _) > 7 &&
48 unlink($_)
49 ||
50 ($nlink || (($dev,$ino,$mode,$nlink,$uid,$gid) = lstat($_))) &&
51 $dev < 0 &&
6280b799 52 ($File::Find::prune = 1);
f06db76b
AD
53 }
54
6280b799
PP
55Set the variable $File::Find::dont_use_nlink if you're using AFS,
56since AFS cheats.
f06db76b
AD
57
58C<finddepth> is just like C<find>, except that it does a depth-first
59search.
60
61Here's another interesting wanted function. It will find all symlinks
62that don't resolve:
63
64 sub wanted {
6280b799 65 -l && !-e && print "bogus link: $File::Find::name\n";
237437d0 66 }
f06db76b 67
0530a6c4
GW
68=head1 BUGS
69
70There is no way to make find or finddepth follow symlinks.
71
f06db76b
AD
72=cut
73
a0d0e21e 74@ISA = qw(Exporter);
6280b799
PP
75@EXPORT = qw(find finddepth);
76
a0d0e21e
LW
77
78sub find {
79 my $wanted = shift;
5a13742d 80 my $cwd = Cwd::cwd();
28312d68
RS
81 # Localize these rather than lexicalizing them for backwards
82 # compatibility.
83 local($topdir,$topdev,$topino,$topmode,$topnlink);
a0d0e21e 84 foreach $topdir (@_) {
d0e28714
CK
85 (($topdev,$topino,$topmode,$topnlink) =
86 ($Is_VMS ? stat($topdir) : lstat($topdir)))
a0d0e21e
LW
87 || (warn("Can't stat $topdir: $!\n"), next);
88 if (-d _) {
89 if (chdir($topdir)) {
90 ($dir,$_) = ($topdir,'.');
91 $name = $topdir;
d0e28714 92 $prune = 0;
a0d0e21e 93 &$wanted;
237437d0
CK
94 next if $prune;
95 my $fixtopdir = $topdir;
96 $fixtopdir =~ s,/$,, ;
97 $fixtopdir =~ s/\.dir$// if $Is_VMS;
98 &finddir($wanted,$fixtopdir,$topnlink);
a0d0e21e
LW
99 }
100 else {
101 warn "Can't cd to $topdir: $!\n";
102 }
103 }
104 else {
9f637d3d 105 unless (($_,$dir) = File::Basename::fileparse($topdir)) {
a0d0e21e
LW
106 ($dir,$_) = ('.', $topdir);
107 }
237437d0
CK
108 if (chdir($dir)) {
109 $name = $topdir;
110 &$wanted;
111 }
112 else {
113 warn "Can't cd to $dir: $!\n";
114 }
a0d0e21e
LW
115 }
116 chdir $cwd;
117 }
118}
119
120sub finddir {
6280b799
PP
121 my($wanted, $nlink);
122 local($dir, $name);
123 ($wanted, $dir, $nlink) = @_;
a0d0e21e 124
6280b799 125 my($dev, $ino, $mode, $subcount);
a0d0e21e 126
6280b799 127 # Get the list of files in the current directory.
a0d0e21e 128 opendir(DIR,'.') || (warn "Can't open $dir: $!\n", return);
6280b799 129 my(@filenames) = readdir(DIR);
a0d0e21e
LW
130 closedir(DIR);
131
132 if ($nlink == 2 && !$dont_use_nlink) { # This dir has no subdirectories.
133 for (@filenames) {
134 next if $_ eq '.';
135 next if $_ eq '..';
136 $name = "$dir/$_";
137 $nlink = 0;
138 &$wanted;
139 }
140 }
237437d0 141 else { # This dir has subdirectories.
a0d0e21e
LW
142 $subcount = $nlink - 2;
143 for (@filenames) {
144 next if $_ eq '.';
145 next if $_ eq '..';
146 $nlink = $prune = 0;
147 $name = "$dir/$_";
148 &$wanted;
149 if ($subcount > 0 || $dont_use_nlink) { # Seen all the subdirs?
150
151 # Get link count and check for directoriness.
152
10eba763
PP
153 ($dev,$ino,$mode,$nlink) = ($Is_VMS ? stat($_) : lstat($_));
154 # unless ($nlink || $dont_use_nlink);
237437d0 155
a0d0e21e
LW
156 if (-d _) {
157
158 # It really is a directory, so do it recursively.
159
237437d0
CK
160 --$subcount;
161 next if $prune;
162 if (chdir $_) {
748a9306 163 $name =~ s/\.dir$// if $Is_VMS;
a0d0e21e
LW
164 &finddir($wanted,$name,$nlink);
165 chdir '..';
166 }
237437d0
CK
167 else {
168 warn "Can't cd to $_: $!\n";
169 }
a0d0e21e
LW
170 }
171 }
172 }
173 }
174}
175
a0d0e21e
LW
176
177sub finddepth {
178 my $wanted = shift;
237437d0 179 my $cwd = Cwd::cwd();
28312d68
RS
180 # Localize these rather than lexicalizing them for backwards
181 # compatibility.
237437d0 182 local($topdir,$topdev,$topino,$topmode,$topnlink);
a0d0e21e 183 foreach $topdir (@_) {
d0e28714
CK
184 (($topdev,$topino,$topmode,$topnlink) =
185 ($Is_VMS ? stat($topdir) : lstat($topdir)))
a0d0e21e
LW
186 || (warn("Can't stat $topdir: $!\n"), next);
187 if (-d _) {
188 if (chdir($topdir)) {
6280b799
PP
189 my $fixtopdir = $topdir;
190 $fixtopdir =~ s,/$,, ;
748a9306 191 $fixtopdir =~ s/\.dir$// if $Is_VMS;
a0d0e21e 192 &finddepthdir($wanted,$fixtopdir,$topnlink);
237437d0
CK
193 ($dir,$_) = ($topdir,'.');
194 $name = $topdir;
a0d0e21e
LW
195 &$wanted;
196 }
197 else {
198 warn "Can't cd to $topdir: $!\n";
199 }
200 }
201 else {
9f637d3d 202 unless (($_,$dir) = File::Basename::fileparse($topdir)) {
a0d0e21e
LW
203 ($dir,$_) = ('.', $topdir);
204 }
237437d0
CK
205 if (chdir($dir)) {
206 $name = $topdir;
207 &$wanted;
208 }
209 else {
210 warn "Can't cd to $dir: $!\n";
211 }
a0d0e21e
LW
212 }
213 chdir $cwd;
214 }
215}
216
217sub finddepthdir {
6280b799
PP
218 my($wanted, $nlink);
219 local($dir, $name);
237437d0 220 ($wanted, $dir, $nlink) = @_;
6280b799 221 my($dev, $ino, $mode, $subcount);
a0d0e21e
LW
222
223 # Get the list of files in the current directory.
237437d0 224 opendir(DIR,'.') || (warn "Can't open $dir: $!\n", return);
a0d0e21e
LW
225 my(@filenames) = readdir(DIR);
226 closedir(DIR);
227
237437d0 228 if ($nlink == 2 && !$dont_use_nlink) { # This dir has no subdirectories.
a0d0e21e
LW
229 for (@filenames) {
230 next if $_ eq '.';
231 next if $_ eq '..';
232 $name = "$dir/$_";
233 $nlink = 0;
234 &$wanted;
235 }
236 }
237437d0 237 else { # This dir has subdirectories.
a0d0e21e
LW
238 $subcount = $nlink - 2;
239 for (@filenames) {
240 next if $_ eq '.';
241 next if $_ eq '..';
6280b799 242 $nlink = 0;
a0d0e21e 243 $name = "$dir/$_";
748a9306 244 if ($subcount > 0 || $dont_use_nlink) { # Seen all the subdirs?
a0d0e21e
LW
245
246 # Get link count and check for directoriness.
247
748a9306 248 ($dev,$ino,$mode,$nlink) = ($Is_VMS ? stat($_) : lstat($_));
237437d0 249
a0d0e21e
LW
250 if (-d _) {
251
252 # It really is a directory, so do it recursively.
253
237437d0 254 --$subcount;
6280b799 255 if (chdir $_) {
748a9306 256 $name =~ s/\.dir$// if $Is_VMS;
a0d0e21e
LW
257 &finddepthdir($wanted,$name,$nlink);
258 chdir '..';
259 }
237437d0
CK
260 else {
261 warn "Can't cd to $_: $!\n";
262 }
a0d0e21e
LW
263 }
264 }
265 &$wanted;
266 }
267 }
268}
269
6280b799
PP
270# Set dont_use_nlink in your hint file if your system's stat doesn't
271# report the number of links in a directory as an indication
272# of the number of files.
273# See, e.g. hints/machten.sh for MachTen 2.2.
274$dont_use_nlink = 1 if ($Config::Config{'dont_use_nlink'});
275
276# These are hard-coded for now, but may move to hint files.
10eba763 277if ($^O eq 'VMS') {
748a9306
LW
278 $Is_VMS = 1;
279 $dont_use_nlink = 1;
280}
281
55497cff 282$dont_use_nlink = 1
3e8584ad 283 if $^O eq 'os2' || $^O eq 'dos' || $^O eq 'amigaos' || $^O eq 'MSWin32';
6280b799 284
a0d0e21e
LW
2851;
286