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 | |
8 | @ISA = qw(Exporter); |
748a9306 |
9 | @EXPORT = qw(find finddepth $name $dir); |
a0d0e21e |
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 | |
42 | sub find { |
43 | my $wanted = shift; |
748a9306 |
44 | my $cwd = fastcwd(); |
a0d0e21e |
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 |
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 |
63 | ($dir,$_) = ('.', $topdir); |
64 | } |
65 | $name = $topdir; |
66 | chdir $dir && &$wanted; |
67 | } |
68 | chdir $cwd; |
69 | } |
70 | } |
71 | |
72 | sub 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 |
104 | ($dev,$ino,$mode,$nlink) = ($Is_VMS ? stat($_) : lstat($_)) |
105 | unless ($nlink || $dont_use_nlink); |
a0d0e21e |
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 |
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 | |
152 | sub finddepth { |
153 | my $wanted = shift; |
748a9306 |
154 | $cwd = fastcwd();; |
a0d0e21e |
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 |
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 |
173 | ($dir,$_) = ('.', $topdir); |
174 | } |
175 | chdir $dir && &$wanted; |
176 | } |
177 | chdir $cwd; |
178 | } |
179 | } |
180 | |
181 | sub 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 |
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 |
209 | |
210 | # Get link count and check for directoriness. |
211 | |
748a9306 |
212 | ($dev,$ino,$mode,$nlink) = ($Is_VMS ? stat($_) : lstat($_)); |
a0d0e21e |
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 |
220 | &finddepthdir($wanted,$name,$nlink); |
221 | chdir '..'; |
222 | } |
223 | --$subcount; |
224 | } |
225 | } |
226 | &$wanted; |
227 | } |
228 | } |
229 | } |
230 | |
748a9306 |
231 | if ($Config{'osname'} eq 'VMS') { |
232 | $Is_VMS = 1; |
233 | $dont_use_nlink = 1; |
234 | } |
235 | |
a0d0e21e |
236 | 1; |
237 | |