3 if test ! -f config.sh; then
5 ln ../../config.sh . || \
6 ln ../../../config.sh . || \
7 (echo "Can't find config.sh."; exit 1)
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.
15 */*) cd `expr X$0 : 'X\(.*\)/'` ;;
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!
29 : In the following dollars and backticks do not need the extra backslash.
30 $spitshell >>find2perl <<'!NO!SUBS!'
32 while ($ARGV[0] =~ /^[^-!(]/) {
35 @roots = ('.') unless @roots;
36 for (@roots) { $_ = "e($_); }
37 $roots = join(',', @roots);
43 s/^-// || /^[()!]/ || die "Unrecognized switch: $_\n";
57 elsif ($_ eq 'name') {
59 $pat = &fileglob_to_re(shift);
60 $out .= '/' . $pat . "/";
62 elsif ($_ eq 'perm') {
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";
70 $onum = '0' . $onum unless $onum =~ /^0/;
71 $out .= &tab . "(\$mode & 0777) == $onum";
74 elsif ($_ eq 'type') {
75 ($filetest = shift) =~ tr/s/S/;
76 $out .= &tab . "-$filetest _";
78 elsif ($_ eq 'print') {
79 $out .= &tab . 'print("$name\n")';
81 elsif ($_ eq 'print0') {
82 $out .= &tab . 'print("$name\0")';
84 elsif ($_ eq 'fstype') {
88 { $out .= '$dev < 0'; }
90 { $out .= '$dev >= 0'; }
92 elsif ($_ eq 'user') {
94 $out .= &tab . "\$uid == \$uid{'$uname'}";
97 elsif ($_ eq 'group') {
99 $out .= &tab . "\$gid == \$gid('$gname')";
102 elsif ($_ eq 'nouser') {
103 $out .= &tab . '!defined $uid{$uid}';
106 elsif ($_ eq 'nogroup') {
107 $out .= &tab . '!defined $gid{$gid}';
110 elsif ($_ eq 'links') {
111 $out .= &tab . '$nlink ' . &n(shift);
113 elsif ($_ eq 'inum') {
114 $out .= &tab . '$ino ' . &n(shift);
116 elsif ($_ eq 'size') {
117 $out .= &tab . 'int((-s _ + 511) / 512) ' . &n(shift);
119 elsif ($_ eq 'atime') {
120 $out .= &tab . 'int(-A _) ' . &n(shift);
122 elsif ($_ eq 'mtime') {
123 $out .= &tab . 'int(-M _) ' . &n(shift);
125 elsif ($_ eq 'ctime') {
126 $out .= &tab . 'int(-C _) ' . &n(shift);
128 elsif ($_ eq 'exec') {
129 for (@cmd = (); @ARGV && $ARGV[0] ne ';'; push(@cmd,shift)) { }
131 for (@cmd) { s/'/\\'/g; }
133 $out .= &tab . "&exec(0, '@cmd')";
138 for (@cmd = (); @ARGV && $ARGV[0] ne ';'; push(@cmd,shift)) { }
140 for (@cmd) { s/'/\\'/g; }
142 $out .= &tab . "&exec(1, '@cmd')";
146 elsif ($_ eq 'prune') {
147 $out .= &tab . '($prune = 1)';
149 elsif ($_ eq 'xdev') {
150 $out .= &tab . '(($prune |= ($dev != $topdev)),1)';
152 elsif ($_ eq 'newer') {
155 $newername = 'AGE_OF' . $file;
156 $newername =~ s/[^\w]/_/g;
157 $newername = '$' . $newername;
158 $out .= "-M _ < $newername";
159 $initnewer .= "$newername = -M " . "e($file) . ";\n";
161 elsif ($_ eq 'eval') {
162 $prog = "e(shift);
163 $out .= &tab . "eval $prog";
165 elsif ($_ eq 'depth') {
170 $out .= &tab . "&ls";
173 elsif ($_ eq 'tar') {
175 die "-tar must have a filename argument\n" unless @ARGV;
181 $initfile .= "open($fh, " . "e($file) .
182 qq{) || die "Can't open $fh: \$!\\n";\n};
184 $flushall = "\n&tflushall;\n";
189 die "-$_ must have a filename argument\n" unless @ARGV;
193 $out .= "&cpio('" . substr($_,0,1) . "', $fh)";
195 $initfile .= "open($fh, " . "e($file) .
196 qq{) || die "Can't open $fh: \$!\\n";\n};
198 $flushall = "\n&flushall;\n";
201 die "Unrecognized switch: -$_\n";
204 if ($ARGV[0] eq '-o') {
205 $statdone = 0 if $indent == 1 && $delayedstat;
207 $out .= "\n" . &tab . "||\n";
211 $out .= " &&" unless $ARGV[0] eq ')';
213 shift if $ARGV[0] eq '-a';
225 @rwx = ('---','--x','-w-','-wx','r--','r-x','rw-','rwx');
226 @moname = (Jan,Feb,Mar,Apr,May,Jun,Jul,Aug,Sep,Oct,Nov,Dec);
231 if ($inituser || $initls) {
232 print 'while (($name, $pw, $uid) = getpwent) {', "\n";
233 print ' $uid{$name} = $uid{$uid} = $uid;', "\n" if $inituser;
234 print ' $user{$uid} = $name unless $user{$uid};', "\n" if $initls;
238 if ($initgroup || $initls) {
239 print 'while (($name, $pw, $gid) = getgrent) {', "\n";
240 print ' $gid{$name} = $gid{$gid} = $gid;', "\n" if $initgroup;
241 print ' $group{$gid} = $name unless $group{$gid};', "\n" if $initls;
245 print $initnewer, "\n" if $initnewer;
247 print $initfile, "\n" if $initfile;
250 # Traverse desired filesystems
265 foreach $topdir (@_) {
266 (($topdev,$topino,$topmode,$topnlink) = stat($topdir))
267 || (warn("Can't stat $topdir: $!\n"), next);
269 if (chdir($topdir)) {
273 $topdir = '' if $topdir eq '/';
274 &dodir($topdir,$topnlink);
275 ($dir,$_) = ($topdir,'.');
282 ($dir,$_) = ($topdir,'.');
285 $topdir = '' if $topdir eq '/';
286 &dodir($topdir,$topnlink);
292 warn "Can't cd to $topdir: $!\n";
296 unless (($dir,$_) = $topdir =~ m#^(.*/)(.*)$#) {
297 ($dir,$_) = ('.', $topdir);
299 chdir $dir && &wanted;
306 local($dir,$nlink) = @_;
307 local($dev,$ino,$mode,$subcount);
310 # Get the list of files in the current directory.
312 opendir(DIR,'.') || warn "Can't open $dir: $!\n";
313 local(@filenames) = readdir(DIR);
316 if ($nlink == 2) { # This dir has no subdirectories.
325 else { # This dir has subdirectories.
326 $subcount = $nlink - 2;
333 print <<'END' unless $depth;
337 if ($subcount > 0) { # Seen all the subdirs?
339 # Get link count and check for directoriness.
341 ($dev,$ino,$mode,$nlink) = lstat($_) unless $nlink;
345 # It really is a directory, so do it recursively.
347 if (!$prune && chdir $_) {
348 &dodir($name,$nlink);
355 print <<'END' if $depth;
368 local($ok, @cmd) = @_;
369 foreach $word (@cmd) {
370 $word =~ s#{}#$name#g;
373 local($old) = select(STDOUT);
377 return 0 unless <STDIN> =~ /^y/;
391 ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$sizemm,
392 $atime,$mtime,$ctime,$blksize,$blocks) = lstat(_);
396 if (defined $blocks) {
397 $blocks = int(($blocks + 1) / 2);
400 $blocks = int(($size + 1023) / 1024);
403 if (-f _) { $perms = '-'; }
404 elsif (-d _) { $perms = 'd'; }
405 elsif (-c _) { $perms = 'c'; $sizemm = &sizemm; }
406 elsif (-b _) { $perms = 'b'; $sizemm = &sizemm; }
407 elsif (-p _) { $perms = 'p'; }
408 elsif (-S _) { $perms = 's'; }
409 else { $perms = 'l'; $pname .= ' -> ' . readlink($_); }
412 $tmp = $rwx[$tmpmode & 7];
414 $tmp = $rwx[$tmpmode & 7] . $tmp;
416 $tmp = $rwx[$tmpmode & 7] . $tmp;
417 substr($tmp,2,1) =~ tr/-x/Ss/ if -u _;
418 substr($tmp,5,1) =~ tr/-x/Ss/ if -g _;
419 substr($tmp,8,1) =~ tr/-x/Tt/ if -k _;
422 $user = $user{$uid} || $uid;
423 $group = $group{$gid} || $gid;
425 ($sec,$min,$hour,$mday,$mon,$year) = localtime($mtime);
426 $moname = $moname[$mon];
427 if (-M _ > 365.25 / 2) {
428 $timeyear = '19' . $year;
431 $timeyear = sprintf("%02d:%02d", $hour, $min);
434 printf "%5lu %4ld %-10s %2d %-8s %-8s %8s %s %2d %5s %s\n",
450 sprintf("%3d, %3d", ($rdev >> 8) & 255, $rdev & 255);
462 if ($name eq 'TRAILER!!!') {
467 ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
468 $atime,$mtime,$ctime,$blksize,$blocks) = lstat(_);
471 warn "Couldn't open $name: $!\n";
476 $text = readlink($_);
477 $size = 0 unless defined $text;
481 ($nm = $name) =~ s#^\./##;
485 sprintf("%06o%06o%06o%06o%06o%06o%06o%06o%011lo%06o%011lo%s\0",
500 $cpout{$fh} .= "\0" if length($cpout{$fh}) & 1;
501 $cpout{$fh} .= pack("SSSSSSSSLSLa*",
502 070707, $dev, $ino, $mode, $uid, $gid, $nlink, $rdev, $mtime,
503 length($nm)+1, $size, $nm . (length($nm) & 1 ? "\0" : "\0\0"));
506 $cpout{$fh} .= $text;
509 &flush($fh) while ($l = length($cpout{$fh})) >= 5120;
510 while (sysread(IN, $cpout{$fh}, 5120 - $l, $l)) {
512 $l = length($cpout{$fh});
521 while (length($cpout{$fh}) >= 5120) {
522 syswrite($fh,$cpout{$fh},5120);
524 substr($cpout{$fh}, 0, 5120) = '';
529 $name = 'TRAILER!!!';
530 foreach $fh (keys %cpout) {
532 $cpout{$fh} .= "0" x (5120 - length($cpout{$fh}));
534 print $blocks{$fh} * 10, " blocks\n";
545 local($linkname,$header,$l,$slop);
546 local($linkflag) = "\0";
548 ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
549 $atime,$mtime,$ctime,$blksize,$blocks) = lstat(_);
552 if ($linkname = $linkseen{$fh,$dev,$ino}) {
556 $linkseen{$fh,$dev,$ino} = $nm;
561 warn "Couldn't open $name: $!\n";
564 $size = 0 if $linkflag ne "\0";
567 $linkname = readlink($_);
568 $linkflag = 2 if defined $linkname;
573 $header = pack("a100a8a8a8a12a12a8a1a100",
575 sprintf("%6o ", $mode & 0777),
576 sprintf("%6o ", $uid & 0777777),
577 sprintf("%6o ", $gid & 0777777),
578 sprintf("%11o ", $size),
579 sprintf("%11o ", $mtime),
583 $l = length($header) % 512;
584 substr($header, 148, 6) = sprintf("%6o", unpack("%16C*", $header));
585 substr($header, 154, 1) = "\0"; # blech
586 $tarout{$fh} .= $header;
587 $tarout{$fh} .= "\0" x (512 - $l) if $l;
589 &tflush($fh) while ($l = length($tarout{$fh})) >= 10240;
590 while (sysread(IN, $tarout{$fh}, 10240 - $l, $l)) {
591 $slop = length($tarout{$fh}) % 512;
592 $tarout{$fh} .= "\0" x (512 - $slop) if $slop;
594 $l = length($tarout{$fh});
603 while (length($tarout{$fh}) >= 10240) {
604 syswrite($fh,$tarout{$fh},10240);
606 substr($tarout{$fh}, 0, 10240) = '';
613 foreach $fh (keys %tarout) {
614 $len = 10240 - length($tarout{$fh});
615 $len += 10240 if $len < 1024;
616 $tarout{$fh} .= "\0" x $len;
626 ############################################################################
631 $tabstring = "\t" x ($indent / 2) . ' ' x ($indent % 2 * 4);
633 if ($_ =~ /^(name|print)/) {
638 $tabstring .= <<'ENDOFSTAT' . $tabstring;
639 ($nlink || (($dev,$ino,$mode,$nlink,$uid,$gid) = lstat($_))) &&
643 $tabstring .= <<'ENDOFSTAT' . $tabstring;
644 (($dev,$ino,$mode,$nlink,$uid,$gid) = lstat($_)) &&
650 $tabstring =~ s/^\s+/ / if $out =~ /!$/;
657 $tmp =~ s/([.^\$()])/\\$1/g;
658 $tmp =~ s/([?*])/.$1/g;
665 $n =~ s/^-/< / || $n =~ s/^\+/> / || $n =~ s/^/== /;
666 $n =~ s/ 0*(\d)/ $1/;