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