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 @ISA = qw(Exporter);
   9 @EXPORT = qw(find finddepth $name $dir);
  10
  11 # Usage:
  12 #       use File::Find;
  13 #
  14 #       find(\&wanted, '/foo','/bar');
  15 #
  16 #       sub wanted { ... }
  17 #               where wanted does whatever you want.  $dir contains the
  18 #               current directory name, and $_ the current filename within
  19 #               that directory.  $name contains "$dir/$_".  You are cd'ed
  20 #               to $dir when the function is called.  The function may
  21 #               set $prune to prune the tree.
  22 #
  23 # This library is primarily for find2perl, which, when fed
  24 #
  25 #   find2perl / -name .nfs\* -mtime +7 -exec rm -f {} \; -o -fstype nfs -prune
  26 #
  27 # spits out something like this
  28 #
  29 #       sub wanted {
  30 #           /^\.nfs.*$/ &&
  31 #           (($dev,$ino,$mode,$nlink,$uid,$gid) = lstat($_)) &&
  32 #           int(-M _) > 7 &&
  33 #           unlink($_)
  34 #           ||
  35 #           ($nlink || (($dev,$ino,$mode,$nlink,$uid,$gid) = lstat($_))) &&
  36 #           $dev < 0 &&
  37 #           ($prune = 1);
  38 #       }
  39 #
  40 # Set the variable $dont_use_nlink if you're using AFS, since AFS cheats.
  41
  42 sub find {
  43     my $wanted = shift;
  44     my $cwd = fastcwd();
  45     foreach $topdir (@_) {
  46         (($topdev,$topino,$topmode,$topnlink) = stat($topdir))
  47           || (warn("Can't stat $topdir: $!\n"), next);
  48         if (-d _) {
  49             if (chdir($topdir)) {
  50                 ($dir,$_) = ($topdir,'.');
  51                 $name = $topdir;
  52                 &$wanted;
  53                 ($fixtopdir = $topdir) =~ s,/$,, ;
  54                 $fixtopdir =~ s/\.dir$// if $Is_VMS; ;
  55                 &finddir($wanted,$fixtopdir,$topnlink);
  56             }
  57             else {
  58                 warn "Can't cd to $topdir: $!\n";
  59             }
  60         }
  61         else {
  62             unless (($dir,$_) = fileparse($topdir)) {
  63                 ($dir,$_) = ('.', $topdir);
  64             }
  65             $name = $topdir;
  66             chdir $dir && &$wanted;
  67         }
  68         chdir $cwd;
  69     }
  70 }
  71
  72 sub finddir {
  73     local($wanted,$dir,$nlink) = @_;
  74     local($dev,$ino,$mode,$subcount);
  75     local($name);
  76
  77     # Get the list of files in the current directory.
  78
  79     opendir(DIR,'.') || (warn "Can't open $dir: $!\n", return);
  80     local(@filenames) = readdir(DIR);
  81     closedir(DIR);
  82
  83     if ($nlink == 2 && !$dont_use_nlink) {  # This dir has no subdirectories.
  84         for (@filenames) {
  85             next if $_ eq '.';
  86             next if $_ eq '..';
  87             $name = "$dir/$_";
  88             $nlink = 0;
  89             &$wanted;
  90         }
  91     }
  92     else {                    # This dir has subdirectories.
  93         $subcount = $nlink - 2;
  94         for (@filenames) {
  95             next if $_ eq '.';
  96             next if $_ eq '..';
  97             $nlink = $prune = 0;
  98             $name = "$dir/$_";
  99             &$wanted;
 100             if ($subcount > 0 || $dont_use_nlink) {    # Seen all the subdirs?
 101
 102                 # Get link count and check for directoriness.
 103
 104                 ($dev,$ino,$mode,$nlink) = ($Is_VMS ? stat($_) : lstat($_))
 105                     unless ($nlink || $dont_use_nlink);
 106
 107                 if (-d _) {
 108
 109                     # It really is a directory, so do it recursively.
 110
 111                     if (!$prune && chdir $_) {
 112                         $name =~ s/\.dir$// if $Is_VMS;
 113                         &finddir($wanted,$name,$nlink);
 114                         chdir '..';
 115                     }
 116                     --$subcount;
 117                 }
 118             }
 119         }
 120     }
 121 }
 122
 123 # Usage:
 124 #       use File::Find;
 125 #
 126 #       finddepth(\&wanted, '/foo','/bar');
 127 #
 128 #       sub wanted { ... }
 129 #               where wanted does whatever you want.  $dir contains the
 130 #               current directory name, and $_ the current filename within
 131 #               that directory.  $name contains "$dir/$_".  You are cd'ed
 132 #               to $dir when the function is called.  The function may
 133 #               set $prune to prune the tree.
 134 #
 135 # This library is primarily for find2perl, which, when fed
 136 #
 137 #   find2perl / -name .nfs\* -mtime +7 -exec rm -f {} \; -o -fstype nfs -prune
 138 #
 139 # spits out something like this
 140 #
 141 #       sub wanted {
 142 #           /^\.nfs.*$/ &&
 143 #           (($dev,$ino,$mode,$nlink,$uid,$gid) = lstat($_)) &&
 144 #           int(-M _) > 7 &&
 145 #           unlink($_)
 146 #           ||
 147 #           ($nlink || (($dev,$ino,$mode,$nlink,$uid,$gid) = lstat($_))) &&
 148 #           $dev < 0 &&
 149 #           ($prune = 1);
 150 #       }
 151
 152 sub finddepth {
 153     my $wanted = shift;
 154     $cwd = fastcwd();;
 155     foreach $topdir (@_) {
 156         (($topdev,$topino,$topmode,$topnlink) = stat($topdir))
 157           || (warn("Can't stat $topdir: $!\n"), next);
 158         if (-d _) {
 159             if (chdir($topdir)) {
 160                 ($fixtopdir = $topdir) =~ s,/$,, ;
 161                 $fixtopdir =~ s/\.dir$// if $Is_VMS;
 162                 &finddepthdir($wanted,$fixtopdir,$topnlink);
 163                 ($dir,$_) = ($fixtopdir,'.');
 164                 $name = $fixtopdir;
 165                 &$wanted;
 166             }
 167             else {
 168                 warn "Can't cd to $topdir: $!\n";
 169             }
 170         }
 171         else {
 172             unless (($dir,$_) = fileparse($topdir)) {
 173                 ($dir,$_) = ('.', $topdir);
 174             }
 175             chdir $dir && &$wanted;
 176         }
 177         chdir $cwd;
 178     }
 179 }
 180
 181 sub finddepthdir {
 182     my($wanted,$dir,$nlink) = @_;
 183     my($dev,$ino,$mode,$subcount);
 184     my($name);
 185
 186     # Get the list of files in the current directory.
 187
 188     opendir(DIR,'.') || warn "Can't open $dir: $!\n";
 189     my(@filenames) = readdir(DIR);
 190     closedir(DIR);
 191
 192     if ($nlink == 2 && !$dont_use_nlink) {   # This dir has no subdirectories.
 193         for (@filenames) {
 194             next if $_ eq '.';
 195             next if $_ eq '..';
 196             $name = "$dir/$_";
 197             $nlink = 0;
 198             &$wanted;
 199         }
 200     }
 201     else {                    # This dir has subdirectories.
 202         $subcount = $nlink - 2;
 203         for (@filenames) {
 204             next if $_ eq '.';
 205             next if $_ eq '..';
 206             $nlink = $prune = 0;
 207             $name = "$dir/$_";
 208             if ($subcount > 0 || $dont_use_nlink) {    # Seen all the subdirs?
 209
 210                 # Get link count and check for directoriness.
 211
 212                 ($dev,$ino,$mode,$nlink) = ($Is_VMS ? stat($_) : lstat($_));
 213
 214                 if (-d _) {
 215
 216                     # It really is a directory, so do it recursively.
 217
 218                     if (!$prune && chdir $_) {
 219                         $name =~ s/\.dir$// if $Is_VMS;
 220                         &finddepthdir($wanted,$name,$nlink);
 221                         chdir '..';
 222                     }
 223                     --$subcount;
 224                 }
 225             }
 226             &$wanted;
 227         }
 228     }
 229 }
 230
 231 if ($Config{'osname'} eq 'VMS') {
 232   $Is_VMS = 1;
 233   $dont_use_nlink = 1;
 234 }
 235
 236 1;
 237