x2p/find2perl

   1 #!/usr/local/bin/perl
   2
   3 eval 'exec /usr/local/bin/perl -S $0 ${1+"$@"}'
   4         if $running_under_some_shell;
   5
   6 $bin = "/usr/local/bin";
   7
   8
   9 while ($ARGV[0] =~ /^[^-!(]/) {
  10     push(@roots, shift);
  11 }
  12 @roots = ('.') unless @roots;
  13 for (@roots) { $_ = &quote($_); }
  14 $roots = join(',', @roots);
  15
  16 $indent = 1;
  17
  18 while (@ARGV) {
  19     $_ = shift;
  20     s/^-// || /^[()!]/ || die "Unrecognized switch: $_\n";
  21     if ($_ eq '(') {
  22         $out .= &tab . "(\n";
  23         $indent++;
  24         next;
  25     }
  26     elsif ($_ eq ')') {
  27         $indent--;
  28         $out .= &tab . ")";
  29     }
  30     elsif ($_ eq '!') {
  31         $out .= &tab . "!";
  32         next;
  33     }
  34     elsif ($_ eq 'name') {
  35         $out .= &tab;
  36         $pat = &fileglob_to_re(shift);
  37         $out .= '/' . $pat . "/";
  38     }
  39     elsif ($_ eq 'perm') {
  40         $onum = shift;
  41         die "Malformed -perm argument: $onum\n" unless $onum =~ /^-?[0-7]+$/;
  42         if ($onum =~ s/^-//) {
  43             $onum = '0' . sprintf("%o", oct($onum) & 017777);   # s/b 07777 ?
  44             $out .= &tab . "((\$mode & $onum) == $onum)";
  45         }
  46         else {
  47             $onum = '0' . $onum unless $onum =~ /^0/;
  48             $out .= &tab . "((\$mode & 0777) == $onum)";
  49         }
  50     }
  51     elsif ($_ eq 'type') {
  52         ($filetest = shift) =~ tr/s/S/;
  53         $out .= &tab . "-$filetest _";
  54     }
  55     elsif ($_ eq 'print') {
  56         $out .= &tab . 'print("$name\n")';
  57     }
  58     elsif ($_ eq 'print0') {
  59         $out .= &tab . 'print("$name\0")';
  60     }
  61     elsif ($_ eq 'fstype') {
  62         $out .= &tab;
  63         $type = shift;
  64         if ($type eq 'nfs')
  65             { $out .= '$dev < 0'; }
  66         else
  67             { $out .= '$dev >= 0'; }
  68     }
  69     elsif ($_ eq 'user') {
  70         $uname = shift;
  71         $out .= &tab . "\$uid == \$uid{'$uname'}";
  72         $inituser++;
  73     }
  74     elsif ($_ eq 'group') {
  75         $gname = shift;
  76         $out .= &tab . "\$gid == \$gid{'$gname'}";
  77         $initgroup++;
  78     }
  79     elsif ($_ eq 'nouser') {
  80         $out .= &tab . '!defined $uid{$uid}';
  81         $inituser++;
  82     }
  83     elsif ($_ eq 'nogroup') {
  84         $out .= &tab . '!defined $gid{$gid}';
  85         $initgroup++;
  86     }
  87     elsif ($_ eq 'links') {
  88         $out .= &tab . '$nlink ' . &n(shift);
  89     }
  90     elsif ($_ eq 'inum') {
  91         $out .= &tab . '$ino ' . &n(shift);
  92     }
  93     elsif ($_ eq 'size') {
  94         $out .= &tab . 'int((-s _ + 511) / 512) ' . &n(shift);
  95     }
  96     elsif ($_ eq 'atime') {
  97         $out .= &tab . 'int(-A _) ' . &n(shift);
  98     }
  99     elsif ($_ eq 'mtime') {
 100         $out .= &tab . 'int(-M _) ' . &n(shift);
 101     }
 102     elsif ($_ eq 'ctime') {
 103         $out .= &tab . 'int(-C _) ' . &n(shift);
 104     }
 105     elsif ($_ eq 'exec') {
 106         for (@cmd = (); @ARGV && $ARGV[0] ne ';'; push(@cmd,shift)) { }
 107         shift;
 108         $_ = "@cmd";
 109         if (m#^(/bin/)?rm -f {}$#) {
 110             if (!@ARGV) {
 111                 $out .= &tab . 'unlink($_)';
 112             }
 113             else {
 114                 $out .= &tab . '(unlink($_) || 1)';
 115             }
 116         }
 117         elsif (m#^(/bin/)?rm {}$#) {
 118             $out .= &tab . '(unlink($_) || warn "$name: $!\n")';
 119         }
 120         else {
 121             for (@cmd) { s/'/\\'/g; }
 122             $" = "','";
 123             $out .= &tab . "&exec(0, '@cmd')";
 124             $" = ' ';
 125             $initexec++;
 126         }
 127     }
 128     elsif ($_ eq 'ok') {
 129         for (@cmd = (); @ARGV && $ARGV[0] ne ';'; push(@cmd,shift)) { }
 130         shift;
 131         for (@cmd) { s/'/\\'/g; }
 132         $" = "','";
 133         $out .= &tab . "&exec(1, '@cmd')";
 134         $" = ' ';
 135         $initexec++;
 136     }
 137     elsif ($_ eq 'prune') {
 138         $out .= &tab . '($prune = 1)';
 139     }
 140     elsif ($_ eq 'xdev') {
 141         $out .= &tab . '(($prune |= ($dev != $topdev)),1)';
 142     }
 143     elsif ($_ eq 'newer') {
 144         $out .= &tab;
 145         $file = shift;
 146         $newername = 'AGE_OF' . $file;
 147         $newername =~ s/[^\w]/_/g;
 148         $newername = '$' . $newername;
 149         $out .= "-M _ < $newername";
 150         $initnewer .= "$newername = -M " . &quote($file) . ";\n";
 151     }
 152     elsif ($_ eq 'eval') {
 153         $prog = &quote(shift);
 154         $out .= &tab . "eval $prog";
 155     }
 156     elsif ($_ eq 'depth') {
 157         $depth++;
 158         next;
 159     }
 160     elsif ($_ eq 'ls') {
 161         $out .= &tab . "&ls";
 162         $initls++;
 163     }
 164     elsif ($_ eq 'tar') {
 165         $out .= &tab;
 166         die "-tar must have a filename argument\n" unless @ARGV;
 167         $file = shift;
 168         $fh = 'FH' . $file;
 169         $fh =~ s/[^\w]/_/g;
 170         $out .= "&tar($fh)";
 171         $file = '>' . $file;
 172         $initfile .= "open($fh, " . &quote($file) .
 173           qq{) || die "Can't open $fh: \$!\\n";\n};
 174         $inittar++;
 175         $flushall = "\n&tflushall;\n";
 176     }
 177     elsif (/^n?cpio$/) {
 178         $depth++;
 179         $out .= &tab;
 180         die "-$_ must have a filename argument\n" unless @ARGV;
 181         $file = shift;
 182         $fh = 'FH' . $file;
 183         $fh =~ s/[^\w]/_/g;
 184         $out .= "&cpio('" . substr($_,0,1) . "', $fh)";
 185         $file = '>' . $file;
 186         $initfile .= "open($fh, " . &quote($file) .
 187           qq{) || die "Can't open $fh: \$!\\n";\n};
 188         $initcpio++;
 189         $flushall = "\n&flushall;\n";
 190     }
 191     else {
 192         die "Unrecognized switch: -$_\n";
 193     }
 194     if (@ARGV) {
 195         if ($ARGV[0] eq '-o') {
 196             { local($statdone) = 1; $out .= "\n" . &tab . "||\n"; }
 197             $statdone = 0 if $indent == 1 && $delayedstat;
 198             $saw_or++;
 199             shift;
 200         }
 201         else {
 202             $out .= " &&" unless $ARGV[0] eq ')';
 203             $out .= "\n";
 204             shift if $ARGV[0] eq '-a';
 205         }
 206     }
 207 }
 208
 209 print <<"END";
 210 #!$bin/perl
 211
 212 eval 'exec $bin/perl -S \$0 \${1+"\$@"}'
 213         if \$running_under_some_shell;
 214
 215 END
 216
 217 if ($initls) {
 218     print <<'END';
 219 @rwx = ('---','--x','-w-','-wx','r--','r-x','rw-','rwx');
 220 @moname = (Jan,Feb,Mar,Apr,May,Jun,Jul,Aug,Sep,Oct,Nov,Dec);
 221
 222 END
 223 }
 224
 225 if ($inituser || $initls) {
 226     print 'while (($name, $pw, $uid) = getpwent) {', "\n";
 227     print '    $uid{$name} = $uid{$uid} = $uid;', "\n" if $inituser;
 228     print '    $user{$uid} = $name unless $user{$uid};', "\n" if $initls;
 229     print "}\n\n";
 230 }
 231
 232 if ($initgroup || $initls) {
 233     print 'while (($name, $pw, $gid) = getgrent) {', "\n";
 234     print '    $gid{$name} = $gid{$gid} = $gid;', "\n" if $initgroup;
 235     print '    $group{$gid} = $name unless $group{$gid};', "\n" if $initls;
 236     print "}\n\n";
 237 }
 238
 239 print $initnewer, "\n" if $initnewer;
 240
 241 print $initfile, "\n" if $initfile;
 242
 243 $find = $depth ? "finddepth" : "find";
 244 print <<"END";
 245 require "$find.pl";
 246
 247 # Traverse desired filesystems
 248
 249 &$find($roots);
 250 $flushall
 251 exit;
 252
 253 sub wanted {
 254 $out;
 255 }
 256
 257 END
 258
 259 if ($initexec) {
 260     print <<'END';
 261 sub exec {
 262     local($ok, @cmd) = @_;
 263     foreach $word (@cmd) {
 264         $word =~ s#{}#$name#g;
 265     }
 266     if ($ok) {
 267         local($old) = select(STDOUT);
 268         $| = 1;
 269         print "@cmd";
 270         select($old);
 271         return 0 unless <STDIN> =~ /^y/;
 272     }
 273     chdir $cwd;         # sigh
 274     system @cmd;
 275     chdir $dir;
 276     return !$?;
 277 }
 278
 279 END
 280 }
 281
 282 if ($initls) {
 283     print <<'END';
 284 sub ls {
 285     ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$sizemm,
 286       $atime,$mtime,$ctime,$blksize,$blocks) = lstat(_);
 287
 288     $pname = $name;
 289
 290     if (defined $blocks) {
 291         $blocks = int(($blocks + 1) / 2);
 292     }
 293     else {
 294         $blocks = int(($size + 1023) / 1024);
 295     }
 296
 297     if    (-f _) { $perms = '-'; }
 298     elsif (-d _) { $perms = 'd'; }
 299     elsif (-c _) { $perms = 'c'; $sizemm = &sizemm; }
 300     elsif (-b _) { $perms = 'b'; $sizemm = &sizemm; }
 301     elsif (-p _) { $perms = 'p'; }
 302     elsif (-S _) { $perms = 's'; }
 303     else         { $perms = 'l'; $pname .= ' -> ' . readlink($_); }
 304
 305     $tmpmode = $mode;
 306     $tmp = $rwx[$tmpmode & 7];
 307     $tmpmode >>= 3;
 308     $tmp = $rwx[$tmpmode & 7] . $tmp;
 309     $tmpmode >>= 3;
 310     $tmp = $rwx[$tmpmode & 7] . $tmp;
 311     substr($tmp,2,1) =~ tr/-x/Ss/ if -u _;
 312     substr($tmp,5,1) =~ tr/-x/Ss/ if -g _;
 313     substr($tmp,8,1) =~ tr/-x/Tt/ if -k _;
 314     $perms .= $tmp;
 315
 316     $user = $user{$uid} || $uid;
 317     $group = $group{$gid} || $gid;
 318
 319     ($sec,$min,$hour,$mday,$mon,$year) = localtime($mtime);
 320     $moname = $moname[$mon];
 321     if (-M _ > 365.25 / 2) {
 322         $timeyear = '19' . $year;
 323     }
 324     else {
 325         $timeyear = sprintf("%02d:%02d", $hour, $min);
 326     }
 327
 328     printf "%5lu %4ld %-10s %2d %-8s %-8s %8s %s %2d %5s %s\n",
 329             $ino,
 330                  $blocks,
 331                       $perms,
 332                             $nlink,
 333                                 $user,
 334                                      $group,
 335                                           $sizemm,
 336                                               $moname,
 337                                                  $mday,
 338                                                      $timeyear,
 339                                                          $pname;
 340     1;
 341 }
 342
 343 sub sizemm {
 344     sprintf("%3d, %3d", ($rdev >> 8) & 255, $rdev & 255);
 345 }
 346
 347 END
 348 }
 349
 350 if ($initcpio) {
 351 print <<'END';
 352 sub cpio {
 353     local($nc,$fh) = @_;
 354     local($text);
 355
 356     if ($name eq 'TRAILER!!!') {
 357         $text = '';
 358         $size = 0;
 359     }
 360     else {
 361         ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
 362           $atime,$mtime,$ctime,$blksize,$blocks) = lstat(_);
 363         if (-f _) {
 364             open(IN, "./$_\0") || do {
 365                 warn "Couldn't open $name: $!\n";
 366                 return;
 367             };
 368         }
 369         else {
 370             $text = readlink($_);
 371             $size = 0 unless defined $text;
 372         }
 373     }
 374
 375     ($nm = $name) =~ s#^\./##;
 376     $nc{$fh} = $nc;
 377     if ($nc eq 'n') {
 378         $cpout{$fh} .=
 379           sprintf("%06o%06o%06o%06o%06o%06o%06o%06o%011lo%06o%011lo%s\0",
 380             070707,
 381             $dev & 0777777,
 382             $ino & 0777777,
 383             $mode & 0777777,
 384             $uid & 0777777,
 385             $gid & 0777777,
 386             $nlink & 0777777,
 387             $rdev & 0177777,
 388             $mtime,
 389             length($nm)+1,
 390             $size,
 391             $nm);
 392     }
 393     else {
 394         $cpout{$fh} .= "\0" if length($cpout{$fh}) & 1;
 395         $cpout{$fh} .= pack("SSSSSSSSLSLa*",
 396             070707, $dev, $ino, $mode, $uid, $gid, $nlink, $rdev, $mtime,
 397             length($nm)+1, $size, $nm . (length($nm) & 1 ? "\0" : "\0\0"));
 398     }
 399     if ($text ne '') {
 400         $cpout{$fh} .= $text;
 401     }
 402     elsif ($size) {
 403         &flush($fh) while ($l = length($cpout{$fh})) >= 5120;
 404         while (sysread(IN, $cpout{$fh}, 5120 - $l, $l)) {
 405             &flush($fh);
 406             $l = length($cpout{$fh});
 407         }
 408     }
 409     close IN;
 410 }
 411
 412 sub flush {
 413     local($fh) = @_;
 414
 415     while (length($cpout{$fh}) >= 5120) {
 416         syswrite($fh,$cpout{$fh},5120);
 417         ++$blocks{$fh};
 418         substr($cpout{$fh}, 0, 5120) = '';
 419     }
 420 }
 421
 422 sub flushall {
 423     $name = 'TRAILER!!!';
 424     foreach $fh (keys %cpout) {
 425         &cpio($nc{$fh},$fh);
 426         $cpout{$fh} .= "0" x (5120 - length($cpout{$fh}));
 427         &flush($fh);
 428         print $blocks{$fh} * 10, " blocks\n";
 429     }
 430 }
 431
 432 END
 433 }
 434
 435 if ($inittar) {
 436 print <<'END';
 437 sub tar {
 438     local($fh) = @_;
 439     local($linkname,$header,$l,$slop);
 440     local($linkflag) = "\0";
 441
 442     ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
 443       $atime,$mtime,$ctime,$blksize,$blocks) = lstat(_);
 444     $nm = $name;
 445     if ($nlink > 1) {
 446         if ($linkname = $linkseen{$fh,$dev,$ino}) {
 447             $linkflag = 1;
 448         }
 449         else {
 450             $linkseen{$fh,$dev,$ino} = $nm;
 451         }
 452     }
 453     if (-f _) {
 454         open(IN, "./$_\0") || do {
 455             warn "Couldn't open $name: $!\n";
 456             return;
 457         };
 458         $size = 0 if $linkflag ne "\0";
 459     }
 460     else {
 461         $linkname = readlink($_);
 462         $linkflag = 2 if defined $linkname;
 463         $nm .= '/' if -d _;
 464         $size = 0;
 465     }
 466
 467     $header = pack("a100a8a8a8a12a12a8a1a100",
 468         $nm,
 469         sprintf("%6o ", $mode & 0777),
 470         sprintf("%6o ", $uid & 0777777),
 471         sprintf("%6o ", $gid & 0777777),
 472         sprintf("%11o ", $size),
 473         sprintf("%11o ", $mtime),
 474         "        ",
 475         $linkflag,
 476         $linkname);
 477     $l = length($header) % 512;
 478     substr($header, 148, 6) = sprintf("%6o", unpack("%16C*", $header));
 479     substr($header, 154, 1) = "\0";  # blech
 480     $tarout{$fh} .= $header;
 481     $tarout{$fh} .= "\0" x (512 - $l) if $l;
 482     if ($size) {
 483         &tflush($fh) while ($l = length($tarout{$fh})) >= 10240;
 484         while (sysread(IN, $tarout{$fh}, 10240 - $l, $l)) {
 485             $slop = length($tarout{$fh}) % 512;
 486             $tarout{$fh} .= "\0" x (512 - $slop) if $slop;
 487             &tflush($fh);
 488             $l = length($tarout{$fh});
 489         }
 490     }
 491     close IN;
 492 }
 493
 494 sub tflush {
 495     local($fh) = @_;
 496
 497     while (length($tarout{$fh}) >= 10240) {
 498         syswrite($fh,$tarout{$fh},10240);
 499         ++$blocks{$fh};
 500         substr($tarout{$fh}, 0, 10240) = '';
 501     }
 502 }
 503
 504 sub tflushall {
 505     local($len);
 506
 507     foreach $fh (keys %tarout) {
 508         $len = 10240 - length($tarout{$fh});
 509         $len += 10240 if $len < 1024;
 510         $tarout{$fh} .= "\0" x $len;
 511         &tflush($fh);
 512     }
 513 }
 514
 515 END
 516 }
 517
 518 exit;
 519
 520 ############################################################################
 521
 522 sub tab {
 523     local($tabstring);
 524
 525     $tabstring = "\t" x ($indent / 2) . ' ' x ($indent % 2 * 4);
 526     if (!$statdone) {
 527         if ($_ =~ /^(name|print|prune|exec|ok|\(|\))/) {
 528             $delayedstat++;
 529         }
 530         else {
 531             if ($saw_or) {
 532                 $tabstring .= <<'ENDOFSTAT' . $tabstring;
 533 ($nlink || (($dev,$ino,$mode,$nlink,$uid,$gid) = lstat($_))) &&
 534 ENDOFSTAT
 535             }
 536             else {
 537                 $tabstring .= <<'ENDOFSTAT' . $tabstring;
 538 (($dev,$ino,$mode,$nlink,$uid,$gid) = lstat($_)) &&
 539 ENDOFSTAT
 540             }
 541             $statdone = 1;
 542         }
 543     }
 544     $tabstring =~ s/^\s+/ / if $out =~ /!$/;
 545     $tabstring;
 546 }
 547
 548 sub fileglob_to_re {
 549     local($tmp) = @_;
 550
 551     $tmp =~ s/([.^\$()])/\\$1/g;
 552     $tmp =~ s/([?*])/.$1/g;
 553     "^$tmp$";
 554 }
 555
 556 sub n {
 557     local($n) = @_;
 558
 559     $n =~ s/^-/< / || $n =~ s/^\+/> / || $n =~ s/^/== /;
 560     $n =~ s/ 0*(\d)/ $1/;
 561     $n;
 562 }
 563
 564 sub quote {
 565     local($string) = @_;
 566     $string =~ s/'/\\'/;
 567     "'$string'";
 568 }