home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / languages / perl / scripts-osu / ftw.shar / ftw.pl next >
Encoding:
Text File  |  1991-02-25  |  2.1 KB  |  98 lines
  1. ## ftw.pl rev 3.0
  2.  
  3. # &ftw("path","function-name")
  4. # calls &function-name("path/file") for each name returned by the
  5. # equivalent of "find path -xdev -print"
  6.  
  7. sub ftw {
  8.     local($path, $fn) = @_;
  9.     local(*CHILD);
  10.     local($preslash) = $/;
  11.     local($/);
  12.     local($_);
  13.     # flushing STDOUT:
  14.     local($preselect) = select(STDOUT);
  15.     local($prepipe) = $|;
  16.     $| = 1;
  17.     print "";
  18.     $| = $prepipe;
  19.     select($preselect);
  20.     # end flushing STDOUT
  21.     $CHILD = open(CHILD,'-|');
  22.     die "ftw: Cannot fork ($!)" unless defined $CHILD;
  23.     unless ($CHILD) { # I am the child
  24.         $| = 1; # don't buffer stdout
  25.         chdir $path || die "Cannot cd to $path ($!)";
  26.         &ftw'helper($path);
  27.         exit 0;
  28.     }
  29.     # I am the parent
  30.     $/ = "\000";
  31.     while (<CHILD>) {
  32.         chop;
  33.         {
  34.              local($/) = $preslash;
  35.             do $fn("".$_);
  36.         }
  37.     }
  38.     close(CHILD);
  39. }
  40.  
  41. sub ftw'helper {
  42.     # expects to be cd'ed to $DIR
  43.     local(*DIR); ($DIR) = @_;
  44.     $DIR = "" if $DIR eq "/"; # no "//..."!
  45.     local($dev, $ino, $mode, $nlink) = stat('.');
  46.     local($_,$name);
  47.  
  48.     opendir(DIR,'.') || die "Cannot open $DIR ($!)";
  49.     local(@filenames) = sort readdir(DIR);
  50.     closedir(DIR);
  51.  
  52.     if ($nlink == 2) {
  53.         print grep(!/^\.\.?$/ && s#[^\000]+#$DIR/$&\000#, @filenames);
  54.     } else {
  55.         for (@filenames) {
  56.             next if /^\.\.?$/;
  57.             $name = "$DIR/$_";
  58.             print $name,"\000";
  59.             next unless ! -l $_ && -d _ && -r _ && -x _;
  60.             next if $dev != (stat(_))[$[+0]; # "-xdev"
  61.             unless (chdir $_) {
  62.                 warn "Cannot chdir to $name ($!)";
  63.                 next;
  64.             }
  65.             &ftw'helper($name);
  66.             chdir '..';
  67.         }
  68.     }
  69. }
  70.  
  71. # &ftw_root("function-name")
  72. # calls &function-name("/file",stat("/file")) for each name
  73. # returned by the equivalent of "find / -fstype nfs -prune -o -print"
  74. # note that stat buffer _ is correct during the call (unlike &ftw() above)
  75.  
  76. sub ftw_root {
  77.     local($ftw_root'fn) = @_;
  78.     local(@ftw_root'devlist) = ('/');
  79.     local($_);
  80.     while ($_ = shift @ftw_root'devlist) {
  81.         &ftw($_,"ftw_root'helper");
  82.     }
  83. }
  84.  
  85. sub ftw_root'helper {
  86.     local($file) = @_;
  87.     local(@s) = lstat($file);
  88.     return unless @s;
  89.     local($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
  90.         $atime,$mtime,$ctime,$blksize,$blocks) = @s;
  91.     if (($ino == 2) && ($dev > 0) && ($dev < 16384)) {
  92.         push(@ftw_root'devlist,$file);
  93.     }
  94.     do $ftw_root'fn("".$file);
  95. }
  96.  
  97. 1;
  98.