lib/File/Find.pm

   1 package File::Find;
   2 require 5.000;
   3 require Exporter;
   4 use Config;
   5 use Cwd;
   6 use File::Basename;
   7
   8 =head1 NAME
   9
  10 find - traverse a file tree
  11
  12 finddepth - traverse a directory structure depth-first
  13
  14 =head1 SYNOPSIS
  15
  16     use File::Find;
  17     find(\&wanted, '/foo','/bar');
  18     sub wanted { ... }
  19
  20     use File::Find;
  21     finddepth(\&wanted, '/foo','/bar');
  22     sub wanted { ... }
  23
  24 =head1 DESCRIPTION
  25
  26 The wanted() function does whatever verifications you want.  $dir contains
  27 the current directory name, and $_ the current filename within that
  28 directory.  $name contains C<"$dir/$_">.  You are chdir()'d to $dir when
  29 the function is called.  The function may set $prune to prune the tree.
  30
  31 This library is primarily for the C<find2perl> tool, which when fed,
  32
  33     find2perl / -name .nfs\* -mtime +7 \
  34         -exec rm -f {} \; -o -fstype nfs -prune
  35
  36 produces something like:
  37
  38     sub wanted {
  39         /^\.nfs.*$/ &&
  40         (($dev,$ino,$mode,$nlink,$uid,$gid) = lstat($_)) &&
  41         int(-M _) > 7 &&
  42         unlink($_)
  43         ||
  44         ($nlink || (($dev,$ino,$mode,$nlink,$uid,$gid) = lstat($_))) &&
  45         $dev < 0 &&
  46         ($prune = 1);
  47     }
  48
  49 Set the variable $dont_use_nlink if you're using AFS, since AFS cheats.
  50
  51 C<finddepth> is just like C<find>, except that it does a depth-first
  52 search.
  53
  54 Here's another interesting wanted function.  It will find all symlinks
  55 that don't resolve:
  56
  57     sub wanted {
  58         -l && !-e && print "bogus link: $name\n";
  59     }
  60
  61 =cut
  62
  63 @ISA = qw(Exporter);
  64 @EXPORT = qw(find finddepth $name $dir);
  65
  66 $dont_use_nlink = 1 if $Config{osname} =~ m:^os/?2$:i ;
  67
  68 # Usage:
  69 #       use File::Find;
  70 #
  71 #       find(\&wanted, '/foo','/bar');
  72 #
  73 #       sub wanted { ... }
  74 #               where wanted does whatever you want.  $dir contains the
  75 #               current directory name, and $_ the current filename within
  76 #               that directory.  $name contains "$dir/$_".  You are cd'ed
  77 #               to $dir when the function is called.  The function may
  78 #               set $prune to prune the tree.
  79 #
  80 # This library is primarily for find2perl, which, when fed
  81 #
  82 #   find2perl / -name .nfs\* -mtime +7 -exec rm -f {} \; -o -fstype nfs -prune
  83 #
  84 # spits out something like this
  85 #
  86 #       sub wanted {
  87 #           /^\.nfs.*$/ &&
  88 #           (($dev,$ino,$mode,$nlink,$uid,$gid) = lstat($_)) &&
  89 #           int(-M _) > 7 &&
  90 #           unlink($_)
  91 #           ||
  92 #           ($nlink || (($dev,$ino,$mode,$nlink,$uid,$gid) = lstat($_))) &&
  93 #           $dev < 0 &&
  94 #           ($prune = 1);
  95 #       }
  96 #
  97 # Set the variable $dont_use_nlink if you're using AFS, since AFS cheats.
  98
  99 sub find {
 100     my $wanted = shift;
 101     my $cwd = fastcwd();
 102     foreach $topdir (@_) {
 103         (($topdev,$topino,$topmode,$topnlink) = stat($topdir))
 104           || (warn("Can't stat $topdir: $!\n"), next);
 105         if (-d _) {
 106             if (chdir($topdir)) {
 107                 ($dir,$_) = ($topdir,'.');
 108                 $name = $topdir;
 109                 &$wanted;
 110                 ($fixtopdir = $topdir) =~ s,/$,, ;
 111                 $fixtopdir =~ s/\.dir$// if $Is_VMS; ;
 112                 &finddir($wanted,$fixtopdir,$topnlink);
 113             }
 114             else {
 115                 warn "Can't cd to $topdir: $!\n";
 116             }
 117         }
 118         else {
 119             unless (($dir,$_) = fileparse($topdir)) {
 120                 ($dir,$_) = ('.', $topdir);
 121             }
 122             $name = $topdir;
 123             chdir $dir && &$wanted;
 124         }
 125         chdir $cwd;
 126     }
 127 }
 128
 129 sub finddir {
 130     local($wanted,$dir,$nlink) = @_;
 131     local($dev,$ino,$mode,$subcount);
 132     local($name);
 133
 134     # Get the list of files in the current directory.
 135
 136     opendir(DIR,'.') || (warn "Can't open $dir: $!\n", return);
 137     local(@filenames) = readdir(DIR);
 138     closedir(DIR);
 139
 140     if ($nlink == 2 && !$dont_use_nlink) {  # This dir has no subdirectories.
 141         for (@filenames) {
 142             next if $_ eq '.';
 143             next if $_ eq '..';
 144             $name = "$dir/$_";
 145             $nlink = 0;
 146             &$wanted;
 147         }
 148     }
 149     else {                    # This dir has subdirectories.
 150         $subcount = $nlink - 2;
 151         for (@filenames) {
 152             next if $_ eq '.';
 153             next if $_ eq '..';
 154             $nlink = $prune = 0;
 155             $name = "$dir/$_";
 156             &$wanted;
 157             if ($subcount > 0 || $dont_use_nlink) {    # Seen all the subdirs?
 158
 159                 # Get link count and check for directoriness.
 160
 161                 ($dev,$ino,$mode,$nlink) = ($Is_VMS ? stat($_) : lstat($_))
 162                     unless ($nlink || $dont_use_nlink);
 163
 164                 if (-d _) {
 165
 166                     # It really is a directory, so do it recursively.
 167
 168                     if (!$prune && chdir $_) {
 169                         $name =~ s/\.dir$// if $Is_VMS;
 170                         &finddir($wanted,$name,$nlink);
 171                         chdir '..';
 172                     }
 173                     --$subcount;
 174                 }
 175             }
 176         }
 177     }
 178 }
 179
 180 # Usage:
 181 #       use File::Find;
 182 #
 183 #       finddepth(\&wanted, '/foo','/bar');
 184 #
 185 #       sub wanted { ... }
 186 #               where wanted does whatever you want.  $dir contains the
 187 #               current directory name, and $_ the current filename within
 188 #               that directory.  $name contains "$dir/$_".  You are cd'ed
 189 #               to $dir when the function is called.  The function may
 190 #               set $prune to prune the tree.
 191 #
 192 # This library is primarily for find2perl, which, when fed
 193 #
 194 #   find2perl / -name .nfs\* -mtime +7 -exec rm -f {} \; -o -fstype nfs -prune
 195 #
 196 # spits out something like this
 197 #
 198 #       sub wanted {
 199 #           /^\.nfs.*$/ &&
 200 #           (($dev,$ino,$mode,$nlink,$uid,$gid) = lstat($_)) &&
 201 #           int(-M _) > 7 &&
 202 #           unlink($_)
 203 #           ||
 204 #           ($nlink || (($dev,$ino,$mode,$nlink,$uid,$gid) = lstat($_))) &&
 205 #           $dev < 0 &&
 206 #           ($prune = 1);
 207 #       }
 208
 209 sub finddepth {
 210     my $wanted = shift;
 211     $cwd = fastcwd();;
 212     foreach $topdir (@_) {
 213         (($topdev,$topino,$topmode,$topnlink) = stat($topdir))
 214           || (warn("Can't stat $topdir: $!\n"), next);
 215         if (-d _) {
 216             if (chdir($topdir)) {
 217                 ($fixtopdir = $topdir) =~ s,/$,, ;
 218                 $fixtopdir =~ s/\.dir$// if $Is_VMS;
 219                 &finddepthdir($wanted,$fixtopdir,$topnlink);
 220                 ($dir,$_) = ($fixtopdir,'.');
 221                 $name = $fixtopdir;
 222                 &$wanted;
 223             }
 224             else {
 225                 warn "Can't cd to $topdir: $!\n";
 226             }
 227         }
 228         else {
 229             unless (($dir,$_) = fileparse($topdir)) {
 230                 ($dir,$_) = ('.', $topdir);
 231             }
 232             chdir $dir && &$wanted;
 233         }
 234         chdir $cwd;
 235     }
 236 }
 237
 238 sub finddepthdir {
 239     my($wanted,$dir,$nlink) = @_;
 240     my($dev,$ino,$mode,$subcount);
 241     local($name); # so &wanted sees current value
 242
 243     # Get the list of files in the current directory.
 244
 245     opendir(DIR,'.') || warn "Can't open $dir: $!\n";
 246     my(@filenames) = readdir(DIR);
 247     closedir(DIR);
 248
 249     if ($nlink == 2 && !$dont_use_nlink) {   # This dir has no subdirectories.
 250         for (@filenames) {
 251             next if $_ eq '.';
 252             next if $_ eq '..';
 253             $name = "$dir/$_";
 254             $nlink = 0;
 255             &$wanted;
 256         }
 257     }
 258     else {                    # This dir has subdirectories.
 259         $subcount = $nlink - 2;
 260         for (@filenames) {
 261             next if $_ eq '.';
 262             next if $_ eq '..';
 263             $nlink = $prune = 0;
 264             $name = "$dir/$_";
 265             if ($subcount > 0 || $dont_use_nlink) {    # Seen all the subdirs?
 266
 267                 # Get link count and check for directoriness.
 268
 269                 ($dev,$ino,$mode,$nlink) = ($Is_VMS ? stat($_) : lstat($_));
 270
 271                 if (-d _) {
 272
 273                     # It really is a directory, so do it recursively.
 274
 275                     if (!$prune && chdir $_) {
 276                         $name =~ s/\.dir$// if $Is_VMS;
 277                         &finddepthdir($wanted,$name,$nlink);
 278                         chdir '..';
 279                     }
 280                     --$subcount;
 281                 }
 282             }
 283             &$wanted;
 284         }
 285     }
 286 }
 287
 288 if ($Config{'osname'} eq 'VMS') {
 289   $Is_VMS = 1;
 290   $dont_use_nlink = 1;
 291 }
 292
 293 1;
 294