home *** CD-ROM | disk | FTP | other *** search
/ BURKS 2 / BURKS_AUG97.ISO / SLAKWARE / D12 / PERL1.TGZ / perl1.tar / usr / bin / find2perl < prev    next >
Text File  |  1996-06-28  |  12KB  |  570 lines
  1. #!/usr/bin/perl
  2.     eval 'exec perl -S $0 "$@"'
  3.     if 0;
  4. $startperl = "#!/usr/bin/perl";
  5. # 
  6. # Modified September 26, 1993 to provide proper handling of years after 1999
  7. #   Tom Link <tml+@pitt.edu>
  8. #   University of Pittsburgh
  9.  
  10. while ($ARGV[0] =~ /^[^-!(]/) {
  11.     push(@roots, shift);
  12. }
  13. @roots = ('.') unless @roots;
  14. for (@roots) { $_ = "e($_); }
  15. $roots = join(',', @roots);
  16.  
  17. $indent = 1;
  18.  
  19. while (@ARGV) {
  20.     $_ = shift;
  21.     s/^-// || /^[()!]/ || die "Unrecognized switch: $_\n";
  22.     if ($_ eq '(') {
  23.     $out .= &tab . "(\n";
  24.     $indent++;
  25.     next;
  26.     }
  27.     elsif ($_ eq ')') {
  28.     $indent--;
  29.     $out .= &tab . ")";
  30.     }
  31.     elsif ($_ eq '!') {
  32.     $out .= &tab . "!";
  33.     next;
  34.     }
  35.     elsif ($_ eq 'name') {
  36.     $out .= &tab;
  37.     $pat = &fileglob_to_re(shift);
  38.     $out .= '/' . $pat . "/";
  39.     }
  40.     elsif ($_ eq 'perm') {
  41.     $onum = shift;
  42.     die "Malformed -perm argument: $onum\n" unless $onum =~ /^-?[0-7]+$/;
  43.     if ($onum =~ s/^-//) {
  44.         $onum = '0' . sprintf("%o", oct($onum) & 017777);    # s/b 07777 ?
  45.         $out .= &tab . "((\$mode & $onum) == $onum)";
  46.     }
  47.     else {
  48.         $onum = '0' . $onum unless $onum =~ /^0/;
  49.         $out .= &tab . "((\$mode & 0777) == $onum)";
  50.     }
  51.     }
  52.     elsif ($_ eq 'type') {
  53.     ($filetest = shift) =~ tr/s/S/;
  54.     $out .= &tab . "-$filetest _";
  55.     }
  56.     elsif ($_ eq 'print') {
  57.     $out .= &tab . 'print("$name\n")';
  58.     }
  59.     elsif ($_ eq 'print0') {
  60.     $out .= &tab . 'print("$name\0")';
  61.     }
  62.     elsif ($_ eq 'fstype') {
  63.     $out .= &tab;
  64.     $type = shift;
  65.     if ($type eq 'nfs')
  66.         { $out .= '($dev < 0)'; }
  67.     else
  68.         { $out .= '($dev >= 0)'; }
  69.     }
  70.     elsif ($_ eq 'user') {
  71.     $uname = shift;
  72.     $out .= &tab . "(\$uid == \$uid{'$uname'})";
  73.     $inituser++;
  74.     }
  75.     elsif ($_ eq 'group') {
  76.     $gname = shift;
  77.     $out .= &tab . "(\$gid == \$gid{'$gname'})";
  78.     $initgroup++;
  79.     }
  80.     elsif ($_ eq 'nouser') {
  81.     $out .= &tab . '!defined $uid{$uid}';
  82.     $inituser++;
  83.     }
  84.     elsif ($_ eq 'nogroup') {
  85.     $out .= &tab . '!defined $gid{$gid}';
  86.     $initgroup++;
  87.     }
  88.     elsif ($_ eq 'links') {
  89.     $out .= &tab . '($nlink ' . &n(shift);
  90.     }
  91.     elsif ($_ eq 'inum') {
  92.     $out .= &tab . '($ino ' . &n(shift);
  93.     }
  94.     elsif ($_ eq 'size') {
  95.     $out .= &tab . '(int(((-s _) + 511) / 512) ' . &n(shift);
  96.     }
  97.     elsif ($_ eq 'atime') {
  98.     $out .= &tab . '(int(-A _) ' . &n(shift);
  99.     }
  100.     elsif ($_ eq 'mtime') {
  101.     $out .= &tab . '(int(-M _) ' . &n(shift);
  102.     }
  103.     elsif ($_ eq 'ctime') {
  104.     $out .= &tab . '(int(-C _) ' . &n(shift);
  105.     }
  106.     elsif ($_ eq 'exec') {
  107.     for (@cmd = (); @ARGV && $ARGV[0] ne ';'; push(@cmd,shift)) { }
  108.     shift;
  109.     $_ = "@cmd";
  110.     if (m#^(/bin/)?rm -f {}$#) {
  111.         if (!@ARGV) {
  112.         $out .= &tab . 'unlink($_)';
  113.         }
  114.         else {
  115.         $out .= &tab . '(unlink($_) || 1)';
  116.         }
  117.     }
  118.     elsif (m#^(/bin/)?rm {}$#) {
  119.         $out .= &tab . '(unlink($_) || warn "$name: $!\n")';
  120.     }
  121.     else {
  122.         for (@cmd) { s/'/\\'/g; }
  123.         $" = "','";
  124.         $out .= &tab . "&exec(0, '@cmd')";
  125.         $" = ' ';
  126.         $initexec++;
  127.     }
  128.     }
  129.     elsif ($_ eq 'ok') {
  130.     for (@cmd = (); @ARGV && $ARGV[0] ne ';'; push(@cmd,shift)) { }
  131.     shift;
  132.     for (@cmd) { s/'/\\'/g; }
  133.     $" = "','";
  134.     $out .= &tab . "&exec(1, '@cmd')";
  135.     $" = ' ';
  136.     $initexec++;
  137.     }
  138.     elsif ($_ eq 'prune') {
  139.     $out .= &tab . '($prune = 1)';
  140.     }
  141.     elsif ($_ eq 'xdev') {
  142.     $out .= &tab . '!($prune |= ($dev != $topdev))';
  143.     }
  144.     elsif ($_ eq 'newer') {
  145.     $out .= &tab;
  146.     $file = shift;
  147.     $newername = 'AGE_OF' . $file;
  148.     $newername =~ s/[^\w]/_/g;
  149.     $newername = '$' . $newername;
  150.     $out .= "(-M _ < $newername)";
  151.     $initnewer .= "$newername = -M " . "e($file) . ";\n";
  152.     }
  153.     elsif ($_ eq 'eval') {
  154.     $prog = "e(shift);
  155.     $out .= &tab . "eval $prog";
  156.     }
  157.     elsif ($_ eq 'depth') {
  158.     $depth++;
  159.     next;
  160.     }
  161.     elsif ($_ eq 'ls') {
  162.     $out .= &tab . "&ls";
  163.     $initls++;
  164.     }
  165.     elsif ($_ eq 'tar') {
  166.     $out .= &tab;
  167.     die "-tar must have a filename argument\n" unless @ARGV;
  168.     $file = shift;
  169.     $fh = 'FH' . $file;
  170.     $fh =~ s/[^\w]/_/g;
  171.     $out .= "&tar($fh)";
  172.     $file = '>' . $file;
  173.     $initfile .= "open($fh, " . "e($file) .
  174.       qq{) || die "Can't open $fh: \$!\\n";\n};
  175.     $inittar++;
  176.     $flushall = "\n&tflushall;\n";
  177.     }
  178.     elsif (/^n?cpio$/) {
  179.     $depth++;
  180.     $out .= &tab;
  181.     die "-$_ must have a filename argument\n" unless @ARGV;
  182.     $file = shift;
  183.     $fh = 'FH' . $file;
  184.     $fh =~ s/[^\w]/_/g;
  185.     $out .= "&cpio('" . substr($_,0,1) . "', $fh)";
  186.     $file = '>' . $file;
  187.     $initfile .= "open($fh, " . "e($file) .
  188.       qq{) || die "Can't open $fh: \$!\\n";\n};
  189.     $initcpio++;
  190.     $flushall = "\n&flushall;\n";
  191.     }
  192.     else {
  193.     die "Unrecognized switch: -$_\n";
  194.     }
  195.     if (@ARGV) {
  196.     if ($ARGV[0] eq '-o') {
  197.         { local($statdone) = 1; $out .= "\n" . &tab . "||\n"; }
  198.         $statdone = 0 if $indent == 1 && $delayedstat;
  199.         $saw_or++;
  200.         shift;
  201.     }
  202.     else {
  203.         $out .= " &&" unless $ARGV[0] eq ')';
  204.         $out .= "\n";
  205.         shift if $ARGV[0] eq '-a';
  206.     }
  207.     }
  208. }
  209.  
  210. print <<"END";
  211. $startperl
  212.  
  213. eval 'exec perl -S \$0 \${1+"\$@"}'
  214.     if \$running_under_some_shell;
  215.  
  216. END
  217.  
  218. if ($initls) {
  219.     print <<'END';
  220. @rwx = ('---','--x','-w-','-wx','r--','r-x','rw-','rwx');
  221. @moname = (Jan,Feb,Mar,Apr,May,Jun,Jul,Aug,Sep,Oct,Nov,Dec);
  222.  
  223. END
  224. }
  225.  
  226. if ($inituser || $initls) {
  227.     print 'while (($name, $pw, $uid) = getpwent) {', "\n";
  228.     print '    $uid{$name} = $uid{$uid} = $uid;', "\n" if $inituser;
  229.     print '    $user{$uid} = $name unless $user{$uid};', "\n" if $initls;
  230.     print "}\n\n";
  231. }
  232.  
  233. if ($initgroup || $initls) {
  234.     print 'while (($name, $pw, $gid) = getgrent) {', "\n";
  235.     print '    $gid{$name} = $gid{$gid} = $gid;', "\n" if $initgroup;
  236.     print '    $group{$gid} = $name unless $group{$gid};', "\n" if $initls;
  237.     print "}\n\n";
  238. }
  239.  
  240. print $initnewer, "\n" if $initnewer;
  241.  
  242. print $initfile, "\n" if $initfile;
  243.  
  244. $find = $depth ? "finddepth" : "find";
  245. print <<"END";
  246. require "$find.pl";
  247.  
  248. # Traverse desired filesystems
  249.  
  250. &$find($roots);
  251. $flushall
  252. exit;
  253.  
  254. sub wanted {
  255. $out;
  256. }
  257.  
  258. END
  259.  
  260. if ($initexec) {
  261.     print <<'END';
  262. sub exec {
  263.     local($ok, @cmd) = @_;
  264.     foreach $word (@cmd) {
  265.     $word =~ s#{}#$name#g;
  266.     }
  267.     if ($ok) {
  268.     local($old) = select(STDOUT);
  269.     $| = 1;
  270.     print "@cmd";
  271.     select($old);
  272.     return 0 unless <STDIN> =~ /^y/;
  273.     }
  274.     chdir $cwd;        # sigh
  275.     system @cmd;
  276.     chdir $dir;
  277.     return !$?;
  278. }
  279.  
  280. END
  281. }
  282.  
  283. if ($initls) {
  284.     print <<'END';
  285. sub ls {
  286.     ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$sizemm,
  287.       $atime,$mtime,$ctime,$blksize,$blocks) = lstat(_);
  288.  
  289.     $pname = $name;
  290.  
  291.     if (defined $blocks) {
  292.     $blocks = int(($blocks + 1) / 2);
  293.     }
  294.     else {
  295.     $blocks = int(($size + 1023) / 1024);
  296.     }
  297.  
  298.     if    (-f _) { $perms = '-'; }
  299.     elsif (-d _) { $perms = 'd'; }
  300.     elsif (-c _) { $perms = 'c'; $sizemm = &sizemm; }
  301.     elsif (-b _) { $perms = 'b'; $sizemm = &sizemm; }
  302.     elsif (-p _) { $perms = 'p'; }
  303.     elsif (-S _) { $perms = 's'; }
  304.     else         { $perms = 'l'; $pname .= ' -> ' . readlink($_); }
  305.  
  306.     $tmpmode = $mode;
  307.     $tmp = $rwx[$tmpmode & 7];
  308.     $tmpmode >>= 3;
  309.     $tmp = $rwx[$tmpmode & 7] . $tmp;
  310.     $tmpmode >>= 3;
  311.     $tmp = $rwx[$tmpmode & 7] . $tmp;
  312.     substr($tmp,2,1) =~ tr/-x/Ss/ if -u _;
  313.     substr($tmp,5,1) =~ tr/-x/Ss/ if -g _;
  314.     substr($tmp,8,1) =~ tr/-x/Tt/ if -k _;
  315.     $perms .= $tmp;
  316.  
  317.     $user = $user{$uid} || $uid;
  318.     $group = $group{$gid} || $gid;
  319.  
  320.     ($sec,$min,$hour,$mday,$mon,$year) = localtime($mtime);
  321.     $moname = $moname[$mon];
  322.     if (-M _ > 365.25 / 2) {
  323.     $timeyear = $year + 1900;
  324.     }
  325.     else {
  326.     $timeyear = sprintf("%02d:%02d", $hour, $min);
  327.     }
  328.  
  329.     printf "%5lu %4ld %-10s %2d %-8s %-8s %8s %s %2d %5s %s\n",
  330.         $ino,
  331.          $blocks,
  332.               $perms,
  333.                 $nlink,
  334.                 $user,
  335.                      $group,
  336.                       $sizemm,
  337.                           $moname,
  338.                          $mday,
  339.                              $timeyear,
  340.                              $pname;
  341.     1;
  342. }
  343.  
  344. sub sizemm {
  345.     sprintf("%3d, %3d", ($rdev >> 8) & 255, $rdev & 255);
  346. }
  347.  
  348. END
  349. }
  350.  
  351. if ($initcpio) {
  352. print <<'END';
  353. sub cpio {
  354.     local($nc,$fh) = @_;
  355.     local($text);
  356.  
  357.     if ($name eq 'TRAILER!!!') {
  358.     $text = '';
  359.     $size = 0;
  360.     }
  361.     else {
  362.     ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
  363.       $atime,$mtime,$ctime,$blksize,$blocks) = lstat(_);
  364.     if (-f _) {
  365.         open(IN, "./$_\0") || do {
  366.         warn "Couldn't open $name: $!\n";
  367.         return;
  368.         };
  369.     }
  370.     else {
  371.         $text = readlink($_);
  372.         $size = 0 unless defined $text;
  373.     }
  374.     }
  375.  
  376.     ($nm = $name) =~ s#^\./##;
  377.     $nc{$fh} = $nc;
  378.     if