contrib/perl5/lib/File/Find.pm

   1 package File::Find;
   2 require 5.000;
   3 require Exporter;
   4 require Cwd;
   5
   6 =head1 NAME
   7
   8 find - traverse a file tree
   9
  10 finddepth - traverse a directory structure depth-first
  11
  12 =head1 SYNOPSIS
  13
  14     use File::Find;
  15     find(\&wanted, '/foo','/bar');
  16     sub wanted { ... }
  17
  18     use File::Find;
  19     finddepth(\&wanted, '/foo','/bar');
  20     sub wanted { ... }
  21
  22 =head1 DESCRIPTION
  23
  24 The first argument to find() is either a hash reference describing the
  25 operations to be performed for each file, a code reference, or a string
  26 that contains a subroutine name.  If it is a hash reference, then the
  27 value for the key C<wanted> should be a code reference.  This code
  28 reference is called I<the wanted() function> below.
  29
  30 Currently the only other supported key for the above hash is
  31 C<bydepth>, in presense of which the walk over directories is
  32 performed depth-first.  Entry point finddepth() is a shortcut for
  33 specifying C<{ bydepth => 1}> in the first argument of find().
  34
  35 The wanted() function does whatever verifications you want.
  36 $File::Find::dir contains the current directory name, and $_ the
  37 current filename within that directory.  $File::Find::name contains
  38 C<"$File::Find::dir/$_">.  You are chdir()'d to $File::Find::dir when
  39 the function is called.  The function may set $File::Find::prune to
  40 prune the tree.
  41
  42 File::Find assumes that you don't alter the $_ variable.  If you do then
  43 make sure you return it to its original value before exiting your function.
  44
  45 This library is useful for the C<find2perl> tool, which when fed,
  46
  47     find2perl / -name .nfs\* -mtime +7 \
  48         -exec rm -f {} \; -o -fstype nfs -prune
  49
  50 produces something like:
  51
  52     sub wanted {
  53         /^\.nfs.*$/ &&
  54         (($dev,$ino,$mode,$nlink,$uid,$gid) = lstat($_)) &&
  55         int(-M _) > 7 &&
  56         unlink($_)
  57         ||
  58         ($nlink || (($dev,$ino,$mode,$nlink,$uid,$gid) = lstat($_))) &&
  59         $dev < 0 &&
  60         ($File::Find::prune = 1);
  61     }
  62
  63 Set the variable $File::Find::dont_use_nlink if you're using AFS,
  64 since AFS cheats.
  65
  66 C<finddepth> is just like C<find>, except that it does a depth-first
  67 search.
  68
  69 Here's another interesting wanted function.  It will find all symlinks
  70 that don't resolve:
  71
  72     sub wanted {
  73         -l && !-e && print "bogus link: $File::Find::name\n";
  74     }
  75
  76 =head1 BUGS
  77
  78 There is no way to make find or finddepth follow symlinks.
  79
  80 =cut
  81
  82 @ISA = qw(Exporter);
  83 @EXPORT = qw(find finddepth);
  84
  85
  86 sub find_opt {
  87     my $wanted = shift;
  88     my $bydepth = $wanted->{bydepth};
  89     my $cwd = $bydepth ? Cwd::fastcwd() : Cwd::cwd();
  90     # Localize these rather than lexicalizing them for backwards
  91     # compatibility.
  92     local($topdir,$topdev,$topino,$topmode,$topnlink);
  93     foreach $topdir (@_) {
  94         (($topdev,$topino,$topmode,$topnlink) =
  95           ($Is_VMS ? stat($topdir) : lstat($topdir)))
  96           || (warn("Can't stat $topdir: $!\n"), next);
  97         if (-d _) {
  98             if (chdir($topdir)) {
  99                 $prune = 0;
 100                 unless ($bydepth) {
 101                   ($dir,$_) = ($topdir,'.');
 102                   $name = $topdir;
 103                   $wanted->{wanted}->();
 104                 }
 105                 next if $prune;
 106                 my $fixtopdir = $topdir;
 107                 $fixtopdir =~ s,/$,, ;
 108                 $fixtopdir =~ s/\.dir$// if $Is_VMS;
 109                 &finddir($wanted,$fixtopdir,$topnlink, $bydepth);
 110                 if ($bydepth) {
 111                   ($dir,$_) = ($fixtopdir,'.');
 112                   $name = $fixtopdir;
 113                   $wanted->{wanted}->();
 114                 }
 115             }
 116             else {
 117                 warn "Can't cd to $topdir: $!\n";
 118             }
 119         }
 120         else {
 121             require File::Basename;
 122             unless (($_,$dir) = File::Basename::fileparse($topdir)) {
 123                 ($dir,$_) = ('.', $topdir);
 124             }
 125             if (chdir($dir)) {
 126                 $name = $topdir;
 127                 $wanted->{wanted}->();
 128             }
 129             else {
 130                 warn "Can't cd to $dir: $!\n";
 131             }
 132         }
 133         chdir $cwd;
 134     }
 135 }
 136
 137 sub finddir {
 138     my($wanted, $nlink, $bydepth);
 139     local($dir, $name);
 140     ($wanted, $dir, $nlink, $bydepth) = @_;
 141
 142     my($dev, $ino, $mode, $subcount);
 143
 144     # Get the list of files in the current directory.
 145     opendir(DIR,'.') || (warn("Can't open $dir: $!\n"), $bydepth || return);
 146     my(@filenames) = readdir(DIR);
 147     closedir(DIR);
 148
 149     if ($nlink == 2 && !$dont_use_nlink) {  # This dir has no subdirectories.
 150         for (@filenames) {
 151             next if $_ eq '.';
 152             next if $_ eq '..';
 153             $name = "$dir/$_";
 154             $nlink = 0;
 155             $wanted->{wanted}->();
 156         }
 157     }
 158     else {                    # This dir has subdirectories.
 159         $subcount = $nlink - 2;
 160         for (@filenames) {
 161             next if $_ eq '.';
 162             next if $_ eq '..';
 163             $nlink = 0;
 164             $prune = 0 unless $bydepth;
 165             $name = "$dir/$_";
 166             $wanted->{wanted}->() unless $bydepth;
 167             if ($subcount > 0 || $dont_use_nlink) {    # Seen all the subdirs?
 168
 169                 # Get link count and check for directoriness.
 170
 171                 ($dev,$ino,$mode,$nlink) = ($Is_VMS ? stat($_) : lstat($_));
 172                     # unless ($nlink || $dont_use_nlink);
 173
 174                 if (-d _) {
 175
 176                     # It really is a directory, so do it recursively.
 177
 178                     --$subcount;
 179                     next if $prune;
 180                     # Untaint $_, so that we can do a chdir
 181                     $_ = $1 if /^(.*)/;
 182                     if (chdir $_) {
 183                         $name =~ s/\.dir$// if $Is_VMS;
 184                         &finddir($wanted,$name,$nlink, $bydepth);
 185                         chdir '..';
 186                     }
 187                     else {
 188                         warn "Can't cd to $_: $!\n";
 189                     }
 190                 }
 191             }
 192             $wanted->{wanted}->() if $bydepth;
 193         }
 194     }
 195 }
 196
 197 sub wrap_wanted {
 198   my $wanted = shift;
 199   ref($wanted) eq 'HASH' ? $wanted : { wanted => $wanted };
 200 }
 201
 202 sub find {
 203   my $wanted = shift;
 204   find_opt(wrap_wanted($wanted), @_);
 205 }
 206
 207 sub finddepth {
 208   my $wanted = wrap_wanted(shift);
 209   $wanted->{bydepth} = 1;
 210   find_opt($wanted, @_);
 211 }
 212
 213 # These are hard-coded for now, but may move to hint files.
 214 if ($^O eq 'VMS') {
 215   $Is_VMS = 1;
 216   $dont_use_nlink = 1;
 217 }
 218
 219 $dont_use_nlink = 1
 220     if $^O eq 'os2' || $^O eq 'dos' || $^O eq 'amigaos' || $^O eq 'MSWin32';
 221
 222 # Set dont_use_nlink in your hint file if your system's stat doesn't
 223 # report the number of links in a directory as an indication
 224 # of the number of files.
 225 # See, e.g. hints/machten.sh for MachTen 2.2.
 226 unless ($dont_use_nlink) {
 227   require Config;
 228   $dont_use_nlink = 1 if ($Config::Config{'dont_use_nlink'});
 229 }
 230
 231 1;
 232