[10723] | 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 | File::Find assumes that you don't alter the $_ variable. If you do then |
---|
| 35 | make sure you return it to its original value before exiting your function. |
---|
| 36 | |
---|
| 37 | This library is primarily for the C<find2perl> tool, which when fed, |
---|
| 38 | |
---|
| 39 | find2perl / -name .nfs\* -mtime +7 \ |
---|
| 40 | -exec rm -f {} \; -o -fstype nfs -prune |
---|
| 41 | |
---|
| 42 | produces something like: |
---|
| 43 | |
---|
| 44 | sub wanted { |
---|
| 45 | /^\.nfs.*$/ && |
---|
| 46 | (($dev,$ino,$mode,$nlink,$uid,$gid) = lstat($_)) && |
---|
| 47 | int(-M _) > 7 && |
---|
| 48 | unlink($_) |
---|
| 49 | || |
---|
| 50 | ($nlink || (($dev,$ino,$mode,$nlink,$uid,$gid) = lstat($_))) && |
---|
| 51 | $dev < 0 && |
---|
| 52 | ($File::Find::prune = 1); |
---|
| 53 | } |
---|
| 54 | |
---|
| 55 | Set the variable $File::Find::dont_use_nlink if you're using AFS, |
---|
| 56 | since AFS cheats. |
---|
| 57 | |
---|
| 58 | C<finddepth> is just like C<find>, except that it does a depth-first |
---|
| 59 | search. |
---|
| 60 | |
---|
| 61 | Here's another interesting wanted function. It will find all symlinks |
---|
| 62 | that don't resolve: |
---|
| 63 | |
---|
| 64 | sub wanted { |
---|
| 65 | -l && !-e && print "bogus link: $File::Find::name\n"; |
---|
| 66 | } |
---|
| 67 | |
---|
| 68 | =head1 BUGS |
---|
| 69 | |
---|
| 70 | There is no way to make find or finddepth follow symlinks. |
---|
| 71 | |
---|
| 72 | =cut |
---|
| 73 | |
---|
| 74 | @ISA = qw(Exporter); |
---|
| 75 | @EXPORT = qw(find finddepth); |
---|
| 76 | |
---|
| 77 | |
---|
| 78 | sub find { |
---|
| 79 | my $wanted = shift; |
---|
| 80 | my $cwd = Cwd::cwd(); |
---|
| 81 | # Localize these rather than lexicalizing them for backwards |
---|
| 82 | # compatibility. |
---|
| 83 | local($topdir,$topdev,$topino,$topmode,$topnlink); |
---|
| 84 | foreach $topdir (@_) { |
---|
| 85 | (($topdev,$topino,$topmode,$topnlink) = |
---|
| 86 | ($Is_VMS ? stat($topdir) : lstat($topdir))) |
---|
| 87 | || (warn("Can't stat $topdir: $!\n"), next); |
---|
| 88 | if (-d _) { |
---|
| 89 | if (chdir($topdir)) { |
---|
| 90 | ($dir,$_) = ($topdir,'.'); |
---|
| 91 | $name = $topdir; |
---|
| 92 | $prune = 0; |
---|
| 93 | &$wanted; |
---|
| 94 | if (!$prune) { |
---|
| 95 | my $fixtopdir = $topdir; |
---|
| 96 | $fixtopdir =~ s,/$,, ; |
---|
| 97 | $fixtopdir =~ s/\.dir$// if $Is_VMS; |
---|
| 98 | $fixtopdir =~ s/\\dir$// if $Is_NT; |
---|
| 99 | &finddir($wanted,$fixtopdir,$topnlink); |
---|
| 100 | } |
---|
| 101 | } |
---|
| 102 | else { |
---|
| 103 | warn "Can't cd to $topdir: $!\n"; |
---|
| 104 | } |
---|
| 105 | } |
---|
| 106 | else { |
---|
| 107 | unless (($_,$dir) = File::Basename::fileparse($topdir)) { |
---|
| 108 | ($dir,$_) = ('.', $topdir); |
---|
| 109 | } |
---|
| 110 | $name = $topdir; |
---|
| 111 | chdir $dir && &$wanted; |
---|
| 112 | } |
---|
| 113 | chdir $cwd; |
---|
| 114 | } |
---|
| 115 | } |
---|
| 116 | |
---|
| 117 | sub finddir { |
---|
| 118 | my($wanted, $nlink); |
---|
| 119 | local($dir, $name); |
---|
| 120 | ($wanted, $dir, $nlink) = @_; |
---|
| 121 | |
---|
| 122 | my($dev, $ino, $mode, $subcount); |
---|
| 123 | |
---|
| 124 | # Get the list of files in the current directory. |
---|
| 125 | opendir(DIR,'.') || (warn "Can't open $dir: $!\n", return); |
---|
| 126 | my(@filenames) = readdir(DIR); |
---|
| 127 | closedir(DIR); |
---|
| 128 | |
---|
| 129 | if ($nlink == 2 && !$dont_use_nlink) { # This dir has no subdirectories. |
---|
| 130 | for (@filenames) { |
---|
| 131 | next if $_ eq '.'; |
---|
| 132 | next if $_ eq '..'; |
---|
| 133 | $name = "$dir/$_"; |
---|
| 134 | $nlink = 0; |
---|
| 135 | &$wanted; |
---|
| 136 | } |
---|
| 137 | } |
---|
| 138 | else { # This dir has subdirectories. |
---|
| 139 | $subcount = $nlink - 2; |
---|
| 140 | for (@filenames) { |
---|
| 141 | next if $_ eq '.'; |
---|
| 142 | next if $_ eq '..'; |
---|
| 143 | $nlink = $prune = 0; |
---|
| 144 | $name = "$dir/$_"; |
---|
| 145 | &$wanted; |
---|
| 146 | if ($subcount > 0 || $dont_use_nlink) { # Seen all the subdirs? |
---|
| 147 | |
---|
| 148 | # Get link count and check for directoriness. |
---|
| 149 | |
---|
| 150 | ($dev,$ino,$mode,$nlink) = ($Is_VMS ? stat($_) : lstat($_)); |
---|
| 151 | # unless ($nlink || $dont_use_nlink); |
---|
| 152 | |
---|
| 153 | if (-d _) { |
---|
| 154 | |
---|
| 155 | # It really is a directory, so do it recursively. |
---|
| 156 | |
---|
| 157 | if (!$prune && chdir $_) { |
---|
| 158 | $name =~ s/\.dir$// if $Is_VMS; |
---|
| 159 | $name =~ s/\\dir$// if $Is_NT; |
---|
| 160 | &finddir($wanted,$name,$nlink); |
---|
| 161 | chdir '..'; |
---|
| 162 | } |
---|
| 163 | --$subcount; |
---|
| 164 | } |
---|
| 165 | } |
---|
| 166 | } |
---|
| 167 | } |
---|
| 168 | } |
---|
| 169 | |
---|
| 170 | |
---|
| 171 | sub finddepth { |
---|
| 172 | my $wanted = shift; |
---|
| 173 | |
---|
| 174 | $cwd = Cwd::fastcwd();; |
---|
| 175 | |
---|
| 176 | # Localize these rather than lexicalizing them for backwards |
---|
| 177 | # compatibility. |
---|
| 178 | local($topdir, $topdev, $topino, $topmode, $topnlink); |
---|
| 179 | foreach $topdir (@_) { |
---|
| 180 | (($topdev,$topino,$topmode,$topnlink) = |
---|
| 181 | ($Is_VMS ? stat($topdir) : lstat($topdir))) |
---|
| 182 | || (warn("Can't stat $topdir: $!\n"), next); |
---|
| 183 | if (-d _) { |
---|
| 184 | if (chdir($topdir)) { |
---|
| 185 | my $fixtopdir = $topdir; |
---|
| 186 | $fixtopdir =~ s,/$,, ; |
---|
| 187 | $fixtopdir =~ s/\.dir$// if $Is_VMS; |
---|
| 188 | $fixtopdir =~ s/\\dir$// if $Is_NT; |
---|
| 189 | &finddepthdir($wanted,$fixtopdir,$topnlink); |
---|
| 190 | ($dir,$_) = ($fixtopdir,'.'); |
---|
| 191 | $name = $fixtopdir; |
---|
| 192 | &$wanted; |
---|
| 193 | } |
---|
| 194 | else { |
---|
| 195 | warn "Can't cd to $topdir: $!\n"; |
---|
| 196 | } |
---|
| 197 | } |
---|
| 198 | else { |
---|
| 199 | unless (($_,$dir) = File::Basename::fileparse($topdir)) { |
---|
| 200 | ($dir,$_) = ('.', $topdir); |
---|
| 201 | } |
---|
| 202 | $name = $topdir; |
---|
| 203 | chdir $dir && &$wanted; |
---|
| 204 | } |
---|
| 205 | chdir $cwd; |
---|
| 206 | } |
---|
| 207 | } |
---|
| 208 | |
---|
| 209 | sub finddepthdir { |
---|
| 210 | my($wanted, $nlink); |
---|
| 211 | local($dir, $name); |
---|
| 212 | ($wanted,$dir,$nlink) = @_; |
---|
| 213 | my($dev, $ino, $mode, $subcount); |
---|
| 214 | |
---|
| 215 | # Get the list of files in the current directory. |
---|
| 216 | opendir(DIR,'.') || warn "Can't open $dir: $!\n"; |
---|
| 217 | my(@filenames) = readdir(DIR); |
---|
| 218 | closedir(DIR); |
---|
| 219 | |
---|
| 220 | if ($nlink == 2 && !$dont_use_nlink) { # This dir has no subdirectories. |
---|
| 221 | for (@filenames) { |
---|
| 222 | next if $_ eq '.'; |
---|
| 223 | next if $_ eq '..'; |
---|
| 224 | $name = "$dir/$_"; |
---|
| 225 | $nlink = 0; |
---|
| 226 | &$wanted; |
---|
| 227 | } |
---|
| 228 | } |
---|
| 229 | else { # This dir has subdirectories. |
---|
| 230 | $subcount = $nlink - 2; |
---|
| 231 | for (@filenames) { |
---|
| 232 | next if $_ eq '.'; |
---|
| 233 | next if $_ eq '..'; |
---|
| 234 | $nlink = 0; |
---|
| 235 | $name = "$dir/$_"; |
---|
| 236 | if ($subcount > 0 || $dont_use_nlink) { # Seen all the subdirs? |
---|
| 237 | |
---|
| 238 | # Get link count and check for directoriness. |
---|
| 239 | |
---|
| 240 | ($dev,$ino,$mode,$nlink) = ($Is_VMS ? stat($_) : lstat($_)); |
---|
| 241 | |
---|
| 242 | if (-d _) { |
---|
| 243 | |
---|
| 244 | # It really is a directory, so do it recursively. |
---|
| 245 | |
---|
| 246 | if (chdir $_) { |
---|
| 247 | $name =~ s/\.dir$// if $Is_VMS; |
---|
| 248 | $name =~ s/\\dir$// if $Is_NT; |
---|
| 249 | &finddepthdir($wanted,$name,$nlink); |
---|
| 250 | chdir '..'; |
---|
| 251 | } |
---|
| 252 | --$subcount; |
---|
| 253 | } |
---|
| 254 | } |
---|
| 255 | &$wanted; |
---|
| 256 | } |
---|
| 257 | } |
---|
| 258 | } |
---|
| 259 | |
---|
| 260 | # Set dont_use_nlink in your hint file if your system's stat doesn't |
---|
| 261 | # report the number of links in a directory as an indication |
---|
| 262 | # of the number of files. |
---|
| 263 | # See, e.g. hints/machten.sh for MachTen 2.2. |
---|
| 264 | $dont_use_nlink = 1 if ($Config::Config{'dont_use_nlink'}); |
---|
| 265 | |
---|
| 266 | # These are hard-coded for now, but may move to hint files. |
---|
| 267 | if ($^O eq 'VMS') { |
---|
| 268 | $Is_VMS = 1; |
---|
| 269 | $dont_use_nlink = 1; |
---|
| 270 | } |
---|
| 271 | if ($^O =~ m:^mswin32:i) { |
---|
| 272 | $Is_NT = 1; |
---|
| 273 | $dont_use_nlink = 1; |
---|
| 274 | } |
---|
| 275 | |
---|
| 276 | $dont_use_nlink = 1 |
---|
| 277 | if $^O eq 'os2' || $^O eq 'msdos' || $^O eq 'amigaos'; |
---|
| 278 | |
---|
| 279 | 1; |
---|
| 280 | |
---|