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