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         for (@cmd) { s/'/\\'/g; }
 132         $" = "','";
 133         $out .= &tab . "&exec(0, '@cmd')";
 134         $" = ' ';
 135         $initexec++;
 136     }
 137     elsif ($_ eq 'ok') {
 138         for (@cmd = (); @ARGV && $ARGV[0] ne ';'; push(@cmd,shift)) { }
 139         shift;
 140         for (@cmd) { s/'/\\'/g; }
 141         $" = "','";
 142         $out .= &tab . "&exec(1, '@cmd')";
 143         $" = ' ';
 144         $initexec++;
 145     }
 146     elsif ($_ eq 'prune') {
 147         $out .= &tab . '($prune = 1)';
 148     }
 149     elsif ($_ eq 'xdev') {
 150         $out .= &tab . '(($prune |= ($dev != $topdev)),1)';
 151     }
 152     elsif ($_ eq 'newer') {
 153         $out .= &tab;
 154         $file = shift;
 155         $newername = 'AGE_OF' . $file;
 156         $newername =~ s/[^\w]/_/g;
 157         $newername = '$' . $newername;
 158         $out .= "-M _ < $newername";
 159         $initnewer .= "$newername = -M " . &quote($file) . ";\n";
 160     }
 161     elsif ($_ eq 'eval') {
 162         $prog = &quote(shift);
 163         $out .= &tab . "eval $prog";
 164     }
 165     elsif ($_ eq 'depth') {
 166         $depth++;
 167         next;
 168     }
 169     elsif ($_ eq 'ls') {
 170         $out .= &tab . "&ls";
 171         $initls++;
 172     }
 173     elsif ($_ eq 'tar') {
 174         $out .= &tab;
 175         die "-tar must have a filename argument\n" unless @ARGV;
 176         $file = shift;
 177         $fh = 'FH' . $file;
 178         $fh =~ s/[^\w]/_/g;
 179         $out .= "&tar($fh)";
 180         $file = '>' . $file;
 181         $initfile .= "open($fh, " . &quote($file) .
 182           qq{) || die "Can't open $fh: \$!\\n";\n};
 183         $inittar++;
 184         $flushall = "\n&tflushall;\n";
 185     }
 186     elsif (/^n?cpio$/) {
 187         $depth++;
 188         $out .= &tab;
 189         die "-$_ must have a filename argument\n" unless @ARGV;
 190         $file = shift;
 191         $fh = 'FH' . $file;
 192         $fh =~ s/[^\w]/_/g;
 193         $out .= "&cpio('" . substr($_,0,1) . "', $fh)";
 194         $file = '>' . $file;
 195         $initfile .= "open($fh, " . &quote($file) .
 196           qq{) || die "Can't open $fh: \$!\\n";\n};
 197         $initcpio++;
 198         $flushall = "\n&flushall;\n";
 199     }
 200     else {
 201         die "Unrecognized switch: -$_\n";
 202     }
 203     if (@ARGV) {
 204         if ($ARGV[0] eq '-o') {
 205             local($indent) = $indent - 4;
 206             $out .= "\n" . &tab . "||\n";
 207             shift;
 208         }
 209         else {
 210             $out .= " &&" unless $ARGV[0] eq ')';
 211             $out .= "\n";
 212             shift if $ARGV[0] eq '-a';
 213         }
 214     }
 215 }
 216
 217 print <<"END";
 218 #!$bin/perl
 219
 220 END
 221
 222 if ($initls) {
 223     print <<'END';
 224 @rwx = ('---','--x','-w-','-wx','r--','r-x','rw-','rwx');
 225 @moname = (Jan,Feb,Mar,Apr,May,Jun,Jul,Aug,Sep,Oct,Nov,Dec);
 226
 227 END
 228 }
 229
 230 if ($inituser || $initls) {
 231     print 'while (($name, $pw, $uid) = getpwent) {', "\n";
 232     print '    $uid{$name} = $uid{$uid} = $uid;', "\n" if $inituser;
 233     print '    $user{$uid} = $name unless $user{$uid};', "\n" if $initls;
 234     print "}\n\n";
 235 }
 236
 237 if ($initgroup || $initls) {
 238     print 'while (($name, $pw, $gid) = getgrent) {', "\n";
 239     print '    $gid{$name} = $gid{$gid} = $gid;', "\n" if $initgroup;
 240     print '    $group{$gid} = $name unless $group{$gid};', "\n" if $initls;
 241     print "}\n\n";
 242 }
 243
 244 print $initnewer, "\n" if $initnewer;
 245
 246 print $initfile, "\n" if $initfile;
 247
 248 print <<"END";
 249 # Traverse desired filesystems
 250
 251 &dodirs($roots);
 252 $flushall
 253 exit;
 254
 255 sub wanted {
 256 $out;
 257 }
 258
 259 END
 260
 261 print <<'END';
 262 sub dodirs {
 263     chop($cwd = `pwd`);
 264     foreach $topdir (@_) {
 265         (($topdev,$topino,$topmode,$topnlink) = stat($topdir))
 266           || (warn("Can't stat $topdir: $!\n"), next);
 267         if (-d _) {
 268             if (chdir($topdir)) {
 269 END
 270 if ($depth) {
 271     print <<'END';
 272                 $topdir = '' if $topdir eq '/';
 273                 &dodir($topdir,$topnlink);
 274                 ($dir,$_) = ($topdir,'.');
 275                 $name = $topdir;
 276                 &wanted;
 277 END
 278 }
 279 else {
 280     print <<'END';
 281                 ($dir,$_) = ($topdir,'.');
 282                 $name = $topdir;
 283                 &wanted;
 284                 $topdir = '' if $topdir eq '/';
 285                 &dodir($topdir,$topnlink);
 286 END
 287 }
 288 print <<'END';
 289             }
 290             else {
 291                 warn "Can't cd to $topdir: $!\n";
 292             }
 293         }
 294         else {
 295             unless (($dir,$_) = $topdir =~ m#^(.*/)(.*)$#) {
 296                 ($dir,$_) = ('.', $topdir);
 297             }
 298             chdir $dir && &wanted;
 299         }
 300         chdir $cwd;
 301     }
 302 }
 303
 304 sub dodir {
 305     local($dir,$nlink) = @_;
 306     local($dev,$ino,$mode,$subcount);
 307     local($name);
 308
 309     # Get the list of files in the current directory.
 310
 311     opendir(DIR,'.') || warn "Can't open $dir: $!\n";
 312     local(@filenames) = readdir(DIR);
 313     closedir(DIR);
 314
 315     if ($nlink == 2) {        # This dir has no subdirectories.
 316         for (@filenames) {
 317             next if $_ eq '.';
 318             next if $_ eq '..';
 319             $name = "$dir/$_";
 320             &wanted;
 321         }
 322     }
 323     else {                    # This dir has subdirectories.
 324         $subcount = $nlink - 2;
 325         for (@filenames) {
 326             next if $_ eq '.';
 327             next if $_ eq '..';
 328             $nlink = $prune = 0;
 329             $name = "$dir/$_";
 330 END
 331 print <<'END' unless $depth;
 332             &wanted;
 333 END
 334 print <<'END';
 335             if ($subcount > 0) {    # Seen all the subdirs?
 336
 337                 # Get link count and check for directoriness.
 338
 339                 ($dev,$ino,$mode,$nlink) = lstat($_) unless $nlink;
 340
 341                 if (-d _) {
 342
 343                     # It really is a directory, so do it recursively.
 344
 345                     if (!$prune && chdir $_) {
 346                         &dodir($name,$nlink);
 347                         chdir '..';
 348                     }
 349                     --$subcount;
 350                 }
 351             }
 352 END
 353 print <<'END' if $depth;
 354             &wanted;
 355 END
 356 print <<'END';
 357         }
 358     }
 359 }
 360
 361 END
 362
 363 if ($initexec) {
 364     print <<'END';
 365 sub exec {
 366     local($ok, @cmd) = @_;
 367     foreach $word (@cmd) {
 368         $word =~ s#{}#$name#g;
 369     }
 370     if ($ok) {
 371         local($old) = select(STDOUT);
 372         $| = 1;
 373         print "@cmd";
 374         select($old);
 375         return 0 unless <STDIN> =~ /^y/;
 376     }
 377     chdir $cwd;         # sigh
 378     system @cmd;
 379     chdir $dir;
 380     return !$?;
 381 }
 382
 383 END
 384 }
 385
 386 if ($initls) {
 387     print <<'END';
 388 sub ls {
 389     ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$sizemm,
 390       $atime,$mtime,$ctime,$blksize,$blocks) = lstat(_);
 391
 392     $pname = $name;
 393
 394     if (defined $blocks) {
 395         $blocks = int(($blocks + 1) / 2);
 396     }
 397     else {
 398         $blocks = int(($size + 1023) / 1024);
 399     }
 400
 401     if    (-f _) { $perms = '-'; }
 402     elsif (-d _) { $perms = 'd'; }
 403     elsif (-c _) { $perms = 'c'; $sizemm = &sizemm; }
 404     elsif (-b _) { $perms = 'b'; $sizemm = &sizemm; }
 405     elsif (-p _) { $perms = 'p'; }
 406     elsif (-S _) { $perms = 's'; }
 407     else         { $perms = 'l'; $pname .= ' -> ' . readlink($_); }
 408
 409     $tmpmode = $mode;
 410     $tmp = $rwx[$tmpmode & 7];
 411     $tmpmode >>= 3;
 412     $tmp = $rwx[$tmpmode & 7] . $tmp;
 413     $tmpmode >>= 3;
 414     $tmp = $rwx[$tmpmode & 7] . $tmp;
 415     substr($tmp,2,1) =~ tr/-x/Ss/ if -u _;
 416     substr($tmp,5,1) =~ tr/-x/Ss/ if -g _;
 417     substr($tmp,8,1) =~ tr/-x/Tt/ if -k _;
 418     $perms .= $tmp;
 419
 420     $user = $user{$uid} || $uid;
 421     $group = $group{$gid} || $gid;
 422
 423     ($sec,$min,$hour,$mday,$mon,$year) = localtime($mtime);
 424     $moname = $moname[$mon];
 425     if (-M _ > 365.25 / 2) {
 426         $timeyear = '19' . $year;
 427     }
 428     else {
 429         $timeyear = sprintf("%02d:%02d", $hour, $min);
 430     }
 431
 432     printf "%5lu %4ld %-10s %2d %-8s %-8s %8s %s %2d %5s %s\n",
 433             $ino,
 434                  $blocks,
 435                       $perms,
 436                             $nlink,
 437                                 $user,
 438                                      $group,
 439                                           $sizemm,
 440                                               $moname,
 441                                                  $mday,
 442                                                      $timeyear,
 443                                                          $pname;
 444     1;
 445 }
 446
 447 sub sizemm {
 448     sprintf("%3d, %3d", ($rdev >> 8) & 255, $rdev & 255);
 449 }
 450
 451 END
 452 }
 453
 454 if ($initcpio) {
 455 print <<'END';
 456 sub cpio {
 457     local($nc,$fh) = @_;
 458     local($text);
 459
 460     if ($name eq 'TRAILER!!!') {
 461         $text = '';
 462         $size = 0;
 463     }
 464     else {
 465         ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
 466           $atime,$mtime,$ctime,$blksize,$blocks) = lstat(_);
 467         if (-f _) {
 468             open(IN, $_) || do {
 469                 warn "Couldn't open $name: $!\n";
 470                 return;
 471             };
 472         }
 473         else {
 474             $text = readlink($_);
 475             $size = 0 unless defined $text;
 476         }
 477     }
 478
 479     ($nm = $name) =~ s#^\./##;
 480     $nc{$fh} = $nc;
 481     if ($nc eq 'n') {
 482         $cpout{$fh} .=
 483           sprintf("%06o%06o%06o%06o%06o%06o%06o%06o%011lo%06o%011lo%s\0",
 484             070707,
 485             $dev & 0777777,
 486             $ino & 0777777,
 487             $mode & 0777777,
 488             $uid & 0777777,
 489             $gid & 0777777,
 490             $nlink & 0777777,
 491             $rdev & 0177777,
 492             $mtime,
 493             length($nm)+1,
 494             $size,
 495             $nm);
 496     }
 497     else {
 498         $cpout{$fh} .= "\0" if length($cpout{$fh}) & 1;
 499         $cpout{$fh} .= pack("SSSSSSSSLSLa*",
 500             070707, $dev, $ino, $mode, $uid, $gid, $nlink, $rdev, $mtime,
 501             length($nm)+1, $size, $nm . (length($nm) & 1 ? "\0" : "\0\0"));
 502     }
 503     if ($text ne '') {
 504         $cpout{$fh} .= $text;
 505     }
 506     elsif ($size) {
 507         &flush($fh) while ($l = length($cpout{$fh})) >= 5120;
 508         while (sysread(IN, $cpout{$fh}, 5120 - $l, $l)) {
 509             &flush($fh);
 510             $l = length($cpout{$fh});
 511         }
 512     }
 513     close IN;
 514 }
 515
 516 sub flush {
 517     local($fh) = @_;
 518
 519     while (length($cpout{$fh}) >= 5120) {
 520         syswrite($fh,$cpout{$fh},5120);
 521         ++$blocks{$fh};
 522         substr($cpout{$fh}, 0, 5120) = '';
 523     }
 524 }
 525
 526 sub flushall {
 527     $name = 'TRAILER!!!';
 528     foreach $fh (keys %cpout) {
 529         &cpio($nc{$fh},$fh);
 530         $cpout{$fh} .= "0" x (5120 - length($cpout{$fh}));
 531         &flush($fh);
 532         print $blocks{$fh} * 10, " blocks\n";
 533     }
 534 }
 535
 536 END
 537 }
 538
 539 if ($inittar) {
 540 print <<'END';
 541 sub tar {
 542     local($fh) = @_;
 543     local($linkname,$header,$l,$slop);
 544     local($linkflag) = "\0";
 545
 546     ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
 547       $atime,$mtime,$ctime,$blksize,$blocks) = lstat(_);
 548     $nm = $name;
 549     if ($nlink > 1) {
 550         if ($linkname = $linkseen{$fh,$dev,$ino}) {
 551             $linkflag = 1;
 552         }
 553         else {
 554             $linkseen{$fh,$dev,$ino} = $nm;
 555         }
 556     }
 557     if (-f _) {
 558         open(IN, $_) || do {
 559             warn "Couldn't open $name: $!\n";
 560             return;
 561         };
 562         $size = 0 if $linkflag ne "\0";
 563     }
 564     else {
 565         $linkname = readlink($_);
 566         $linkflag = 2 if defined $linkname;
 567         $nm .= '/' if -d _;
 568         $size = 0;
 569     }
 570
 571     $header = pack("a100a8a8a8a12a12a8a1a100",
 572         $nm,
 573         sprintf("%6o ", $mode & 0777),
 574         sprintf("%6o ", $uid & 0777777),
 575         sprintf("%6o ", $gid & 0777777),
 576         sprintf("%11o ", $size),
 577         sprintf("%11o ", $mtime),
 578         "        ",
 579         $linkflag,
 580         $linkname);
 581     $l = length($header) % 512;
 582     substr($header, 148, 6) = sprintf("%6o", unpack("%16C*", $header));
 583     substr($header, 154, 1) = "\0";  # blech
 584     $tarout{$fh} .= $header;
 585     $tarout{$fh} .= "\0" x (512 - $l) if $l;
 586     if ($size) {
 587         &tflush($fh) while ($l = length($tarout{$fh})) >= 10240;
 588         while (sysread(IN, $tarout{$fh}, 10240 - $l, $l)) {
 589             $slop = length($tarout{$fh}) % 512;
 590             $tarout{$fh} .= "\0" x (512 - $slop) if $slop;
 591             &tflush($fh);
 592             $l = length($tarout{$fh});
 593         }
 594     }
 595     close IN;
 596 }
 597
 598 sub tflush {
 599     local($fh) = @_;
 600
 601     while (length($tarout{$fh}) >= 10240) {
 602         syswrite($fh,$tarout{$fh},10240);
 603         ++$blocks{$fh};
 604         substr($tarout{$fh}, 0, 10240) = '';
 605     }
 606 }
 607
 608 sub tflushall {
 609     local($len);
 610
 611     foreach $fh (keys %tarout) {
 612         $len = 10240 - length($tarout{$fh});
 613         $len += 10240 if $len < 1024;
 614         $tarout{$fh} .= "\0" x $len;
 615         &tflush($fh);
 616     }
 617 }
 618
 619 END
 620 }
 621
 622 exit;
 623
 624 ############################################################################
 625
 626 sub tab {
 627     local($tabstring);
 628
 629     $tabstring = "\t" x ($indent / 2) . ' ' x ($indent % 2 * 4);
 630     if ($_ !~ /^(name|print)/) {
 631         if (!$statdone) {
 632             $tabstring .= <<'ENDOFSTAT' . $tabstring;
 633 (($dev,$ino,$mode,$nlink,$uid,$gid) = lstat($_)) &&
 634 ENDOFSTAT
 635             $statdone = 1;
 636         }
 637     }
 638     $tabstring =~ s/^\s+/ / if $out =~ /!$/;
 639     $tabstring;
 640 }
 641
 642 sub fileglob_to_re {
 643     local($tmp) = @_;
 644
 645     $tmp =~ s/([.^\$()])/\\$1/g;
 646     $tmp =~ s/([?*])/.$1/g;
 647     "^$tmp$";
 648 }
 649
 650 sub n {
 651     local($n) = @_;
 652
 653     $n =~ s/^-0*/< / || $n =~ s/^\+0*/> / || $n =~ s/^0*/== /;
 654     $n;
 655 }
 656
 657 sub quote {
 658     local($string) = @_;
 659     $string =~ s/'/\\'/;
 660     "'$string'";
 661 }
 662 !NO!SUBS!
 663 chmod 755 find2perl
 664 $eunicefix find2perl