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 # Usage:
  67 #       use File::Find;
  68 #
  69 #       find(\&wanted, '/foo','/bar');
  70 #
  71 #       sub wanted { ... }
  72 #               where wanted does whatever you want.  $dir contains the
  73 #               current directory name, and $_ the current filename within
  74 #               that directory.  $name contains "$dir/$_".  You are cd'ed
  75 #               to $dir when the function is called.  The function may
  76 #               set $prune to prune the tree.
  77 #
  78 # This library is primarily for find2perl, which, when fed
  79 #
  80 #   find2perl / -name .nfs\* -mtime +7 -exec rm -f {} \; -o -fstype nfs -prune
  81 #
  82 # spits out something like this
  83 #
  84 #       sub wanted {
  85 #           /^\.nfs.*$/ &&
  86 #           (($dev,$ino,$mode,$nlink,$uid,$gid) = lstat($_)) &&
  87 #           int(-M _) > 7 &&
  88 #           unlink($_)
  89 #           ||
  90 #           ($nlink || (($dev,$ino,$mode,$nlink,$uid,$gid) = lstat($_))) &&
  91 #           $dev < 0 &&
  92 #           ($prune = 1);
  93 #       }
  94 #
  95 # Set the variable $dont_use_nlink if you're using AFS, since AFS cheats.
  96
  97 sub find {
  98     my $wanted = shift;
  99     my $cwd = fastcwd();
 100     foreach $topdir (@_) {
 101         (($topdev,$topino,$topmode,$topnlink) = stat($topdir))
 102           || (warn("Can't stat $topdir: $!\n"), next);
 103         if (-d _) {
 104             if (chdir($topdir)) {
 105                 ($dir,$_) = ($topdir,'.');
 106                 $name = $topdir;
 107                 &$wanted;
 108                 ($fixtopdir = $topdir) =~ s,/$,, ;
 109                 $fixtopdir =~ s/\.dir$// if $Is_VMS; ;
 110                 &finddir($wanted,$fixtopdir,$topnlink);
 111             }
 112             else {
 113                 warn "Can't cd to $topdir: $!\n";
 114             }
 115         }
 116         else {
 117             unless (($dir,$_) = fileparse($topdir)) {
 118                 ($dir,$_) = ('.', $topdir);
 119             }
 120             $name = $topdir;
 121             chdir $dir && &$wanted;
 122         }
 123         chdir $cwd;
 124     }
 125 }
 126
 127 sub finddir {
 128     local($wanted,$dir,$nlink) = @_;
 129     local($dev,$ino,$mode,$subcount);
 130     local($name);
 131
 132     # Get the list of files in the current directory.
 133
 134     opendir(DIR,'.') || (warn "Can't open $dir: $!\n", return);
 135     local(@filenames) = readdir(DIR);
 136     closedir(DIR);
 137
 138     if ($nlink == 2 && !$dont_use_nlink) {  # This dir has no subdirectories.
 139         for (@filenames) {
 140             next if $_ eq '.';
 141             next if $_ eq '..';
 142             $name = "$dir/$_";
 143             $nlink = 0;
 144             &$wanted;
 145         }
 146     }
 147     else {                    # This dir has subdirectories.
 148         $subcount = $nlink - 2;
 149         for (@filenames) {
 150             next if $_ eq '.';
 151             next if $_ eq '..';
 152             $nlink = $prune = 0;
 153             $name = "$dir/$_";
 154             &$wanted;
 155             if ($subcount > 0 || $dont_use_nlink) {    # Seen all the subdirs?
 156
 157                 # Get link count and check for directoriness.
 158
 159                 ($dev,$ino,$mode,$nlink) = ($Is_VMS ? stat($_) : lstat($_))
 160                     unless ($nlink || $dont_use_nlink);
 161
 162                 if (-d _) {
 163
 164                     # It really is a directory, so do it recursively.
 165
 166                     if (!$prune && chdir $_) {
 167                         $name =~ s/\.dir$// if $Is_VMS;
 168                         &finddir($wanted,$name,$nlink);
 169                         chdir '..';
 170                     }
 171                     --$subcount;
 172                 }
 173             }
 174         }
 175     }
 176 }
 177
 178 # Usage:
 179 #       use File::Find;
 180 #
 181 #       finddepth(\&wanted, '/foo','/bar');
 182 #
 183 #       sub wanted { ... }
 184 #               where wanted does whatever you want.  $dir contains the
 185 #               current directory name, and $_ the current filename within
 186 #               that directory.  $name contains "$dir/$_".  You are cd'ed
 187 #               to $dir when the function is called.  The function may
 188 #               set $prune to prune the tree.
 189 #
 190 # This library is primarily for find2perl, which, when fed
 191 #
 192 #   find2perl / -name .nfs\* -mtime +7 -exec rm -f {} \; -o -fstype nfs -prune
 193 #
 194 # spits out something like this
 195 #
 196 #       sub wanted {
 197 #           /^\.nfs.*$/ &&
 198 #           (($dev,$ino,$mode,$nlink,$uid,$gid) = lstat($_)) &&
 199 #           int(-M _) > 7 &&
 200 #           unlink($_)
 201 #           ||
 202 #           ($nlink || (($dev,$ino,$mode,$nlink,$uid,$gid) = lstat($_))) &&
 203 #           $dev < 0 &&
 204 #           ($prune = 1);
 205 #       }
 206
 207 sub finddepth {
 208     my $wanted = shift;
 209     $cwd = fastcwd();;
 210     foreach $topdir (@_) {
 211         (($topdev,$topino,$topmode,$topnlink) = stat($topdir))
 212           || (warn("Can't stat $topdir: $!\n"), next);
 213         if (-d _) {
 214             if (chdir($topdir)) {
 215                 ($fixtopdir = $topdir) =~ s,/$,, ;
 216                 $fixtopdir =~ s/\.dir$// if $Is_VMS;
 217                 &finddepthdir($wanted,$fixtopdir,$topnlink);
 218                 ($dir,$_) = ($fixtopdir,'.');
 219                 $name = $fixtopdir;
 220                 &$wanted;
 221             }
 222             else {
 223                 warn "Can't cd to $topdir: $!\n";
 224             }
 225         }
 226         else {
 227             unless (($dir,$_) = fileparse($topdir)) {
 228                 ($dir,$_) = ('.', $topdir);
 229             }
 230             chdir $dir && &$wanted;
 231         }
 232         chdir $cwd;
 233     }
 234 }
 235
 236 sub finddepthdir {
 237     my($wanted,$dir,$nlink) = @_;
 238     my($dev,$ino,$mode,$subcount);
 239     my($name);
 240
 241     # Get the list of files in the current directory.
 242
 243     opendir(DIR,'.') || warn "Can't open $dir: $!\n";
 244     my(@filenames) = readdir(DIR);
 245     closedir(DIR);
 246
 247     if ($nlink == 2 && !$dont_use_nlink) {   # This dir has no subdirectories.
 248         for (@filenames) {
 249             next if $_ eq '.';
 250             next if $_ eq '..';
 251             $name = "$dir/$_";
 252             $nlink = 0;
 253             &$wanted;
 254         }
 255     }
 256     else {                    # This dir has subdirectories.
 257         $subcount = $nlink - 2;
 258         for (@filenames) {
 259             next if $_ eq '.';
 260             next if $_ eq '..';
 261             $nlink = $prune = 0;
 262             $name = "$dir/$_";
 263             if ($subcount > 0 || $dont_use_nlink) {    # Seen all the subdirs?
 264
 265                 # Get link count and check for directoriness.
 266
 267                 ($dev,$ino,$mode,$nlink) = ($Is_VMS ? stat($_) : lstat($_));
 268
 269                 if (-d _) {
 270
 271                     # It really is a directory, so do it recursively.
 272
 273                     if (!$prune && chdir $_) {
 274                         $name =~ s/\.dir$// if $Is_VMS;
 275                         &finddepthdir($wanted,$name,$nlink);
 276                         chdir '..';
 277                     }
 278                     --$subcount;
 279                 }
 280             }
 281             &$wanted;
 282         }
 283     }
 284 }
 285
 286 if ($Config{'osname'} eq 'VMS') {
 287   $Is_VMS = 1;
 288   $dont_use_nlink = 1;
 289 }
 290
 291 1;
 292