This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
perl5.001 patch.1f
[perl5.git] / lib / File / Find.pm
CommitLineData
a0d0e21e
LW
1package File::Find;
2require 5.000;
3require Exporter;
748a9306
LW
4use Config;
5use Cwd;
6use File::Basename;
a0d0e21e
LW
7
8@ISA = qw(Exporter);
748a9306 9@EXPORT = qw(find finddepth $name $dir);
a0d0e21e
LW
10
11# Usage:
12# use File::Find;
13#
14# find(\&wanted, '/foo','/bar');
15#
16# sub wanted { ... }
17# where wanted does whatever you want. $dir contains the
18# current directory name, and $_ the current filename within
19# that directory. $name contains "$dir/$_". You are cd'ed
20# to $dir when the function is called. The function may
21# set $prune to prune the tree.
22#
23# This library is primarily for find2perl, which, when fed
24#
25# find2perl / -name .nfs\* -mtime +7 -exec rm -f {} \; -o -fstype nfs -prune
26#
27# spits out something like this
28#
29# sub wanted {
30# /^\.nfs.*$/ &&
31# (($dev,$ino,$mode,$nlink,$uid,$gid) = lstat($_)) &&
32# int(-M _) > 7 &&
33# unlink($_)
34# ||
35# ($nlink || (($dev,$ino,$mode,$nlink,$uid,$gid) = lstat($_))) &&
36# $dev < 0 &&
37# ($prune = 1);
38# }
39#
40# Set the variable $dont_use_nlink if you're using AFS, since AFS cheats.
41
42sub find {
43 my $wanted = shift;
748a9306 44 my $cwd = fastcwd();
a0d0e21e
LW
45 foreach $topdir (@_) {
46 (($topdev,$topino,$topmode,$topnlink) = stat($topdir))
47 || (warn("Can't stat $topdir: $!\n"), next);
48 if (-d _) {
49 if (chdir($topdir)) {
50 ($dir,$_) = ($topdir,'.');
51 $name = $topdir;
52 &$wanted;
53 ($fixtopdir = $topdir) =~ s,/$,, ;
748a9306 54 $fixtopdir =~ s/\.dir$// if $Is_VMS; ;
a0d0e21e
LW
55 &finddir($wanted,$fixtopdir,$topnlink);
56 }
57 else {
58 warn "Can't cd to $topdir: $!\n";
59 }
60 }
61 else {
748a9306 62 unless (($dir,$_) = fileparse($topdir)) {
a0d0e21e
LW
63 ($dir,$_) = ('.', $topdir);
64 }
65 $name = $topdir;
66 chdir $dir && &$wanted;
67 }
68 chdir $cwd;
69 }
70}
71
72sub finddir {
73 local($wanted,$dir,$nlink) = @_;
74 local($dev,$ino,$mode,$subcount);
75 local($name);
76
77 # Get the list of files in the current directory.
78
79 opendir(DIR,'.') || (warn "Can't open $dir: $!\n", return);
80 local(@filenames) = readdir(DIR);
81 closedir(DIR);
82
83 if ($nlink == 2 && !$dont_use_nlink) { # This dir has no subdirectories.
84 for (@filenames) {
85 next if $_ eq '.';
86 next if $_ eq '..';
87 $name = "$dir/$_";
88 $nlink = 0;
89 &$wanted;
90 }
91 }
92 else { # This dir has subdirectories.
93 $subcount = $nlink - 2;
94 for (@filenames) {
95 next if $_ eq '.';
96 next if $_ eq '..';
97 $nlink = $prune = 0;
98 $name = "$dir/$_";
99 &$wanted;
100 if ($subcount > 0 || $dont_use_nlink) { # Seen all the subdirs?
101
102 # Get link count and check for directoriness.
103
748a9306
LW
104 ($dev,$ino,$mode,$nlink) = ($Is_VMS ? stat($_) : lstat($_))
105 unless ($nlink || $dont_use_nlink);
a0d0e21e
LW
106
107 if (-d _) {
108
109 # It really is a directory, so do it recursively.
110
111 if (!$prune && chdir $_) {
748a9306 112 $name =~ s/\.dir$// if $Is_VMS;
a0d0e21e
LW
113 &finddir($wanted,$name,$nlink);
114 chdir '..';
115 }
116 --$subcount;
117 }
118 }
119 }
120 }
121}
122
123# Usage:
124# use File::Find;
125#
126# finddepth(\&wanted, '/foo','/bar');
127#
128# sub wanted { ... }
129# where wanted does whatever you want. $dir contains the
130# current directory name, and $_ the current filename within
131# that directory. $name contains "$dir/$_". You are cd'ed
132# to $dir when the function is called. The function may
133# set $prune to prune the tree.
134#
135# This library is primarily for find2perl, which, when fed
136#
137# find2perl / -name .nfs\* -mtime +7 -exec rm -f {} \; -o -fstype nfs -prune
138#
139# spits out something like this
140#
141# sub wanted {
142# /^\.nfs.*$/ &&
143# (($dev,$ino,$mode,$nlink,$uid,$gid) = lstat($_)) &&
144# int(-M _) > 7 &&
145# unlink($_)
146# ||
147# ($nlink || (($dev,$ino,$mode,$nlink,$uid,$gid) = lstat($_))) &&
148# $dev < 0 &&
149# ($prune = 1);
150# }
151
152sub finddepth {
153 my $wanted = shift;
748a9306 154 $cwd = fastcwd();;
a0d0e21e
LW
155 foreach $topdir (@_) {
156 (($topdev,$topino,$topmode,$topnlink) = stat($topdir))
157 || (warn("Can't stat $topdir: $!\n"), next);
158 if (-d _) {
159 if (chdir($topdir)) {
160 ($fixtopdir = $topdir) =~ s,/$,, ;
748a9306 161 $fixtopdir =~ s/\.dir$// if $Is_VMS;
a0d0e21e
LW
162 &finddepthdir($wanted,$fixtopdir,$topnlink);
163 ($dir,$_) = ($fixtopdir,'.');
164 $name = $fixtopdir;
165 &$wanted;
166 }
167 else {
168 warn "Can't cd to $topdir: $!\n";
169 }
170 }
171 else {
748a9306 172 unless (($dir,$_) = fileparse($topdir)) {
a0d0e21e
LW
173 ($dir,$_) = ('.', $topdir);
174 }
175 chdir $dir && &$wanted;
176 }
177 chdir $cwd;
178 }
179}
180
181sub finddepthdir {
182 my($wanted,$dir,$nlink) = @_;
183 my($dev,$ino,$mode,$subcount);
184 my($name);
185
186 # Get the list of files in the current directory.
187
188 opendir(DIR,'.') || warn "Can't open $dir: $!\n";
189 my(@filenames) = readdir(DIR);
190 closedir(DIR);
191
748a9306 192 if ($nlink == 2 && !$dont_use_nlink) { # This dir has no subdirectories.
a0d0e21e
LW
193 for (@filenames) {
194 next if $_ eq '.';
195 next if $_ eq '..';
196 $name = "$dir/$_";
197 $nlink = 0;
198 &$wanted;
199 }
200 }
201 else { # This dir has subdirectories.
202 $subcount = $nlink - 2;
203 for (@filenames) {
204 next if $_ eq '.';
205 next if $_ eq '..';
206 $nlink = $prune = 0;
207 $name = "$dir/$_";
748a9306 208 if ($subcount > 0 || $dont_use_nlink) { # Seen all the subdirs?
a0d0e21e
LW
209
210 # Get link count and check for directoriness.
211
748a9306 212 ($dev,$ino,$mode,$nlink) = ($Is_VMS ? stat($_) : lstat($_));
a0d0e21e
LW
213
214 if (-d _) {
215
216 # It really is a directory, so do it recursively.
217
218 if (!$prune && chdir $_) {
748a9306 219 $name =~ s/\.dir$// if $Is_VMS;
a0d0e21e
LW
220 &finddepthdir($wanted,$name,$nlink);
221 chdir '..';
222 }
223 --$subcount;
224 }
225 }
226 &$wanted;
227 }
228 }
229}
230
748a9306
LW
231if ($Config{'osname'} eq 'VMS') {
232 $Is_VMS = 1;
233 $dont_use_nlink = 1;
234}
235
a0d0e21e
LW
2361;
237