home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / languages / perl / scripts-osu / ftw.shar / ftw2.pl < prev   
Encoding:
Perl Script  |  1991-02-25  |  1.6 KB  |  73 lines
  1. ## ftw.pl rev 4.0alpha
  2.  
  3. package ftw;
  4.  
  5. # &ftw("path","function-name")
  6. # calls &function-name("path/file") for each name returned by the
  7. # equivalent of "find path -xdev -print"
  8.  
  9. sub main'ftw {
  10.     local($path, $fn) = @_;
  11.  
  12.     $fn =~ s/^([^']+)$/(caller)[$[]."'".$1/e;
  13.     if (-d $path) {
  14.         &helper($path);
  15.     } elsif (-e $path) {
  16.         do $fn("$path");
  17.     }
  18. }
  19.  
  20. sub helper {
  21.     local($path) = @_;
  22.  
  23.     local($dev, $ino, $mode, $nlink) = stat($path);
  24.     local($_,*DIR);
  25.     opendir(DIR,$path) || die "Cannot open $DIR ($!)";
  26.     local(@filenames) = sort grep(!/^\.\.?$/, readdir(DIR));
  27.     closedir(DIR);
  28.  
  29.     if ($nlink == 2) {
  30.         for (@filenames) {
  31.             do $fn("$path/$_");
  32.         }
  33.     } else {
  34.         for (@filenames) {
  35.             $_ = "$path/$_";
  36.             do $fn("$_"); # cannot pass $_ as lvalue
  37.             next unless ! -l $_ && -d _ && -r _ && -x _;
  38.             next if $dev != (stat(_))[$[+0]; # "-xdev"
  39.             &helper("$_"); # recurse if directory
  40.         }
  41.     }
  42. }
  43.  
  44. package ftw_root;
  45.  
  46. # &ftw_root("function-name")
  47. # calls &function-name("/file",stat("/file")) for each name
  48. # returned by the equivalent of "find / -fstype nfs -prune -o -print"
  49. # note that stat buffer _ is correct during the call (unlike &ftw() above)
  50.  
  51. sub main'ftw_root {
  52.     local($fn) = @_;
  53.     local($devlist) = ('/');
  54.     local($_);
  55.     while ($_ = shift @devlist) {
  56.         &ftw($_,"root_helper");
  57.     }
  58. }
  59.  
  60. sub root_helper {
  61.     local($file) = @_;
  62.     local(@s) = lstat($file);
  63.     return unless @s;
  64.     local($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
  65.         $atime,$mtime,$ctime,$blksize,$blocks) = @s;
  66.     if (($ino == 2) && ($dev > 0) && ($dev < 16384)) {
  67.         push(@devlist,$file);
  68.     }
  69.     do $fn("$file"); # don't pass $file as an lvalue
  70. }
  71.  
  72. 1;
  73.