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