Commit | Line | Data |
---|---|---|
a0d0e21e LW |
1 | package File::Find; |
2 | require 5.000; | |
3 | require Exporter; | |
6280b799 | 4 | require Cwd; |
a0d0e21e | 5 | |
f06db76b AD |
6 | =head1 NAME |
7 | ||
8 | find - traverse a file tree | |
9 | ||
10 | finddepth - traverse a directory structure depth-first | |
11 | ||
12 | =head1 SYNOPSIS | |
13 | ||
14 | use File::Find; | |
15 | find(\&wanted, '/foo','/bar'); | |
16 | sub wanted { ... } | |
237437d0 | 17 | |
f06db76b AD |
18 | use File::Find; |
19 | finddepth(\&wanted, '/foo','/bar'); | |
20 | sub wanted { ... } | |
21 | ||
22 | =head1 DESCRIPTION | |
23 | ||
20408e3c | 24 | The first argument to find() is either a hash reference describing the |
1ec92630 GB |
25 | operations to be performed for each file, a code reference, or a string |
26 | that contains a subroutine name. If it is a hash reference, then the | |
27 | value for the key C<wanted> should be a code reference. This code | |
28 | reference is called I<the wanted() function> below. | |
20408e3c GS |
29 | |
30 | Currently the only other supported key for the above hash is | |
31 | C<bydepth>, in presense of which the walk over directories is | |
32 | performed depth-first. Entry point finddepth() is a shortcut for | |
33 | specifying C<{ bydepth => 1}> in the first argument of find(). | |
34 | ||
6280b799 | 35 | The wanted() function does whatever verifications you want. |
36 | $File::Find::dir contains the current directory name, and $_ the | |
37 | current filename within that directory. $File::Find::name contains | |
38 | C<"$File::Find::dir/$_">. You are chdir()'d to $File::Find::dir when | |
39 | the function is called. The function may set $File::Find::prune to | |
40 | prune the tree. | |
f06db76b | 41 | |
47a735e8 MDLR |
42 | File::Find assumes that you don't alter the $_ variable. If you do then |
43 | make sure you return it to its original value before exiting your function. | |
44 | ||
20408e3c | 45 | This library is useful for the C<find2perl> tool, which when fed, |
f06db76b AD |
46 | |
47 | find2perl / -name .nfs\* -mtime +7 \ | |
48 | -exec rm -f {} \; -o -fstype nfs -prune | |
49 | ||
50 | produces something like: | |
51 | ||
52 | sub wanted { | |
53 | /^\.nfs.*$/ && | |
54 | (($dev,$ino,$mode,$nlink,$uid,$gid) = lstat($_)) && | |
55 | int(-M _) > 7 && | |
56 | unlink($_) | |
57 | || | |
58 | ($nlink || (($dev,$ino,$mode,$nlink,$uid,$gid) = lstat($_))) && | |
59 | $dev < 0 && | |
6280b799 | 60 | ($File::Find::prune = 1); |
f06db76b AD |
61 | } |
62 | ||
6280b799 | 63 | Set the variable $File::Find::dont_use_nlink if you're using AFS, |
64 | since AFS cheats. | |
f06db76b AD |
65 | |
66 | C<finddepth> is just like C<find>, except that it does a depth-first | |
67 | search. | |
68 | ||
69 | Here's another interesting wanted function. It will find all symlinks | |
70 | that don't resolve: | |
71 | ||
72 | sub wanted { | |
6280b799 | 73 | -l && !-e && print "bogus link: $File::Find::name\n"; |
237437d0 | 74 | } |
f06db76b | 75 | |
0530a6c4 GW |
76 | =head1 BUGS |
77 | ||
78 | There is no way to make find or finddepth follow symlinks. | |
79 | ||
f06db76b AD |
80 | =cut |
81 | ||
a0d0e21e | 82 | @ISA = qw(Exporter); |
6280b799 | 83 | @EXPORT = qw(find finddepth); |
84 | ||
a0d0e21e | 85 | |
20408e3c | 86 | sub find_opt { |
a0d0e21e | 87 | my $wanted = shift; |
20408e3c GS |
88 | my $bydepth = $wanted->{bydepth}; |
89 | my $cwd = $bydepth ? Cwd::fastcwd() : Cwd::cwd(); | |
28312d68 RS |
90 | # Localize these rather than lexicalizing them for backwards |
91 | # compatibility. | |
92 | local($topdir,$topdev,$topino,$topmode,$topnlink); | |
a0d0e21e | 93 | foreach $topdir (@_) { |
d0e28714 CK |
94 | (($topdev,$topino,$topmode,$topnlink) = |
95 | ($Is_VMS ? stat($topdir) : lstat($topdir))) | |
a0d0e21e LW |
96 | || (warn("Can't stat $topdir: $!\n"), next); |
97 | if (-d _) { | |
98 | if (chdir($topdir)) { | |
d0e28714 | 99 | $prune = 0; |
20408e3c GS |
100 | unless ($bydepth) { |
101 | ($dir,$_) = ($topdir,'.'); | |
102 | $name = $topdir; | |
103 | $wanted->{wanted}->(); | |
104 | } | |
237437d0 CK |
105 | next if $prune; |
106 | my $fixtopdir = $topdir; | |
107 | $fixtopdir =~ s,/$,, ; | |
108 | $fixtopdir =~ s/\.dir$// if $Is_VMS; | |
20408e3c GS |
109 | &finddir($wanted,$fixtopdir,$topnlink, $bydepth); |
110 | if ($bydepth) { | |
111 | ($dir,$_) = ($fixtopdir,'.'); | |
112 | $name = $fixtopdir; | |
113 | $wanted->{wanted}->(); | |
114 | } | |
a0d0e21e LW |
115 | } |
116 | else { | |
117 | warn "Can't cd to $topdir: $!\n"; | |
118 | } | |
119 | } | |
120 | else { | |
20408e3c | 121 | require File::Basename; |
9f637d3d | 122 | unless (($_,$dir) = File::Basename::fileparse($topdir)) { |
a0d0e21e LW |
123 | ($dir,$_) = ('.', $topdir); |
124 | } | |
237437d0 CK |
125 | if (chdir($dir)) { |
126 | $name = $topdir; | |
20408e3c | 127 | $wanted->{wanted}->(); |
237437d0 CK |
128 | } |
129 | else { | |
130 | warn "Can't cd to $dir: $!\n"; | |
131 | } | |
a0d0e21e LW |
132 | } |
133 | chdir $cwd; | |
134 | } | |
135 | } | |
136 | ||
137 | sub finddir { | |
20408e3c | 138 | my($wanted, $nlink, $bydepth); |
6280b799 | 139 | local($dir, $name); |
20408e3c | 140 | ($wanted, $dir, $nlink, $bydepth) = @_; |
a0d0e21e | 141 | |
6280b799 | 142 | my($dev, $ino, $mode, $subcount); |
a0d0e21e | 143 | |
6280b799 | 144 | # Get the list of files in the current directory. |
20408e3c | 145 | opendir(DIR,'.') || (warn("Can't open $dir: $!\n"), $bydepth || return); |
6280b799 | 146 | my(@filenames) = readdir(DIR); |
a0d0e21e LW |
147 | closedir(DIR); |
148 | ||
149 | if ($nlink == 2 && !$dont_use_nlink) { # This dir has no subdirectories. | |
150 | for (@filenames) { | |
151 | next if $_ eq '.'; | |
152 | next if $_ eq '..'; | |
153 | $name = "$dir/$_"; | |
154 | $nlink = 0; | |
20408e3c | 155 | $wanted->{wanted}->(); |
a0d0e21e LW |
156 | } |
157 | } | |
237437d0 | 158 | else { # This dir has subdirectories. |
a0d0e21e LW |
159 | $subcount = $nlink - 2; |
160 | for (@filenames) { | |
161 | next if $_ eq '.'; | |
162 | next if $_ eq '..'; | |
20408e3c GS |
163 | $nlink = 0; |
164 | $prune = 0 unless $bydepth; | |
a0d0e21e | 165 | $name = "$dir/$_"; |
20408e3c | 166 | $wanted->{wanted}->() unless $bydepth; |
a0d0e21e LW |
167 | if ($subcount > 0 || $dont_use_nlink) { # Seen all the subdirs? |
168 | ||
169 | # Get link count and check for directoriness. | |
170 | ||
10eba763 | 171 | ($dev,$ino,$mode,$nlink) = ($Is_VMS ? stat($_) : lstat($_)); |
172 | # unless ($nlink || $dont_use_nlink); | |
237437d0 | 173 | |
a0d0e21e LW |
174 | if (-d _) { |
175 | ||
176 | # It really is a directory, so do it recursively. | |
177 | ||
237437d0 CK |
178 | --$subcount; |
179 | next if $prune; | |
340937ab JD |
180 | # Untaint $_, so that we can do a chdir |
181 | $_ = $1 if /^(.*)/; | |
237437d0 | 182 | if (chdir $_) { |
748a9306 | 183 | $name =~ s/\.dir$// if $Is_VMS; |
20408e3c | 184 | &finddir($wanted,$name,$nlink, $bydepth); |
a0d0e21e LW |
185 | chdir '..'; |
186 | } | |
237437d0 CK |
187 | else { |
188 | warn "Can't cd to $_: $!\n"; | |
189 | } | |
a0d0e21e LW |
190 | } |
191 | } | |
20408e3c | 192 | $wanted->{wanted}->() if $bydepth; |
a0d0e21e LW |
193 | } |
194 | } | |
195 | } | |
196 | ||
20408e3c GS |
197 | sub wrap_wanted { |
198 | my $wanted = shift; | |
1ec92630 | 199 | ref($wanted) eq 'HASH' ? $wanted : { wanted => $wanted }; |
a0d0e21e LW |
200 | } |
201 | ||
20408e3c GS |
202 | sub find { |
203 | my $wanted = shift; | |
204 | find_opt(wrap_wanted($wanted), @_); | |
a0d0e21e LW |
205 | } |
206 | ||
55d729e4 | 207 | sub finddepth { |
20408e3c GS |
208 | my $wanted = wrap_wanted(shift); |
209 | $wanted->{bydepth} = 1; | |
210 | find_opt($wanted, @_); | |
211 | } | |
6280b799 | 212 | |
213 | # These are hard-coded for now, but may move to hint files. | |
10eba763 | 214 | if ($^O eq 'VMS') { |
748a9306 LW |
215 | $Is_VMS = 1; |
216 | $dont_use_nlink = 1; | |
217 | } | |
218 | ||
55497cff | 219 | $dont_use_nlink = 1 |
3e8584ad | 220 | if $^O eq 'os2' || $^O eq 'dos' || $^O eq 'amigaos' || $^O eq 'MSWin32'; |
6280b799 | 221 | |
20408e3c GS |
222 | # Set dont_use_nlink in your hint file if your system's stat doesn't |
223 | # report the number of links in a directory as an indication | |
224 | # of the number of files. | |
225 | # See, e.g. hints/machten.sh for MachTen 2.2. | |
226 | unless ($dont_use_nlink) { | |
227 | require Config; | |
228 | $dont_use_nlink = 1 if ($Config::Config{'dont_use_nlink'}); | |
229 | } | |
230 | ||
a0d0e21e LW |
231 | 1; |
232 |