x2p/find2perl.SH

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