Commit | Line | Data |
---|---|---|
a0d0e21e LW |
1 | package File::Find; |
2 | require 5.000; | |
3 | require Exporter; | |
748a9306 LW |
4 | use Config; |
5 | use Cwd; | |
6 | use File::Basename; | |
a0d0e21e | 7 | |
f06db76b AD |
8 | =head1 NAME |
9 | ||
10 | find - traverse a file tree | |
11 | ||
12 | finddepth - 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 | ||
26 | The wanted() function does whatever verifications you want. $dir contains | |
27 | the current directory name, and $_ the current filename within that | |
28 | directory. $name contains C<"$dir/$_">. You are chdir()'d to $dir when | |
29 | the function is called. The function may set $prune to prune the tree. | |
30 | ||
31 | This 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 | ||
36 | produces 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 | ||
49 | Set the variable $dont_use_nlink if you're using AFS, since AFS cheats. | |
50 | ||
51 | C<finddepth> is just like C<find>, except that it does a depth-first | |
52 | search. | |
53 | ||
54 | Here's another interesting wanted function. It will find all symlinks | |
55 | that 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 | ||
99 | sub 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 | ||
129 | sub 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 | ||
209 | sub 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 | ||
238 | sub 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 |
288 | if ($Config{'osname'} eq 'VMS') { |
289 | $Is_VMS = 1; | |
290 | $dont_use_nlink = 1; | |
291 | } | |
292 | ||
a0d0e21e LW |
293 | 1; |
294 |