Commit | Line | Data |
---|---|---|
a0d0e21e LW |
1 | package File::Find; |
2 | require 5.000; | |
3 | require Exporter; | |
10eba763 | 4 | use Config; |
6280b799 | 5 | require Cwd; |
6 | require File::Basename; | |
7 | ||
a0d0e21e | 8 | |
f06db76b AD |
9 | =head1 NAME |
10 | ||
11 | find - traverse a file tree | |
12 | ||
13 | finddepth - 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 | 27 | The wanted() function does whatever verifications you want. |
28 | $File::Find::dir contains the current directory name, and $_ the | |
29 | current filename within that directory. $File::Find::name contains | |
30 | C<"$File::Find::dir/$_">. You are chdir()'d to $File::Find::dir when | |
31 | the function is called. The function may set $File::Find::prune to | |
32 | prune the tree. | |
f06db76b | 33 | |
47a735e8 MDLR |
34 | File::Find assumes that you don't alter the $_ variable. If you do then |
35 | make sure you return it to its original value before exiting your function. | |
36 | ||
237437d0 | 37 | This 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 | ||
42 | produces 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 | 55 | Set the variable $File::Find::dont_use_nlink if you're using AFS, |
56 | since AFS cheats. | |
f06db76b AD |
57 | |
58 | C<finddepth> is just like C<find>, except that it does a depth-first | |
59 | search. | |
60 | ||
61 | Here's another interesting wanted function. It will find all symlinks | |
62 | that 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 | ||
70 | There is no way to make find or finddepth follow symlinks. | |
71 | ||
f06db76b AD |
72 | =cut |
73 | ||
a0d0e21e | 74 | @ISA = qw(Exporter); |
6280b799 | 75 | @EXPORT = qw(find finddepth); |
76 | ||
a0d0e21e LW |
77 | |
78 | sub 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 | ||
120 | sub finddir { | |
6280b799 | 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 | 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 | |
177 | sub 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 | 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 | ||
217 | sub finddepthdir { | |
6280b799 | 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 | 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 | 277 | if ($^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 |
285 | 1; |
286 |