home *** CD-ROM | disk | FTP | other *** search
/ The World of Computer Software / World_Of_Computer_Software-02-387-Vol-3of3.iso / p / perl4036.zip / x2p / find2perl.SH < prev    next >
Text File  |  1993-02-08  |  13KB  |  599 lines
  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) { $_ = "e($_); }
  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 " . "e($file) . ";\n";
  178.     }
  179.     elsif ($_ eq 'eval') {
  180.     $prog = "e(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, " . "e($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, " . "e($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
  599.