home *** CD-ROM | disk | FTP | other *** search
/ Chip: Windows 2000 Professional Resource Kit / W2KPRK.iso / apps / perl / ActivePerl.exe / data.z / find2perl.bat < prev    next >
Encoding:
DOS Batch File  |  1999-10-16  |  13.6 KB  |  603 lines
  1. @rem = '--*-Perl-*--
  2. @echo off
  3. if "%OS%" == "Windows_NT" goto WinNT
  4. perl -x -S "%0" %1 %2 %3 %4 %5 %6 %7 %8 %9
  5. goto endofperl
  6. :WinNT
  7. perl -x -S "%0" %*
  8. if NOT "%COMSPEC%" == "%SystemRoot%\system32\cmd.exe" goto endofperl
  9. if %errorlevel% == 9009 echo You do not have Perl in your PATH.
  10. goto endofperl
  11. @rem ';
  12. #!perl
  13. #line 14
  14.     eval 'exec P:\Apps\ActivePerl\temp\bin\MSWin32-x86-object\perl.exe -S $0 ${1+"$@"}'
  15.       if $running_under_some_shell;
  16. $startperl = "#!perl";
  17. $perlpath = "P:\Apps\ActivePerl\temp\bin\MSWin32-x86-object\perl.exe";
  18.  
  19. # 
  20. # Modified September 26, 1993 to provide proper handling of years after 1999
  21. #   Tom Link <tml+@pitt.edu>
  22. #   University of Pittsburgh
  23. # 
  24. # Modified April 7, 1998 with nasty hacks to implement the troublesome -follow
  25. #  Billy Constantine <wdconsta@cs.adelaide.edu.au> <billy@smug.adelaide.edu.au>
  26. #  University of Adelaide, Adelaide, South Australia
  27. # 
  28.  
  29. while ($ARGV[0] =~ /^[^-!(]/) {
  30.     push(@roots, shift);
  31. }
  32. @roots = ('.') unless @roots;
  33. for (@roots) { $_ = "e($_); }
  34. $roots = join(',', @roots);
  35.  
  36. $indent = 1;
  37. $stat = 'lstat';
  38. $decl = '';
  39.  
  40. while (@ARGV) {
  41.     $_ = shift;
  42.     s/^-// || /^[()!]/ || die "Unrecognized switch: $_\n";
  43.     if ($_ eq '(') {
  44.     $out .= &tab . "(\n";
  45.     $indent++;
  46.     next;
  47.     }
  48.     elsif ($_ eq ')') {
  49.     $indent--;
  50.     $out .= &tab . ")";
  51.     }
  52.     elsif ($_ eq 'follow') {
  53.     $stat = 'stat';
  54.     $decl = '%already_seen = ();';
  55.     $out .= &tab . '(not $already_seen{"$dev,$ino"}) &&';
  56.     $out .= "\n" . &tab . '(($already_seen{"$dev,$ino"} = !(-d _)) || 1)';
  57.     }
  58.     elsif ($_ eq '!') {
  59.     $out .= &tab . "!";
  60.     next;
  61.     }
  62.     elsif ($_ eq 'name') {
  63.     $out .= &tab;
  64.     $pat = &fileglob_to_re(shift);
  65.     $out .= '/' . $pat . "/";
  66.     }
  67.     elsif ($_ eq 'perm') {
  68.     $onum = shift;
  69.     die "Malformed -perm argument: $onum\n" unless $onum =~ /^-?[0-7]+$/;
  70.     if ($onum =~ s/^-//) {
  71.         $onum = '0' . sprintf("%o", oct($onum) & 017777);    # s/b 07777 ?
  72.         $out .= &tab . "((\$mode & $onum) == $onum)";
  73.     }
  74.     else {
  75.         $onum = '0' . $onum unless $onum =~ /^0/;
  76.         $out .= &tab . "((\$mode & 0777) == $onum)";
  77.     }
  78.     }
  79.     elsif ($_ eq 'type') {
  80.     ($filetest = shift) =~ tr/s/S/;
  81.     $out .= &tab . "-$filetest _";
  82.     }
  83.     elsif ($_ eq 'print') {
  84.     $out .= &tab . 'print("$name\n")';
  85.     }
  86.     elsif ($_ eq 'print0') {
  87.     $out .= &tab . 'print("$name\0")';
  88.     }
  89.     elsif ($_ eq 'fstype') {
  90.     $out .= &tab;
  91.     $type = shift;
  92.     if ($type eq 'nfs')
  93.         { $out .= '($dev < 0)'; }
  94.     else
  95.         { $out .= '($dev >= 0)'; }
  96.     }
  97.     elsif ($_ eq 'user') {
  98.     $uname = shift;
  99.     $out .= &tab . "(\$uid == \$uid{'$uname'})";
  100.     $inituser++;
  101.     }
  102.     elsif ($_ eq 'group') {
  103.     $gname = shift;
  104.     $out .= &tab . "(\$gid == \$gid{'$gname'})";
  105.     $initgroup++;
  106.     }
  107.     elsif ($_ eq 'nouser') {
  108.     $out .= &tab . '!defined $uid{$uid}';
  109.     $inituser++;
  110.     }
  111.     elsif ($_ eq 'nogroup') {
  112.     $out .= &tab . '!defined $gid{$gid}';
  113.     $initgroup++;
  114.     }
  115.     elsif ($_ eq 'links') {
  116.     $out .= &tab . '($nlink ' . &n(shift);
  117.     }
  118.     elsif ($_ eq 'inum') {
  119.     $out .= &tab . '($ino ' . &n(shift);
  120.     }
  121.     elsif ($_ eq 'size') {
  122.     $out .= &tab . '(int(((-s _) + 511) / 512) ' . &n(shift);
  123.     }
  124.     elsif ($_ eq 'atime') {
  125.     $out .= &tab . '(int(-A _) ' . &n(shift);
  126.     }
  127.     elsif ($_ eq 'mtime') {
  128.     $out .= &tab . '(int(-M _) ' . &n(shift);
  129.     }
  130.     elsif ($_ eq 'ctime') {
  131.     $out .= &tab . '(int(-C _) ' . &n(shift);
  132.     }
  133.     elsif ($_ eq 'exec') {
  134.     for (@cmd = (); @ARGV && $ARGV[0] ne ';'; push(@cmd,shift)) { }
  135.     shift;
  136.     $_ = "@cmd";
  137.     if (m#^(/bin/)?rm -f {}$#) {
  138.         if (!@ARGV) {
  139.         $out .= &tab . 'unlink($_)';
  140.         }
  141.         else {
  142.         $out .= &tab . '(unlink($_) || 1)';
  143.         }
  144.     }
  145.     elsif (m#^(/bin/)?rm {}$#) {
  146.         $out .= &tab . '(unlink($_) || warn "$name: $!\n")';
  147.     }
  148.     else {
  149.         for (@cmd) { s/'/\\'/g; }
  150.         $" = "','";
  151.         $out .= &tab . "&exec(0, '@cmd')";
  152.         $" = ' ';
  153.         $initexec++;
  154.     }
  155.     }
  156.     elsif ($_ eq 'ok') {
  157.     for (@cmd = (); @ARGV && $ARGV[0] ne ';'; push(@cmd,shift)) { }
  158.     shift;
  159.     for (@cmd) { s/'/\\'/g; }
  160.     $" = "','";
  161.     $out .= &tab . "&exec(1, '@cmd')";
  162.     $" = ' ';
  163.     $initexec++;
  164.     }
  165.     elsif ($_ eq 'prune') {
  166.     $out .= &tab . '($prune = 1)';
  167.     }
  168.     elsif ($_ eq 'xdev') {
  169.     $out .= &tab . '!($prune |= ($dev != $topdev))';
  170.     }
  171.     elsif ($_ eq 'newer') {
  172.     $out .= &tab;
  173.     $file = shift;
  174.     $newername = 'AGE_OF' . $file;
  175.     $newername =~ s/[^\w]/_/g;
  176.     $newername = "\$$newername";
  177.     $out .= "(-M _ < $newername)";
  178.     $initnewer .= "$newername = -M " . "e($file) . ";\n";
  179.     }
  180.     elsif ($_ eq 'eval') {
  181.     $prog = "e(shift);
  182.     $out .= &tab . "eval $prog";
  183.     }
  184.     elsif ($_ eq 'depth') {
  185.     $depth++;
  186.     next;
  187.     }
  188.     elsif ($_ eq 'ls') {
  189.     $out .= &tab . "&ls";
  190.     $initls++;
  191.     }
  192.     elsif ($_ eq 'tar') {
  193.     $out .= &tab;
  194.     die "-tar must have a filename argument\n" unless @ARGV;
  195.     $file = shift;
  196.     $fh = 'FH' . $file;
  197.     $fh =~ s/[^\w]/_/g;
  198.     $out .= "&tar($fh)";
  199.     $file = '>' . $file;
  200.     $initfile .= "open($fh, " . "e($file) .
  201.       qq{) || die "Can't open $fh: \$!\\n";\n};
  202.     $inittar++;
  203.     $flushall = "\n&tflushall;\n";
  204.     }
  205.     elsif (/^n?cpio$/) {
  206.     $depth++;
  207.     $out .= &tab;
  208.     die "-$_ must have a filename argument\n" unless @ARGV;
  209.     $file = shift;
  210.     $fh = 'FH' . $file;
  211.     $fh =~ s/[^\w]/_/g;
  212.     $out .= "&cpio('" . substr($_,0,1) . "', $fh)";
  213.     $file = '>' . $file;
  214.     $initfile .= "open($fh, " . "e($file) .
  215.       qq{) || die "Can't open $fh: \$!\\n";\n};
  216.     $initcpio++;
  217.     $flushall = "\n&flushall;\n";
  218.     }
  219.     else {
  220.     die "Unrecognized switch: -$_\n";
  221.     }
  222.     if (@ARGV) {
  223.     if ($ARGV[0] eq '-o') {
  224.         { local($statdone) = 1; $out .= "\n" . &tab . "||\n"; }
  225.         $statdone = 0 if $indent == 1 && $delayedstat;
  226.         $saw_or++;
  227.         shift;
  228.     }
  229.     else {
  230.         $out .= " &&" unless $ARGV[0] eq ')';
  231.         $out .= "\n";
  232.         shift if $ARGV[0] eq '-a';
  233.     }
  234.     }
  235. }
  236.  
  237. print <<"END";
  238. $startperl
  239.     eval 'exec $perlpath -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. $decl
  277. &$find($roots);
  278. $flushall
  279. exit;
  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 <<"INTERP", <<'END';
  311. sub ls {
  312.     (\$dev,\$ino,\$mode,\$nlink,\$uid,\$gid,\$rdev,\$sizemm,
  313.       \$atime,\$mtime,\$ctime,\$blksize,\$blocks) = $stat\(_\);
  314. INTERP
  315.  
  316.     $pname = $name;
  317.  
  318.     if (defined $blocks) {
  319.     $blocks = int(($blocks + 1) / 2);
  320.     }
  321.     else {
  322.     $blocks = int(($size + 1023) / 1024);
  323.     }
  324.  
  325.     if    (-f _) { $perms = '-'; }
  326.     elsif (-d _) { $perms = 'd'; }
  327.     elsif (-c _) { $perms = 'c'; $sizemm = &sizemm; }
  328.     elsif (-b _) { $perms = 'b'; $sizemm = &sizemm; }
  329.     elsif (-p _) { $perms = 'p'; }
  330.     elsif (-S _) { $perms = 's'; }
  331.     else         { $perms = 'l'; $pname .= ' -> ' . readlink($_); }
  332.  
  333.     $tmpmode = $mode;
  334.     $tmp = $rwx[$tmpmode & 7];
  335.     $tmpmode >>= 3;
  336.     $tmp = $rwx[$tmpmode & 7] . $tmp;
  337.     $tmpmode >>= 3;
  338.     $tmp = $rwx[$tmpmode & 7] . $tmp;
  339.     substr($tmp,2,1) =~ tr/-x/Ss/ if -u _;
  340.     substr($tmp,5,1) =~ tr/-x/Ss/ if -g _;
  341.     substr($tmp,8,1) =~ tr/-x/Tt/ if -k _;
  342.     $perms .= $tmp;
  343.  
  344.     $user = $user{$uid} || $uid;
  345.     $group = $group{$gid} || $gid;
  346.  
  347.     ($sec,$min,$hour,$mday,$mon,$year) = localtime($mtime);
  348.     $moname = $moname[$mon];
  349.     if (-M _ > 365.25 / 2) {
  350.     $timeyear = $year + 1900;
  351.     }
  352.     else {
  353.     $timeyear = sprintf("%02d:%02d", $hour, $min);
  354.     }
  355.  
  356.     printf "%5lu %4ld %-10s %2d %-8s %-8s %8s %s %2d %5s %s\n",
  357.         $ino,
  358.          $blocks,
  359.               $perms,
  360.                 $nlink,
  361.                 $user,
  362.                      $group,
  363.                       $sizemm,
  364.                           $moname,
  365.                          $mday,
  366.                              $timeyear,
  367.                              $pname;
  368.     1;
  369. }
  370.  
  371. sub sizemm {
  372.     sprintf("%3d, %3d", ($rdev >> 8) & 255, $rdev & 255);
  373. }
  374.  
  375. END
  376. }
  377.  
  378. if ($initcpio) {
  379. print <<'START', <<"INTERP", <<'END';
  380. sub cpio {
  381.     local($nc,$fh) = @_;
  382.     local($text);
  383.  
  384.     if ($name eq 'TRAILER!!!') {
  385.     $text = '';
  386.     $size = 0;
  387.     }
  388.     else {
  389. START
  390.     (\$dev,\$ino,\$mode,\$nlink,\$uid,\$gid,\$rdev,\$size,
  391.       \$atime,\$mtime,\$ctime,\$blksize,\$blocks) = $stat\(_\);
  392. INTERP
  393.     if (-f _) {
  394.         open(IN, "./$_\0") || do {
  395.         warn "Couldn't open $name: $!\n";
  396.         return;
  397.         };
  398.     }
  399.     else {
  400.         $text = readlink($_);
  401.         $size = 0 unless defined $text;
  402.     }
  403.     }
  404.  
  405.     ($nm = $name) =~ s#^\./##;
  406.     $nc{$fh} = $nc;
  407.     if ($nc eq 'n') {
  408.     $cpout{$fh} .=
  409.       sprintf("%06o%06o%06o%06o%06o%06o%06o%06o%011lo%06o%011lo%s\0",
  410.         070707,
  411.         $dev & 0777777,
  412.         $ino & 0777777,
  413.         $mode & 0777777,
  414.         $uid & 0777777,
  415.         $gid & 0777777,
  416.         $nlink & 0777777,
  417.         $rdev & 0177777,
  418.         $mtime,
  419.         length($nm)+1,
  420.         $size,
  421.         $nm);
  422.     }
  423.     else {
  424.     $cpout{$fh} .= "\0" if length($cpout{$fh}) & 1;
  425.     $cpout{$fh} .= pack("SSSSSSSSLSLa*",
  426.         070707, $dev, $ino, $mode, $uid, $gid, $nlink, $rdev, $mtime,
  427.         length($nm)+1, $size, $nm . (length($nm) & 1 ? "\0" : "\0\0"));
  428.     }
  429.     if ($text ne '') {
  430.     $cpout{$fh} .= $text;
  431.     }
  432.     elsif ($size) {
  433.     &flush($fh) while ($l = length($cpout{$fh})) >= 5120;
  434.     while (sysread(IN, $cpout{$fh}, 5120 - $l, $l)) {
  435.         &flush($fh);
  436.         $l = length($cpout{$fh});
  437.     }
  438.     }
  439.     close IN;
  440. }
  441.  
  442. sub flush {
  443.     local($fh) = @_;
  444.  
  445.     while (length($cpout{$fh}) >= 5120) {
  446.     syswrite($fh,$cpout{$fh},5120);
  447.     ++$blocks{$fh};
  448.     substr($cpout{$fh}, 0, 5120) = '';
  449.     }
  450. }
  451.  
  452. sub flushall {
  453.     $name = 'TRAILER!!!';
  454.     foreach $fh (keys %cpout) {
  455.     &cpio($nc{$fh},$fh);
  456.     $cpout{$fh} .= "0" x (5120 - length($cpout{$fh}));
  457.     &flush($fh);
  458.     print $blocks{$fh} * 10, " blocks\n";
  459.     }
  460. }
  461.  
  462. END
  463. }
  464.  
  465. if ($inittar) {
  466. print <<'START', <<"INTERP", <<'END';
  467. sub tar {
  468.     local($fh) = @_;
  469.     local($linkname,$header,$l,$slop);
  470.     local($linkflag) = "\0";
  471.  
  472. START
  473.     (\$dev,\$ino,\$mode,\$nlink,\$uid,\$gid,\$rdev,\$size,
  474.       \$atime,\$mtime,\$ctime,\$blksize,\$blocks) = $stat\(_\);
  475. INTERP
  476.     $nm = $name;
  477.     if ($nlink > 1) {
  478.     if ($linkname = $linkseen{$fh,$dev,$ino}) {
  479.         $linkflag = 1;
  480.     }
  481.     else {
  482.         $linkseen{$fh,$dev,$ino} = $nm;
  483.     }
  484.     }
  485.     if (-f _) {
  486.     open(IN, "./$_\0") || do {
  487.         warn "Couldn't open $name: $!\n";
  488.         return;
  489.     };
  490.     $size = 0 if $linkflag ne "\0";
  491.     }
  492.     else {
  493.     $linkname = readlink($_);
  494.     $linkflag = 2 if defined $linkname;
  495.     $nm .= '/' if -d _;
  496.     $size = 0;
  497.     }
  498.  
  499.     $header = pack("a100a8a8a8a12a12a8a1a100",
  500.     $nm,
  501.     sprintf("%6o ", $mode & 0777),
  502.     sprintf("%6o ", $uid & 0777777),
  503.     sprintf("%6o ", $gid & 0777777),
  504.     sprintf("%11o ", $size),
  505.     sprintf("%11o ", $mtime),
  506.     "        ",
  507.     $linkflag,
  508.     $linkname);
  509.     $l = length($header) % 512;
  510.     substr($header, 148, 6) = sprintf("%6o", unpack("%16C*", $header));
  511.     substr($header, 154, 1) = "\0";  # blech
  512.     $tarout{$fh} .= $header;
  513.     $tarout{$fh} .= "\0" x (512 - $l) if $l;
  514.     if ($size) {
  515.     &tflush($fh) while ($l = length($tarout{$fh})) >= 10240;
  516.     while (sysread(IN, $tarout{$fh}, 10240 - $l, $l)) {
  517.         $slop = length($tarout{$fh}) % 512;
  518.         $tarout{$fh} .= "\0" x (512 - $slop) if $slop;
  519.         &tflush($fh);
  520.         $l = length($tarout{$fh});
  521.     }
  522.     }
  523.     close IN;
  524. }
  525.  
  526. sub tflush {
  527.     local($fh) = @_;
  528.  
  529.     while (length($tarout{$fh}) >= 10240) {
  530.     syswrite($fh,$tarout{$fh},10240);
  531.     ++$blocks{$fh};
  532.     substr($tarout{$fh}, 0, 10240) = '';
  533.     }
  534. }
  535.  
  536. sub tflushall {
  537.     local($len);
  538.  
  539.     foreach $fh (keys %tarout) {
  540.     $len = 10240 - length($tarout{$fh});
  541.     $len += 10240 if $len < 1024;
  542.     $tarout{$fh} .= "\0" x $len;
  543.     &tflush($fh);
  544.     }
  545. }
  546.  
  547. END
  548. }
  549.  
  550. exit;
  551.  
  552. ############################################################################
  553.  
  554. sub tab {
  555.     local($tabstring);
  556.  
  557.     $tabstring = "\t" x ($indent / 2) . ' ' x ($indent % 2 * 4);
  558.     if (!$statdone) {
  559.     if ($_ =~ /^(name|print|prune|exec|ok|\(|\))/) {
  560.         $delayedstat++;
  561.     }
  562.     else {
  563.         if ($saw_or) {
  564.         $tabstring .= <<"ENDOFSTAT" . $tabstring;
  565. (\$nlink || ((\$dev,\$ino,\$mode,\$nlink,\$uid,\$gid) = $stat\(\$_\))) &&
  566. ENDOFSTAT
  567.         }
  568.         else {
  569.         $tabstring .= <<"ENDOFSTAT" . $tabstring;
  570. ((\$dev,\$ino,\$mode,\$nlink,\$uid,\$gid) = $stat\(\$_\)) &&
  571. ENDOFSTAT
  572.         }
  573.         $statdone = 1;
  574.     }
  575.     }
  576.     $tabstring =~ s/^\s+/ / if $out =~ /!$/;
  577.     $tabstring;
  578. }
  579.  
  580. sub fileglob_to_re {
  581.     local($tmp) = @_;
  582.  
  583.     $tmp =~ s#([./^\$()])#\\$1#g;
  584.     $tmp =~ s/([?*])/.$1/g;
  585.     "^$tmp\$";
  586. }
  587.  
  588. sub n {
  589.     local($n) = @_;
  590.  
  591.     $n =~ s/^-/< / || $n =~ s/^\+/> / || $n =~ s/^/== /;
  592.     $n =~ s/ 0*(\d)/ $1/;
  593.     $n . ')';
  594. }
  595.  
  596. sub quote {
  597.     local($string) = @_;
  598.     $string =~ s/'/\\'/;
  599.     "'$string'";
  600. }
  601. __END__
  602. :endofperl
  603.