Commit | Line | Data |
a0d0e21e |
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 |
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 { ... } |
20 | |
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 | |
34 | This library is primarily for the C<find2perl> tool, which when fed, |
35 | |
36 | find2perl / -name .nfs\* -mtime +7 \ |
37 | -exec rm -f {} \; -o -fstype nfs -prune |
38 | |
39 | produces something like: |
40 | |
41 | sub wanted { |
42 | /^\.nfs.*$/ && |
43 | (($dev,$ino,$mode,$nlink,$uid,$gid) = lstat($_)) && |
44 | int(-M _) > 7 && |
45 | unlink($_) |
46 | || |
47 | ($nlink || (($dev,$ino,$mode,$nlink,$uid,$gid) = lstat($_))) && |
48 | $dev < 0 && |
6280b799 |
49 | ($File::Find::prune = 1); |
f06db76b |
50 | } |
51 | |
6280b799 |
52 | Set the variable $File::Find::dont_use_nlink if you're using AFS, |
53 | since AFS cheats. |
f06db76b |
54 | |
55 | C<finddepth> is just like C<find>, except that it does a depth-first |
56 | search. |
57 | |
58 | Here's another interesting wanted function. It will find all symlinks |
59 | that don't resolve: |
60 | |
61 | sub wanted { |
6280b799 |
62 | -l && !-e && print "bogus link: $File::Find::name\n"; |
f06db76b |
63 | } |
64 | |
65 | =cut |
66 | |
a0d0e21e |
67 | @ISA = qw(Exporter); |
6280b799 |
68 | @EXPORT = qw(find finddepth); |
69 | |
a0d0e21e |
70 | |
71 | sub find { |
72 | my $wanted = shift; |
6280b799 |
73 | my $cwd = Cwd::fastcwd(); |
74 | my ($topdir,$topdev,$topino,$topmode,$topnlink); |
a0d0e21e |
75 | foreach $topdir (@_) { |
76 | (($topdev,$topino,$topmode,$topnlink) = stat($topdir)) |
77 | || (warn("Can't stat $topdir: $!\n"), next); |
78 | if (-d _) { |
79 | if (chdir($topdir)) { |
80 | ($dir,$_) = ($topdir,'.'); |
81 | $name = $topdir; |
82 | &$wanted; |
6280b799 |
83 | my $fixtopdir = $topdir; |
84 | $fixtopdir =~ s,/$,, ; |
9f637d3d |
85 | $fixtopdir =~ s/\.dir$// if $Is_VMS; |
86 | $fixtopdir =~ s/\\dir$// if $Is_NT; |
a0d0e21e |
87 | &finddir($wanted,$fixtopdir,$topnlink); |
88 | } |
89 | else { |
90 | warn "Can't cd to $topdir: $!\n"; |
91 | } |
92 | } |
93 | else { |
9f637d3d |
94 | unless (($_,$dir) = File::Basename::fileparse($topdir)) { |
a0d0e21e |
95 | ($dir,$_) = ('.', $topdir); |
96 | } |
97 | $name = $topdir; |
98 | chdir $dir && &$wanted; |
99 | } |
100 | chdir $cwd; |
101 | } |
102 | } |
103 | |
104 | sub finddir { |
6280b799 |
105 | my($wanted, $nlink); |
106 | local($dir, $name); |
107 | ($wanted, $dir, $nlink) = @_; |
a0d0e21e |
108 | |
6280b799 |
109 | my($dev, $ino, $mode, $subcount); |
a0d0e21e |
110 | |
6280b799 |
111 | # Get the list of files in the current directory. |
a0d0e21e |
112 | opendir(DIR,'.') || (warn "Can't open $dir: $!\n", return); |
6280b799 |
113 | my(@filenames) = readdir(DIR); |
a0d0e21e |
114 | closedir(DIR); |
115 | |
116 | if ($nlink == 2 && !$dont_use_nlink) { # This dir has no subdirectories. |
117 | for (@filenames) { |
118 | next if $_ eq '.'; |
119 | next if $_ eq '..'; |
120 | $name = "$dir/$_"; |
121 | $nlink = 0; |
122 | &$wanted; |
123 | } |
124 | } |
125 | else { # This dir has subdirectories. |
126 | $subcount = $nlink - 2; |
127 | for (@filenames) { |
128 | next if $_ eq '.'; |
129 | next if $_ eq '..'; |
130 | $nlink = $prune = 0; |
131 | $name = "$dir/$_"; |
132 | &$wanted; |
133 | if ($subcount > 0 || $dont_use_nlink) { # Seen all the subdirs? |
134 | |
135 | # Get link count and check for directoriness. |
136 | |
10eba763 |
137 | ($dev,$ino,$mode,$nlink) = ($Is_VMS ? stat($_) : lstat($_)); |
138 | # unless ($nlink || $dont_use_nlink); |
a0d0e21e |
139 | |
140 | if (-d _) { |
141 | |
142 | # It really is a directory, so do it recursively. |
143 | |
144 | if (!$prune && chdir $_) { |
748a9306 |
145 | $name =~ s/\.dir$// if $Is_VMS; |
9f637d3d |
146 | $name =~ s/\\dir$// if $Is_NT; |
a0d0e21e |
147 | &finddir($wanted,$name,$nlink); |
148 | chdir '..'; |
149 | } |
150 | --$subcount; |
151 | } |
152 | } |
153 | } |
154 | } |
155 | } |
156 | |
a0d0e21e |
157 | |
158 | sub finddepth { |
159 | my $wanted = shift; |
6280b799 |
160 | |
161 | $cwd = Cwd::fastcwd();; |
162 | |
163 | my($topdir, $topdev, $topino, $topmode, $topnlink); |
a0d0e21e |
164 | foreach $topdir (@_) { |
165 | (($topdev,$topino,$topmode,$topnlink) = stat($topdir)) |
166 | || (warn("Can't stat $topdir: $!\n"), next); |
167 | if (-d _) { |
168 | if (chdir($topdir)) { |
6280b799 |
169 | my $fixtopdir = $topdir; |
170 | $fixtopdir =~ s,/$,, ; |
748a9306 |
171 | $fixtopdir =~ s/\.dir$// if $Is_VMS; |
9f637d3d |
172 | $fixtopdir =~ s/\\dir$// if $Is_NT; |
a0d0e21e |
173 | &finddepthdir($wanted,$fixtopdir,$topnlink); |
174 | ($dir,$_) = ($fixtopdir,'.'); |
175 | $name = $fixtopdir; |
176 | &$wanted; |
177 | } |
178 | else { |
179 | warn "Can't cd to $topdir: $!\n"; |
180 | } |
181 | } |
182 | else { |
9f637d3d |
183 | unless (($_,$dir) = File::Basename::fileparse($topdir)) { |
a0d0e21e |
184 | ($dir,$_) = ('.', $topdir); |
185 | } |
186 | chdir $dir && &$wanted; |
187 | } |
188 | chdir $cwd; |
189 | } |
190 | } |
191 | |
192 | sub finddepthdir { |
6280b799 |
193 | my($wanted, $nlink); |
194 | local($dir, $name); |
195 | ($wanted,$dir,$nlink) = @_; |
196 | my($dev, $ino, $mode, $subcount); |
a0d0e21e |
197 | |
198 | # Get the list of files in the current directory. |
a0d0e21e |
199 | opendir(DIR,'.') || warn "Can't open $dir: $!\n"; |
200 | my(@filenames) = readdir(DIR); |
201 | closedir(DIR); |
202 | |
748a9306 |
203 | if ($nlink == 2 && !$dont_use_nlink) { # This dir has no subdirectories. |
a0d0e21e |
204 | for (@filenames) { |
205 | next if $_ eq '.'; |
206 | next if $_ eq '..'; |
207 | $name = "$dir/$_"; |
208 | $nlink = 0; |
209 | &$wanted; |
210 | } |
211 | } |
212 | else { # This dir has subdirectories. |
213 | $subcount = $nlink - 2; |
214 | for (@filenames) { |
215 | next if $_ eq '.'; |
216 | next if $_ eq '..'; |
6280b799 |
217 | $nlink = 0; |
a0d0e21e |
218 | $name = "$dir/$_"; |
748a9306 |
219 | if ($subcount > 0 || $dont_use_nlink) { # Seen all the subdirs? |
a0d0e21e |
220 | |
221 | # Get link count and check for directoriness. |
222 | |
748a9306 |
223 | ($dev,$ino,$mode,$nlink) = ($Is_VMS ? stat($_) : lstat($_)); |
a0d0e21e |
224 | |
225 | if (-d _) { |
226 | |
227 | # It really is a directory, so do it recursively. |
228 | |
6280b799 |
229 | if (chdir $_) { |
748a9306 |
230 | $name =~ s/\.dir$// if $Is_VMS; |
9f637d3d |
231 | $name =~ s/\\dir$// if $Is_NT; |
a0d0e21e |
232 | &finddepthdir($wanted,$name,$nlink); |
233 | chdir '..'; |
234 | } |
235 | --$subcount; |
236 | } |
237 | } |
238 | &$wanted; |
239 | } |
240 | } |
241 | } |
242 | |
6280b799 |
243 | # Set dont_use_nlink in your hint file if your system's stat doesn't |
244 | # report the number of links in a directory as an indication |
245 | # of the number of files. |
246 | # See, e.g. hints/machten.sh for MachTen 2.2. |
247 | $dont_use_nlink = 1 if ($Config::Config{'dont_use_nlink'}); |
248 | |
249 | # These are hard-coded for now, but may move to hint files. |
10eba763 |
250 | if ($^O eq 'VMS') { |
748a9306 |
251 | $Is_VMS = 1; |
252 | $dont_use_nlink = 1; |
253 | } |
9f637d3d |
254 | if ($^O =~ m:^mswin32:i) { |
255 | $Is_NT = 1; |
256 | $dont_use_nlink = 1; |
257 | } |
748a9306 |
258 | |
10eba763 |
259 | $dont_use_nlink = 1 if $^O eq 'os2'; |
6280b799 |
260 | |
a0d0e21e |
261 | 1; |
262 | |