home *** CD-ROM | disk | FTP | other *** search
/ CLIX - Fazer Clix Custa Nix / CLIX-CD.cdr / mac / lib / File / Find.pm < prev    next >
Text File  |  1998-01-12  |  7KB  |  297 lines
  1. package File::Find;
  2. require 5.000;
  3. require Exporter;
  4. use 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:x','bar:y');
  19.     sub wanted { ... }
  20.     
  21.     use File::Find;
  22.     finddepth(\&wanted, 'foo:x','bar:y');
  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. File::Find assumes that you don't alter the $_ variable.  If you do then
  35. make sure you return it to its original value before exiting your function.
  36.  
  37. This library is primarily for the C<find2perl> tool, which when fed, 
  38.  
  39.     find2perl / -name .nfs\* -mtime +7 \
  40.     -exec rm -f {} \; -o -fstype nfs -prune
  41.  
  42. produces something like:
  43.  
  44.     sub wanted {
  45.         /^\.nfs.*$/ &&
  46.         (($dev,$ino,$mode,$nlink,$uid,$gid) = lstat($_)) &&
  47.         int(-M _) > 7 &&
  48.         unlink($_)
  49.         ||
  50.         ($nlink || (($dev,$ino,$mode,$nlink,$uid,$gid) = lstat($_))) &&
  51.         $dev < 0 &&
  52.         ($File::Find::prune = 1);
  53.     }
  54.  
  55. Set the variable $File::Find::dont_use_nlink if you're using AFS,
  56. since AFS cheats.
  57.  
  58. C<finddepth> is just like C<find>, except that it does a depth-first
  59. search.
  60.  
  61. Here's another interesting wanted function.  It will find all symlinks
  62. that don't resolve:
  63.  
  64.     sub wanted {
  65.     -l && !-e && print "bogus link: $File::Find::name\n";
  66.     } 
  67.  
  68. =cut
  69.  
  70. @ISA = qw(Exporter);
  71. @EXPORT = qw(find finddepth);
  72.  
  73.  
  74. sub find {
  75.     my $wanted = shift;
  76.     my $cwd = Cwd::cwd();
  77.     # Localize these rather than lexicalizing them for backwards
  78.     # compatibility.
  79.     local($topdir,$topdev,$topino,$topmode,$topnlink);
  80.     foreach $topdir (@_) {
  81.     (($topdev,$topino,$topmode,$topnlink) = stat($topdir))
  82.       || (warn("Can't stat $topdir: $!\n"), next);
  83.     if (-d _) {
  84.         if (chdir($topdir)) {
  85.         ($dir,$_) = ($topdir, $current_dir);
  86.         $name = $topdir;
  87.         &$wanted;
  88.         my $fixtopdir = $topdir;
  89.         if ($Is_MacOS) {
  90.             $fixtopdir = ":$fixtopdir:" unless $fixtopdir =~ /:/;
  91.                 $fixtopdir .= ":" unless $fixtopdir =~ /:$/;
  92.         } else {
  93.                 $fixtopdir =~ s,/$,, ;
  94.             $fixtopdir =~ s/\.dir$// if $Is_VMS;
  95.             $fixtopdir =~ s/\\dir$// if $Is_NT;
  96.         }
  97.         &finddir($wanted,$fixtopdir,$topnlink);
  98.         }
  99.         else {
  100.         warn "Can't cd to $topdir: $!\n";
  101.         }
  102.     }
  103.     else {
  104.         unless (($_,$dir) = File::Basename::fileparse($topdir)) {
  105.         ($dir,$_) = ($current_dir, $topdir);
  106.         }
  107.         $name = $topdir;
  108.         chdir $dir && &$wanted;
  109.     }
  110.     chdir $cwd;
  111.     }
  112. }
  113.  
  114. sub finddir {
  115.     my($wanted, $nlink);
  116.     local($dir, $name);
  117.     ($wanted, $dir, $nlink) = @_;
  118.  
  119.     my($dev, $ino, $mode, $subcount);
  120.  
  121.     # Get the list of files in the current directory.
  122.     opendir(DIR,$current_dir) || (warn "Can't open $dir: $!\n", return);
  123.     my(@filenames) = readdir(DIR);
  124.     closedir(DIR);
  125.  
  126.     if ($nlink == 2 && !$dont_use_nlink) {  # This dir has no subdirectories.
  127.     for (@filenames) {
  128.         next if $_ eq '.';
  129.         next if $_ eq '..';
  130.         $name = "$dir/$_";
  131.         $nlink = 0;
  132.         &$wanted;
  133.     }
  134.     }
  135.     else {                    # This dir has subdirectories.
  136.     $subcount = $nlink - 2;
  137.     for (@filenames) {
  138.         if ($Is_MacOS) {
  139.             $name = "$dir$_";
  140.         } else {
  141.             next if $_ eq '.';
  142.             next if $_ eq '..';
  143.             $name = "$dir/$_";
  144.         }
  145.         $nlink = $prune = 0;
  146.         &$wanted;
  147.         if ($subcount > 0 || $dont_use_nlink) {    # Seen all the subdirs?
  148.  
  149.         # Get link count and check for directoriness.
  150.  
  151.         ($dev,$ino,$mode,$nlink) = ($Is_VMS ? stat($_) : lstat($_));
  152.             # unless ($nlink || $dont_use_nlink);
  153.         
  154.         if (-d _) {
  155.  
  156.             # It really is a directory, so do it recursively.
  157.  
  158.             if (!$prune && chdir $_) {
  159.             $name =~ s/\.dir$// if $Is_VMS;
  160.             $name =~ s/\\dir$// if $Is_NT;
  161.             &finddir($wanted,"$name:",$nlink);
  162.             chdir $up_dir;
  163.             }
  164.             --$subcount;
  165.         }
  166.         }
  167.     }
  168.     }
  169. }
  170.  
  171.  
  172. sub finddepth {
  173.     my $wanted = shift;
  174.  
  175.     $cwd = Cwd::fastcwd();;
  176.  
  177.     # Localize these rather than lexicalizing them for backwards
  178.     # compatibility.
  179.     local($topdir, $topdev, $topino, $topmode, $topnlink);
  180.     foreach $topdir (@_) {
  181.     (($topdev,$topino,$topmode,$topnlink) = stat($topdir))
  182.       || (warn("Can't stat $topdir: $!\n"), next);
  183.     if (-d _) {
  184.         if (chdir($topdir)) {
  185.         my $fixtopdir = $topdir;
  186.         if ($Is_MacOS) {
  187.             $fixtopdir = ":$fixtopdir:" unless $fixtopdir =~ /:/;
  188.                 $fixtopdir .= ":" unless $fixtopdir =~ /:$/;
  189.         } else {
  190.             $fixtopdir =~ s,/$,, ;
  191.             $fixtopdir =~ s/\.dir$// if $Is_VMS;
  192.             $fixtopdir =~ s/\\dir$// if $Is_NT;
  193.         }
  194.         &finddepthdir($wanted,$fixtopdir,$topnlink);
  195.         ($dir,$_) = ($fixtopdir,$current_dir);
  196.         $name = $fixtopdir;
  197.         &$wanted;
  198.         }
  199.         else {
  200.         warn "Can't cd to $topdir: $!\n";
  201.         }
  202.     }
  203.     else {
  204.         unless (($_,$dir) = File::Basename::fileparse($topdir)) {
  205.         ($dir,$_) = ($current_dir, $topdir);
  206.         }
  207.         chdir $dir && &$wanted;
  208.     }
  209.     chdir $cwd;
  210.     }
  211. }
  212.  
  213. sub finddepthdir {
  214.     my($wanted, $nlink);
  215.     local($dir, $name);
  216.     ($wanted,$dir,$nlink) = @_;
  217.     my($dev, $ino, $mode, $subcount);
  218.  
  219.     # Get the list of files in the current directory.
  220.     opendir(DIR,$current_dir) || warn "Can't open $dir: $!\n";
  221.     my(@filenames) = readdir(DIR);
  222.     closedir(DIR);
  223.  
  224.     if ($nlink == 2 && !$dont_use_nlink) {   # This dir has no subdirectories.
  225.     for (@filenames) {
  226.         next if $_ eq '.';
  227.         next if $_ eq '..';
  228.         $name = "$dir/$_";
  229.         $nlink = 0;
  230.         &$wanted;
  231.     }
  232.     }
  233.     else {                    # This dir has subdirectories.
  234.     $subcount = $nlink - 2;
  235.     for (@filenames) {
  236.         if ($Is_MacOS) {
  237.             $name = "$dir$_";
  238.         } else {
  239.             next if $_ eq '.';
  240.             next if $_ eq '..';
  241.             $name = "$dir/$_";
  242.         }
  243.         $nlink = 0;
  244.         if ($subcount > 0 || $dont_use_nlink) {    # Seen all the subdirs?
  245.  
  246.         # Get link count and check for directoriness.
  247.  
  248.         ($dev,$ino,$mode,$nlink) = ($Is_VMS ? stat($_) : lstat($_));
  249.         
  250.         if (-d _) {
  251.  
  252.             # It really is a directory, so do it recursively.
  253.  
  254.             if (chdir $_) {
  255.             $name =~ s/\.dir$// if $Is_VMS;
  256.             $name =~ s/\\dir$// if $Is_NT;
  257.             &finddepthdir($wanted,"$name:",$nlink);
  258.             chdir $up_dir;
  259.             }
  260.             --$subcount;
  261.         }
  262.         }
  263.         &$wanted;
  264.     }
  265.     }
  266. }
  267.  
  268. # Set dont_use_nlink in your hint file if your system's stat doesn't
  269. # report the number of links in a directory as an indication
  270. # of the number of files.
  271. # See, e.g. hints/machten.sh for MachTen 2.2.
  272. $dont_use_nlink = 1 if ($Config::Config{'dont_use_nlink'});
  273. $current_dir = '.';
  274. $up_dir = '..';
  275.  
  276. # These are hard-coded for now, but may move to hint files.
  277. if ($^O eq 'VMS') {
  278.   $Is_VMS = 1;
  279.   $dont_use_nlink = 1;
  280. }
  281. if ($^O eq 'MacOS') {
  282.   $Is_MacOS = 1;
  283.   $dont_use_nlink = 1;
  284.   $current_dir = ':';
  285.   $up_dir = '::';
  286. }
  287. if ($^O =~ m:^mswin32:i) {
  288.   $Is_NT = 1;
  289.   $dont_use_nlink = 1;
  290. }
  291.  
  292. $dont_use_nlink = 1
  293.     if $^O eq 'os2' || $^O eq 'msdos' || $^O eq 'amigaos';
  294.  
  295. 1;
  296.  
  297.