home *** CD-ROM | disk | FTP | other *** search
/ Acorn User 10 / AU_CD10.iso / Updates / Perl / Non-RPC / !Perl / lib / zip / File / Find.pm < prev    next >
Text File  |  1999-04-02  |  6KB  |  239 lines
  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.     my $is_RISCOS_native = 0;
  94.     if ($Is_RISCOS) { $is_RISCOS_native = !RISCOS::Filespec::convert(); }
  95.     foreach $topdir (@_) {
  96.     (($topdev,$topino,$topmode,$topnlink) =
  97.       ($Is_VMS ? stat($topdir) : lstat($topdir)))
  98.       || (warn("Can't stat $topdir: $!\n"), next);
  99.     if (-d _) {
  100.         if (chdir($topdir)) {
  101.         $prune = 0;
  102.         unless ($bydepth) {
  103.           ($dir,$_) = ($topdir,'.');
  104.           $name = $topdir;
  105.           $wanted->{wanted}->();
  106.         }
  107.         next if $prune;
  108.         my $fixtopdir = $topdir;
  109.         $fixtopdir =~ s,/$,, ;
  110.         $fixtopdir =~ s/\.dir$// if $Is_VMS;
  111.         &finddir($wanted,$fixtopdir,$topnlink, $bydepth);
  112.         if ($bydepth) {
  113.           ($dir,$_) = ($fixtopdir,'.');
  114.           $name = $fixtopdir;
  115.           $wanted->{wanted}->();
  116.         }
  117.         }
  118.         else {
  119.         warn "Can't cd to $topdir: $!\n";
  120.         }
  121.     }
  122.     else {
  123.         require File::Basename;
  124.         unless (($_,$dir) = File::Basename::fileparse($topdir)) {
  125.         ($dir,$_) = ('.', $topdir);
  126.         }
  127.         if (chdir($dir)) {
  128.         $name = $topdir;
  129.         $wanted->{wanted}->();
  130.         }
  131.         else {
  132.         warn "Can't cd to $dir: $!\n";
  133.         }
  134.     }
  135.     chdir $cwd;
  136.     }
  137. }
  138.  
  139. sub finddir {
  140.     my($wanted, $nlink, $bydepth);
  141.     local($dir, $name);
  142.     ($wanted, $dir, $nlink, $bydepth) = @_;
  143.  
  144.     my($dev, $ino, $mode, $subcount);
  145.  
  146.     # Get the list of files in the current directory.
  147.     opendir(DIR,'.') || (warn("Can't open $dir: $!\n"), $bydepth || return);
  148.     my(@filenames) = readdir(DIR);
  149.     closedir(DIR);
  150.  
  151.     if ($nlink == 2 && !$dont_use_nlink) {  # This dir has no subdirectories.
  152.     for (@filenames) {
  153.         next if $_ eq '.';
  154.         next if $_ eq '..';
  155.         $name = "$dir/$_";
  156.         $nlink = 0;
  157.         $wanted->{wanted}->();
  158.     }
  159.     }
  160.     else {              # This dir has subdirectories.
  161.     $subcount = $nlink - 2;
  162.     for (@filenames) {
  163.         next if $_ eq '.';
  164.         next if $_ eq '..';
  165.         $nlink = 0;
  166.         $prune = 0 unless $bydepth;
  167.         $name = "$dir/$_";
  168.         $wanted->{wanted}->() unless $bydepth;
  169.         if ($subcount > 0 || $dont_use_nlink) {    # Seen all the subdirs?
  170.  
  171.         # Get link count and check for directoriness.
  172.  
  173.         ($dev,$ino,$mode,$nlink) = ($Is_VMS ? stat($_) : lstat($_));
  174.             # unless ($nlink || $dont_use_nlink);
  175.  
  176.         if (-d _) {
  177.  
  178.             # It really is a directory, so do it recursively.
  179.  
  180.             --$subcount;
  181.             next if $prune;
  182.             # Untaint $_, so that we can do a chdir
  183.             $_ = $1 if /^(.*)/;
  184.             if (chdir $_) {
  185.             $name =~ s/\.dir$// if $Is_VMS;
  186.             &finddir($wanted,$name,$nlink, $bydepth);
  187.             chdir '..';
  188.             }
  189.             else {
  190.             warn "Can't cd to $_: $!\n";
  191.             }
  192.         }
  193.         }
  194.         $wanted->{wanted}->() if $bydepth;
  195.     }
  196.     }
  197. }
  198.  
  199. sub wrap_wanted {
  200.   my $wanted = shift;
  201.   ref($wanted) eq 'HASH' ? $wanted : { wanted => $wanted };
  202. }
  203.  
  204. sub find {
  205.   my $wanted = shift;
  206.   find_opt(wrap_wanted($wanted), @_);
  207. }
  208.  
  209. sub finddepth {
  210.   my $wanted = wrap_wanted(shift);
  211.   $wanted->{bydepth} = 1;
  212.   find_opt($wanted, @_);
  213. }
  214.  
  215. # These are hard-coded for now, but may move to hint files.
  216. if ($^O eq 'VMS') {
  217.   $Is_VMS = 1;
  218.   $dont_use_nlink = 1;
  219. }
  220. if ($^O eq 'riscos') {
  221.   $Is_RISCOS = 1;
  222.   $dont_use_nlink = 1;
  223. }
  224.  
  225. $dont_use_nlink = 1
  226.     if $^O eq 'os2' || $^O eq 'dos' || $^O eq 'amigaos' || $^O eq 'MSWin32';
  227.  
  228. # Set dont_use_nlink in your hint file if your system's stat doesn't
  229. # report the number of links in a directory as an indication
  230. # of the number of files.
  231. # See, e.g. hints/machten.sh for MachTen 2.2.
  232. unless ($dont_use_nlink) {
  233.   require Config;
  234.   $dont_use_nlink = 1 if ($Config::Config{'dont_use_nlink'});
  235. }
  236.  
  237. 1;
  238.  
  239.