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