Commit | Line | Data |
a0d0e21e |
1 | package File::Find; |
2 | require 5.000; |
3 | require Exporter; |
748a9306 |
4 | use Config; |
5 | use Cwd; |
6 | use File::Basename; |
a0d0e21e |
7 | |
f06db76b |
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 | |
66 | # Usage: |
67 | # use File::Find; |
68 | # |
69 | # find(\&wanted, '/foo','/bar'); |
70 | # |
71 | # sub wanted { ... } |
72 | # where wanted does whatever you want. $dir contains the |
73 | # current directory name, and $_ the current filename within |
74 | # that directory. $name contains "$dir/$_". You are cd'ed |
75 | # to $dir when the function is called. The function may |
76 | # set $prune to prune the tree. |
77 | # |
78 | # This library is primarily for find2perl, which, when fed |
79 | # |
80 | # find2perl / -name .nfs\* -mtime +7 -exec rm -f {} \; -o -fstype nfs -prune |
81 | # |
82 | # spits out something like this |
83 | # |
84 | # sub wanted { |
85 | # /^\.nfs.*$/ && |
86 | # (($dev,$ino,$mode,$nlink,$uid,$gid) = lstat($_)) && |
87 | # int(-M _) > 7 && |
88 | # unlink($_) |
89 | # || |
90 | # ($nlink || (($dev,$ino,$mode,$nlink,$uid,$gid) = lstat($_))) && |
91 | # $dev < 0 && |
92 | # ($prune = 1); |
93 | # } |
94 | # |
95 | # Set the variable $dont_use_nlink if you're using AFS, since AFS cheats. |
96 | |
97 | sub find { |
98 | my $wanted = shift; |
748a9306 |
99 | my $cwd = fastcwd(); |
a0d0e21e |
100 | foreach $topdir (@_) { |
101 | (($topdev,$topino,$topmode,$topnlink) = stat($topdir)) |
102 | || (warn("Can't stat $topdir: $!\n"), next); |
103 | if (-d _) { |
104 | if (chdir($topdir)) { |
105 | ($dir,$_) = ($topdir,'.'); |
106 | $name = $topdir; |
107 | &$wanted; |
108 | ($fixtopdir = $topdir) =~ s,/$,, ; |
748a9306 |
109 | $fixtopdir =~ s/\.dir$// if $Is_VMS; ; |
a0d0e21e |
110 | &finddir($wanted,$fixtopdir,$topnlink); |
111 | } |
112 | else { |
113 | warn "Can't cd to $topdir: $!\n"; |
114 | } |
115 | } |
116 | else { |
748a9306 |
117 | unless (($dir,$_) = fileparse($topdir)) { |
a0d0e21e |
118 | ($dir,$_) = ('.', $topdir); |
119 | } |
120 | $name = $topdir; |
121 | chdir $dir && &$wanted; |
122 | } |
123 | chdir $cwd; |
124 | } |
125 | } |
126 | |
127 | sub finddir { |
128 | local($wanted,$dir,$nlink) = @_; |
129 | local($dev,$ino,$mode,$subcount); |
130 | local($name); |
131 | |
132 | # Get the list of files in the current directory. |
133 | |
134 | opendir(DIR,'.') || (warn "Can't open $dir: $!\n", return); |
135 | local(@filenames) = readdir(DIR); |
136 | closedir(DIR); |
137 | |
138 | if ($nlink == 2 && !$dont_use_nlink) { # This dir has no subdirectories. |
139 | for (@filenames) { |
140 | next if $_ eq '.'; |
141 | next if $_ eq '..'; |
142 | $name = "$dir/$_"; |
143 | $nlink = 0; |
144 | &$wanted; |
145 | } |
146 | } |
147 | else { # This dir has subdirectories. |
148 | $subcount = $nlink - 2; |
149 | for (@filenames) { |
150 | next if $_ eq '.'; |
151 | next if $_ eq '..'; |
152 | $nlink = $prune = 0; |
153 | $name = "$dir/$_"; |
154 | &$wanted; |
155 | if ($subcount > 0 || $dont_use_nlink) { # Seen all the subdirs? |
156 | |
157 | # Get link count and check for directoriness. |
158 | |
748a9306 |
159 | ($dev,$ino,$mode,$nlink) = ($Is_VMS ? stat($_) : lstat($_)) |
160 | unless ($nlink || $dont_use_nlink); |
a0d0e21e |
161 | |
162 | if (-d _) { |
163 | |
164 | # It really is a directory, so do it recursively. |
165 | |
166 | if (!$prune && chdir $_) { |
748a9306 |
167 | $name =~ s/\.dir$// if $Is_VMS; |
a0d0e21e |
168 | &finddir($wanted,$name,$nlink); |
169 | chdir '..'; |
170 | } |
171 | --$subcount; |
172 | } |
173 | } |
174 | } |
175 | } |
176 | } |
177 | |
178 | # Usage: |
179 | # use File::Find; |
180 | # |
181 | # finddepth(\&wanted, '/foo','/bar'); |
182 | # |
183 | # sub wanted { ... } |
184 | # where wanted does whatever you want. $dir contains the |
185 | # current directory name, and $_ the current filename within |
186 | # that directory. $name contains "$dir/$_". You are cd'ed |
187 | # to $dir when the function is called. The function may |
188 | # set $prune to prune the tree. |
189 | # |
190 | # This library is primarily for find2perl, which, when fed |
191 | # |
192 | # find2perl / -name .nfs\* -mtime +7 -exec rm -f {} \; -o -fstype nfs -prune |
193 | # |
194 | # spits out something like this |
195 | # |
196 | # sub wanted { |
197 | # /^\.nfs.*$/ && |
198 | # (($dev,$ino,$mode,$nlink,$uid,$gid) = lstat($_)) && |
199 | # int(-M _) > 7 && |
200 | # unlink($_) |
201 | # || |
202 | # ($nlink || (($dev,$ino,$mode,$nlink,$uid,$gid) = lstat($_))) && |
203 | # $dev < 0 && |
204 | # ($prune = 1); |
205 | # } |
206 | |
207 | sub finddepth { |
208 | my $wanted = shift; |
748a9306 |
209 | $cwd = fastcwd();; |
a0d0e21e |
210 | foreach $topdir (@_) { |
211 | (($topdev,$topino,$topmode,$topnlink) = stat($topdir)) |
212 | || (warn("Can't stat $topdir: $!\n"), next); |
213 | if (-d _) { |
214 | if (chdir($topdir)) { |
215 | ($fixtopdir = $topdir) =~ s,/$,, ; |
748a9306 |
216 | $fixtopdir =~ s/\.dir$// if $Is_VMS; |
a0d0e21e |
217 | &finddepthdir($wanted,$fixtopdir,$topnlink); |
218 | ($dir,$_) = ($fixtopdir,'.'); |
219 | $name = $fixtopdir; |
220 | &$wanted; |
221 | } |
222 | else { |
223 | warn "Can't cd to $topdir: $!\n"; |
224 | } |
225 | } |
226 | else { |
748a9306 |
227 | unless (($dir,$_) = fileparse($topdir)) { |
a0d0e21e |
228 | ($dir,$_) = ('.', $topdir); |
229 | } |
230 | chdir $dir && &$wanted; |
231 | } |
232 | chdir $cwd; |
233 | } |
234 | } |
235 | |
236 | sub finddepthdir { |
237 | my($wanted,$dir,$nlink) = @_; |
238 | my($dev,$ino,$mode,$subcount); |
239 | my($name); |
240 | |
241 | # Get the list of files in the current directory. |
242 | |
243 | opendir(DIR,'.') || warn "Can't open $dir: $!\n"; |
244 | my(@filenames) = readdir(DIR); |
245 | closedir(DIR); |
246 | |
748a9306 |
247 | if ($nlink == 2 && !$dont_use_nlink) { # This dir has no subdirectories. |
a0d0e21e |
248 | for (@filenames) { |
249 | next if $_ eq '.'; |
250 | next if $_ eq '..'; |
251 | $name = "$dir/$_"; |
252 | $nlink = 0; |
253 | &$wanted; |
254 | } |
255 | } |
256 | else { # This dir has subdirectories. |
257 | $subcount = $nlink - 2; |
258 | for (@filenames) { |
259 | next if $_ eq '.'; |
260 | next if $_ eq '..'; |
261 | $nlink = $prune = 0; |
262 | $name = "$dir/$_"; |
748a9306 |
263 | if ($subcount > 0 || $dont_use_nlink) { # Seen all the subdirs? |
a0d0e21e |
264 | |
265 | # Get link count and check for directoriness. |
266 | |
748a9306 |
267 | ($dev,$ino,$mode,$nlink) = ($Is_VMS ? stat($_) : lstat($_)); |
a0d0e21e |
268 | |
269 | if (-d _) { |
270 | |
271 | # It really is a directory, so do it recursively. |
272 | |
273 | if (!$prune && chdir $_) { |
748a9306 |
274 | $name =~ s/\.dir$// if $Is_VMS; |
a0d0e21e |
275 | &finddepthdir($wanted,$name,$nlink); |
276 | chdir '..'; |
277 | } |
278 | --$subcount; |
279 | } |
280 | } |
281 | &$wanted; |
282 | } |
283 | } |
284 | } |
285 | |
748a9306 |
286 | if ($Config{'osname'} eq 'VMS') { |
287 | $Is_VMS = 1; |
288 | $dont_use_nlink = 1; |
289 | } |
290 | |
a0d0e21e |
291 | 1; |
292 | |