03ace14fd70a189b4ab7de08e23c4e46f890c8c1
[perl.git] / lib / File / Find.pm
1 package File::Find;
2 require 5.000;
3 require Exporter;
4 use Config;
5 require Cwd;
6 require File::Basename;
7
8
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
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.
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 &&
49         ($File::Find::prune = 1);
50     }
51
52 Set the variable $File::Find::dont_use_nlink if you're using AFS,
53 since AFS cheats.
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 {
62         -l && !-e && print "bogus link: $File::Find::name\n";
63     } 
64
65 =cut
66
67 @ISA = qw(Exporter);
68 @EXPORT = qw(find finddepth);
69
70
71 sub find {
72     my $wanted = shift;
73     my $cwd = Cwd::cwd();
74     my ($topdir,$topdev,$topino,$topmode,$topnlink);
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;
83                 my $fixtopdir = $topdir;
84                 $fixtopdir =~ s,/$,, ;
85                 $fixtopdir =~ s/\.dir$// if $Is_VMS;
86                 $fixtopdir =~ s/\\dir$// if $Is_NT;
87                 &finddir($wanted,$fixtopdir,$topnlink);
88             }
89             else {
90                 warn "Can't cd to $topdir: $!\n";
91             }
92         }
93         else {
94             unless (($_,$dir) = File::Basename::fileparse($topdir)) {
95                 ($dir,$_) = ('.', $topdir);
96             }
97             $name = $topdir;
98             chdir $dir && &$wanted;
99         }
100         chdir $cwd;
101     }
102 }
103
104 sub finddir {
105     my($wanted, $nlink);
106     local($dir, $name);
107     ($wanted, $dir, $nlink) = @_;
108
109     my($dev, $ino, $mode, $subcount);
110
111     # Get the list of files in the current directory.
112     opendir(DIR,'.') || (warn "Can't open $dir: $!\n", return);
113     my(@filenames) = readdir(DIR);
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
137                 ($dev,$ino,$mode,$nlink) = ($Is_VMS ? stat($_) : lstat($_));
138                     # unless ($nlink || $dont_use_nlink);
139                 
140                 if (-d _) {
141
142                     # It really is a directory, so do it recursively.
143
144                     if (!$prune && chdir $_) {
145                         $name =~ s/\.dir$// if $Is_VMS;
146                         $name =~ s/\\dir$// if $Is_NT;
147                         &finddir($wanted,$name,$nlink);
148                         chdir '..';
149                     }
150                     --$subcount;
151                 }
152             }
153         }
154     }
155 }
156
157
158 sub finddepth {
159     my $wanted = shift;
160
161     $cwd = Cwd::fastcwd();;
162
163     my($topdir, $topdev, $topino, $topmode, $topnlink);
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)) {
169                 my $fixtopdir = $topdir;
170                 $fixtopdir =~ s,/$,, ;
171                 $fixtopdir =~ s/\.dir$// if $Is_VMS;
172                 $fixtopdir =~ s/\\dir$// if $Is_NT;
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 {
183             unless (($_,$dir) = File::Basename::fileparse($topdir)) {
184                 ($dir,$_) = ('.', $topdir);
185             }
186             chdir $dir && &$wanted;
187         }
188         chdir $cwd;
189     }
190 }
191
192 sub finddepthdir {
193     my($wanted, $nlink);
194     local($dir, $name);
195     ($wanted,$dir,$nlink) = @_;
196     my($dev, $ino, $mode, $subcount);
197
198     # Get the list of files in the current directory.
199     opendir(DIR,'.') || warn "Can't open $dir: $!\n";
200     my(@filenames) = readdir(DIR);
201     closedir(DIR);
202
203     if ($nlink == 2 && !$dont_use_nlink) {   # This dir has no subdirectories.
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 '..';
217             $nlink = 0;
218             $name = "$dir/$_";
219             if ($subcount > 0 || $dont_use_nlink) {    # Seen all the subdirs?
220
221                 # Get link count and check for directoriness.
222
223                 ($dev,$ino,$mode,$nlink) = ($Is_VMS ? stat($_) : lstat($_));
224                 
225                 if (-d _) {
226
227                     # It really is a directory, so do it recursively.
228
229                     if (chdir $_) {
230                         $name =~ s/\.dir$// if $Is_VMS;
231                         $name =~ s/\\dir$// if $Is_NT;
232                         &finddepthdir($wanted,$name,$nlink);
233                         chdir '..';
234                     }
235                     --$subcount;
236                 }
237             }
238             &$wanted;
239         }
240     }
241 }
242
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.
250 if ($^O eq 'VMS') {
251   $Is_VMS = 1;
252   $dont_use_nlink = 1;
253 }
254 if ($^O =~ m:^mswin32:i) {
255   $Is_NT = 1;
256   $dont_use_nlink = 1;
257 }
258
259 $dont_use_nlink = 1 if $^O eq 'os2';
260
261 1;
262