home *** CD-ROM | disk | FTP | other *** search
/ The Datafile PD-CD 3 / PDCD_3.iso / languages / perl_5 / !Perl / Lib / File / pm / Find < prev    next >
Encoding:
Text File  |  1995-03-07  |  5.4 KB  |  238 lines
  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.  
  238.