home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / languages / perl / scripts-osu / ftw2.shar / ftw.pl
Encoding:
Perl Script  |  1991-03-03  |  1.6 KB  |  75 lines
  1. ## ftw.pl rev 4.0
  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.     $path = "" if $path eq "/"; # don't double the /!
  29.  
  30.     if ($nlink == 2) {
  31.         for (@filenames) {
  32.             do $fn("$path/$_");
  33.         }
  34.     } else {
  35.         for (@filenames) {
  36.             $_ = "$path/$_";
  37.             do $fn("$_"); # cannot pass $_ as lvalue
  38.             next unless ! -l $_ && -d _ && -r _ && -x _;
  39.             next if $dev != (stat(_))[$[+0]; # "-xdev"
  40.             &helper("$_"); # recurse if directory
  41.         }
  42.     }
  43. }
  44.  
  45. package ftw_root;
  46.  
  47. # &ftw_root("function-name")
  48. # calls &function-name("/file",stat("/file")) for each name
  49. # returned by the equivalent of "find / -fstype nfs -prune -o -print"
  50. # note that stat buffer _ is correct during the call (unlike &ftw() above)
  51.  
  52. sub main'ftw_root {
  53.     local($fn) = @_;
  54.     $fn =~ s/^([^']+)$/(caller)[$[]."'".$1/e;
  55.     local(@devlist) = ('/');
  56.     local($_);
  57.     while ($_ = shift @devlist) {
  58.         &main'ftw($_,"root_helper");
  59.     }
  60. }
  61.  
  62. sub root_helper {
  63.     local($file) = @_;
  64.     local(@s) = lstat($file);
  65.     return unless @s;
  66.     local($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
  67.         $atime,$mtime,$ctime,$blksize,$blocks) = @s;
  68.     if (($ino == 2) && ($dev > 0) && ($dev < 16384)) {
  69.         push(@devlist,$file);
  70.     }
  71.     do $fn("$file"); # don't pass $file as an lvalue
  72. }
  73.  
  74. 1;
  75.