[p5sagit/p5-mst-13.2.git] / x2p / find2perl.SH

case $CONFIG in
'')
    if test ! -f config.sh; then
	ln ../config.sh . || \
	ln ../../config.sh . || \
	ln ../../../config.sh . || \
	(echo "Can't find config.sh."; exit 1)
    fi
    . ./config.sh
    ;;
esac
: This forces SH files to create target in same directory as SH file.
: This is so that make depend always knows where to find SH derivatives.
case "$0" in
*/*) cd `expr X$0 : 'X\(.*\)/'` ;;
esac
echo "Extracting find2perl (with variable substitutions)"
: This section of the file will have variable substitutions done on it.
: Move anything that needs config subs from !NO!SUBS! section to !GROK!THIS!.
: Protect any dollar signs and backticks that you do not want interpreted
: by putting a backslash in front.  You may delete these comments.
rm -f find2perl
$spitshell >find2perl <<!GROK!THIS!
#!$bin/perl

eval 'exec $bin/perl -S \$0 \${1+"\$@"}'
	if \$running_under_some_shell;

\$bin = "$bin";

!GROK!THIS!

: In the following dollars and backticks do not need the extra backslash.
$spitshell >>find2perl <<'!NO!SUBS!'

while ($ARGV[0] =~ /^[^-!(]/) {
    push(@roots, shift);
}
@roots = ('.') unless @roots;
for (@roots) { $_ = &quote($_); }
$roots = join(',', @roots);

$indent = 1;

while (@ARGV) {
    $_ = shift;
    s/^-// || /^[()!]/ || die "Unrecognized switch: $_\n";
    if ($_ eq '(') {
	$out .= &tab . "(\n";
	$indent++;
	next;
    }
    elsif ($_ eq ')') {
	$indent--;
	$out .= &tab . ")";
    }
    elsif ($_ eq '!') {
	$out .= &tab . "!";
	next;
    }
    elsif ($_ eq 'name') {
	$out .= &tab;
	$pat = &fileglob_to_re(shift);
	$out .= '/' . $pat . "/";
    }
    elsif ($_ eq 'perm') {
	$onum = shift;
	die "Malformed -perm argument: $onum\n" unless $onum =~ /^-?[0-7]+$/;
	if ($onum =~ s/^-//) {
	    $onum = '0' . sprintf("%o", oct($onum) & 017777);	# s/b 07777 ?
	    $out .= &tab . "((\$mode & $onum) == $onum)";
	}
	else {
	    $onum = '0' . $onum unless $onum =~ /^0/;
	    $out .= &tab . "((\$mode & 0777) == $onum)";
	}
    }
    elsif ($_ eq 'type') {
	($filetest = shift) =~ tr/s/S/;
	$out .= &tab . "-$filetest _";
    }
    elsif ($_ eq 'print') {
	$out .= &tab . 'print("$name\n")';
    }
    elsif ($_ eq 'print0') {
	$out .= &tab . 'print("$name\0")';
    }
    elsif ($_ eq 'fstype') {
	$out .= &tab;
	$type = shift;
	if ($type eq 'nfs')
	    { $out .= '($dev < 0)'; }
	else
	    { $out .= '($dev >= 0)'; }
    }
    elsif ($_ eq 'user') {
	$uname = shift;
	$out .= &tab . "(\$uid == \$uid{'$uname'})";
	$inituser++;
    }
    elsif ($_ eq 'group') {
	$gname = shift;
	$out .= &tab . "(\$gid == \$gid{'$gname'})";
	$initgroup++;
    }
    elsif ($_ eq 'nouser') {
	$out .= &tab . '!defined $uid{$uid}';
	$inituser++;
    }
    elsif ($_ eq 'nogroup') {
	$out .= &tab . '!defined $gid{$gid}';
	$initgroup++;
    }
    elsif ($_ eq 'links') {
	$out .= &tab . '($nlink ' . &n(shift);
    }
    elsif ($_ eq 'inum') {
	$out .= &tab . '($ino ' . &n(shift);
    }
    elsif ($_ eq 'size') {
	$out .= &tab . '(int((-s _ + 511) / 512) ' . &n(shift);
    }
    elsif ($_ eq 'atime') {
	$out .= &tab . '(int(-A _) ' . &n(shift);
    }
    elsif ($_ eq 'mtime') {
	$out .= &tab . '(int(-M _) ' . &n(shift);
    }
    elsif ($_ eq 'ctime') {
	$out .= &tab . '(int(-C _) ' . &n(shift);
    }
    elsif ($_ eq 'exec') {
	for (@cmd = (); @ARGV && $ARGV[0] ne ';'; push(@cmd,shift)) { }
	shift;
	$_ = "@cmd";
	if (m#^(/bin/)?rm -f {}$#) {
	    if (!@ARGV) {
		$out .= &tab . 'unlink($_)';
	    }
	    else {
		$out .= &tab . '(unlink($_) || 1)';
	    }
	}
	elsif (m#^(/bin/)?rm {}$#) {
	    $out .= &tab . '(unlink($_) || warn "$name: $!\n")';
	}
	else {
	    for (@cmd) { s/'/\\'/g; }
	    $" = "','";
	    $out .= &tab . "&exec(0, '@cmd')";
	    $" = ' ';
	    $initexec++;
	}
    }
    elsif ($_ eq 'ok') {
	for (@cmd = (); @ARGV && $ARGV[0] ne ';'; push(@cmd,shift)) { }
	shift;
	for (@cmd) { s/'/\\'/g; }
	$" = "','";
	$out .= &tab . "&exec(1, '@cmd')";
	$" = ' ';
	$initexec++;
    }
    elsif ($_ eq 'prune') {
	$out .= &tab . '($prune = 1)';
    }
    elsif ($_ eq 'xdev') {
	$out .= &tab . '(($prune |= ($dev != $topdev)),1)';
    }
    elsif ($_ eq 'newer') {
	$out .= &tab;
	$file = shift;
	$newername = 'AGE_OF' . $file;
	$newername =~ s/[^\w]/_/g;
	$newername = '$' . $newername;
	$out .= "(-M _ < $newername)";
	$initnewer .= "$newername = -M " . &quote($file) . ";\n";
    }
    elsif ($_ eq 'eval') {
	$prog = &quote(shift);
	$out .= &tab . "eval $prog";
    }
    elsif ($_ eq 'depth') {
	$depth++;
	next;
    }
    elsif ($_ eq 'ls') {
	$out .= &tab . "&ls";
	$initls++;
    }
    elsif ($_ eq 'tar') {
	$out .= &tab;
	die "-tar must have a filename argument\n" unless @ARGV;
	$file = shift;
	$fh = 'FH' . $file;
	$fh =~ s/[^\w]/_/g;
	$out .= "&tar($fh)";
	$file = '>' . $file;
	$initfile .= "open($fh, " . &quote($file) .
	  qq{) || die "Can't open $fh: \$!\\n";\n};
	$inittar++;
	$flushall = "\n&tflushall;\n";
    }
    elsif (/^n?cpio$/) {
	$depth++;
	$out .= &tab;
	die "-$_ must have a filename argument\n" unless @ARGV;
	$file = shift;
	$fh = 'FH' . $file;
	$fh =~ s/[^\w]/_/g;
	$out .= "&cpio('" . substr($_,0,1) . "', $fh)";
	$file = '>' . $file;
	$initfile .= "open($fh, " . &quote($file) .
	  qq{) || die "Can't open $fh: \$!\\n";\n};
	$initcpio++;
	$flushall = "\n&flushall;\n";
    }
    else {
	die "Unrecognized switch: -$_\n";
    }
    if (@ARGV) {
	if ($ARGV[0] eq '-o') {
	    { local($statdone) = 1; $out .= "\n" . &tab . "||\n"; }
	    $statdone = 0 if $indent == 1 && $delayedstat;
	    $saw_or++;
	    shift;
	}
	else {
	    $out .= " &&" unless $ARGV[0] eq ')';
	    $out .= "\n";
	    shift if $ARGV[0] eq '-a';
	}
    }
}

print <<"END";
#!$bin/perl

eval 'exec $bin/perl -S \$0 \${1+"\$@"}'
	if \$running_under_some_shell;

END

if ($initls) {
    print <<'END';
@rwx = ('---','--x','-w-','-wx','r--','r-x','rw-','rwx');
@moname = (Jan,Feb,Mar,Apr,May,Jun,Jul,Aug,Sep,Oct,Nov,Dec);

END
}

if ($inituser || $initls) {
    print 'while (($name, $pw, $uid) = getpwent) {', "\n";
    print '    $uid{$name} = $uid{$uid} = $uid;', "\n" if $inituser;
    print '    $user{$uid} = $name unless $user{$uid};', "\n" if $initls;
    print "}\n\n";
}

if ($initgroup || $initls) {
    print 'while (($name, $pw, $gid) = getgrent) {', "\n";
    print '    $gid{$name} = $gid{$gid} = $gid;', "\n" if $initgroup;
    print '    $group{$gid} = $name unless $group{$gid};', "\n" if $initls;
    print "}\n\n";
}

print $initnewer, "\n" if $initnewer;

print $initfile, "\n" if $initfile;

$find = $depth ? "finddepth" : "find";
print <<"END";
require "$find.pl";

# Traverse desired filesystems

&$find($roots);
$flushall
exit;

sub wanted {
$out;
}

END

if ($initexec) {
    print <<'END';
sub exec {
    local($ok, @cmd) = @_;
    foreach $word (@cmd) {
	$word =~ s#{}#$name#g;
    }
    if ($ok) {
	local($old) = select(STDOUT);
	$| = 1;
	print "@cmd";
	select($old);
	return 0 unless <STDIN> =~ /^y/;
    }
    chdir $cwd;		# sigh
    system @cmd;
    chdir $dir;
    return !$?;
}

END
}

if ($initls) {
    print <<'END';
sub ls {
    ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$sizemm,
      $atime,$mtime,$ctime,$blksize,$blocks) = lstat(_);

    $pname = $name;

    if (defined $blocks) {
	$blocks = int(($blocks + 1) / 2);
    }
    else {
	$blocks = int(($size + 1023) / 1024);
    }

    if    (-f _) { $perms = '-'; }
    elsif (-d _) { $perms = 'd'; }
    elsif (-c _) { $perms = 'c'; $sizemm = &sizemm; }
    elsif (-b _) { $perms = 'b'; $sizemm = &sizemm; }
    elsif (-p _) { $perms = 'p'; }
    elsif (-S _) { $perms = 's'; }
    else         { $perms = 'l'; $pname .= ' -> ' . readlink($_); }

    $tmpmode = $mode;
    $tmp = $rwx[$tmpmode & 7];
    $tmpmode >>= 3;
    $tmp = $rwx[$tmpmode & 7] . $tmp;
    $tmpmode >>= 3;
    $tmp = $rwx[$tmpmode & 7] . $tmp;
    substr($tmp,2,1) =~ tr/-x/Ss/ if -u _;
    substr($tmp,5,1) =~ tr/-x/Ss/ if -g _;
    substr($tmp,8,1) =~ tr/-x/Tt/ if -k _;
    $perms .= $tmp;

    $user = $user{$uid} || $uid;
    $group = $group{$gid} || $gid;

    ($sec,$min,$hour,$mday,$mon,$year) = localtime($mtime);
    $moname = $moname[$mon];
    if (-M _ > 365.25 / 2) {
	$timeyear = '19' . $year;
    }
    else {
	$timeyear = sprintf("%02d:%02d", $hour, $min);
    }

    printf "%5lu %4ld %-10s %2d %-8s %-8s %8s %s %2d %5s %s\n",
	    $ino,
		 $blocks,
		      $perms,
			    $nlink,
				$user,
				     $group,
					  $sizemm,
					      $moname,
						 $mday,
						     $timeyear,
							 $pname;
    1;
}

sub sizemm {
    sprintf("%3d, %3d", ($rdev >> 8) & 255, $rdev & 255);
}

END
}

if ($initcpio) {
print <<'END';
sub cpio {
    local($nc,$fh) = @_;
    local($text);

    if ($name eq 'TRAILER!!!') {
	$text = '';
	$size = 0;
    }
    else {
	($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
	  $atime,$mtime,$ctime,$blksize,$blocks) = lstat(_);
	if (-f _) {
	    open(IN, "./$_\0") || do {
		warn "Couldn't open $name: $!\n";
		return;
	    };
	}
	else {
	    $text = readlink($_);
	    $size = 0 unless defined $text;
	}
    }

    ($nm = $name) =~ s#^\./##;
    $nc{$fh} = $nc;
    if ($nc eq 'n') {
	$cpout{$fh} .=
	  sprintf("%06o%06o%06o%06o%06o%06o%06o%06o%011lo%06o%011lo%s\0",
	    070707,
	    $dev & 0777777,
	    $ino & 0777777,
	    $mode & 0777777,
	    $uid & 0777777,
	    $gid & 0777777,
	    $nlink & 0777777,
	    $rdev & 0177777,
	    $mtime,
	    length($nm)+1,
	    $size,
	    $nm);
    }
    else {
	$cpout{$fh} .= "\0" if length($cpout{$fh}) & 1;
	$cpout{$fh} .= pack("SSSSSSSSLSLa*",
	    070707, $dev, $ino, $mode, $uid, $gid, $nlink, $rdev, $mtime,
	    length($nm)+1, $size, $nm . (length($nm) & 1 ? "\0" : "\0\0"));
    }
    if ($text ne '') {
	$cpout{$fh} .= $text;
    }
    elsif ($size) {
	&flush($fh) while ($l = length($cpout{$fh})) >= 5120;
	while (sysread(IN, $cpout{$fh}, 5120 - $l, $l)) {
	    &flush($fh);
	    $l = length($cpout{$fh});
	}
    }
    close IN;
}

sub flush {
    local($fh) = @_;

    while (length($cpout{$fh}) >= 5120) {
	syswrite($fh,$cpout{$fh},5120);
	++$blocks{$fh};
	substr($cpout{$fh}, 0, 5120) = '';
    }
}

sub flushall {
    $name = 'TRAILER!!!';
    foreach $fh (keys %cpout) {
	&cpio($nc{$fh},$fh);
	$cpout{$fh} .= "0" x (5120 - length($cpout{$fh}));
	&flush($fh);
	print $blocks{$fh} * 10, " blocks\n";
    }
}

END
}

if ($inittar) {
print <<'END';
sub tar {
    local($fh) = @_;
    local($linkname,$header,$l,$slop);
    local($linkflag) = "\0";

    ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
      $atime,$mtime,$ctime,$blksize,$blocks) = lstat(_);
    $nm = $name;
    if ($nlink > 1) {
	if ($linkname = $linkseen{$fh,$dev,$ino}) {
	    $linkflag = 1;
	}
	else {
	    $linkseen{$fh,$dev,$ino} = $nm;
	}
    }
    if (-f _) {
	open(IN, "./$_\0") || do {
	    warn "Couldn't open $name: $!\n";
	    return;
	};
	$size = 0 if $linkflag ne "\0";
    }
    else {
	$linkname = readlink($_);
	$linkflag = 2 if defined $linkname;
	$nm .= '/' if -d _;
	$size = 0;
    }

    $header = pack("a100a8a8a8a12a12a8a1a100",
	$nm,
	sprintf("%6o ", $mode & 0777),
	sprintf("%6o ", $uid & 0777777),
	sprintf("%6o ", $gid & 0777777),
	sprintf("%11o ", $size),
	sprintf("%11o ", $mtime),
	"        ",
	$linkflag,
	$linkname);
    $l = length($header) % 512;
    substr($header, 148, 6) = sprintf("%6o", unpack("%16C*", $header));
    substr($header, 154, 1) = "\0";  # blech
    $tarout{$fh} .= $header;
    $tarout{$fh} .= "\0" x (512 - $l) if $l;
    if ($size) {
	&tflush($fh) while ($l = length($tarout{$fh})) >= 10240;
	while (sysread(IN, $tarout{$fh}, 10240 - $l, $l)) {
	    $slop = length($tarout{$fh}) % 512;
	    $tarout{$fh} .= "\0" x (512 - $slop) if $slop;
	    &tflush($fh);
	    $l = length($tarout{$fh});
	}
    }
    close IN;
}

sub tflush {
    local($fh) = @_;

    while (length($tarout{$fh}) >= 10240) {
	syswrite($fh,$tarout{$fh},10240);
	++$blocks{$fh};
	substr($tarout{$fh}, 0, 10240) = '';
    }
}

sub tflushall {
    local($len);

    foreach $fh (keys %tarout) {
	$len = 10240 - length($tarout{$fh});
	$len += 10240 if $len < 1024;
	$tarout{$fh} .= "\0" x $len;
	&tflush($fh);
    }
}

END
}

exit;

############################################################################

sub tab {
    local($tabstring);

    $tabstring = "\t" x ($indent / 2) . ' ' x ($indent % 2 * 4);
    if (!$statdone) {
	if ($_ =~ /^(name|print|prune|exec|ok|\(|\))/) {
	    $delayedstat++;
	}
	else {
	    if ($saw_or) {
		$tabstring .= <<'ENDOFSTAT' . $tabstring;
($nlink || (($dev,$ino,$mode,$nlink,$uid,$gid) = lstat($_))) &&
ENDOFSTAT
	    }
	    else {
		$tabstring .= <<'ENDOFSTAT' . $tabstring;
(($dev,$ino,$mode,$nlink,$uid,$gid) = lstat($_)) &&
ENDOFSTAT
	    }
	    $statdone = 1;
	}
    }
    $tabstring =~ s/^\s+/ / if $out =~ /!$/;
    $tabstring;
}

sub fileglob_to_re {
    local($tmp) = @_;

    $tmp =~ s#([./^\$()])#\\$1#g;
    $tmp =~ s/([?*])/.$1/g;
    "^$tmp$";
}

sub n {
    local($n) = @_;

    $n =~ s/^-/< / || $n =~ s/^\+/> / || $n =~ s/^/== /;
    $n =~ s/ 0*(\d)/ $1/;
    $n . ')';
}

sub quote {
    local($string) = @_;
    $string =~ s/'/\\'/;
    "'$string'";
}
!NO!SUBS!
chmod 755 find2perl
$eunicefix find2perl
Commit	Line	Data
fe14fcc3	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
8adcabd8	9	. ./config.sh
fe14fcc3	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.
8adcabd8	22	rm -f find2perl
fe14fcc3	23	$spitshell >find2perl <<!GROK!THIS!
	24	#!$bin/perl
	25
8adcabd8	26	eval 'exec $bin/perl -S \$0 \${1+"\$@"}'
	27	if \$running_under_some_shell;
	28
fe14fcc3	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 ?
e334a159	71	$out .= &tab . "((\$mode & $onum) == $onum)";
fe14fcc3	72	}
	73	else {
	74	$onum = '0' . $onum unless $onum =~ /^0/;
e334a159	75	$out .= &tab . "((\$mode & 0777) == $onum)";
fe14fcc3	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')
79072805	92	{ $out .= '($dev < 0)'; }
fe14fcc3	93	else
79072805	94	{ $out .= '($dev >= 0)'; }
fe14fcc3	95	}
	96	elsif ($_ eq 'user') {
	97	$uname = shift;
79072805	98	$out .= &tab . "(\$uid == \$uid{'$uname'})";
fe14fcc3	99	$inituser++;
	100	}
	101	elsif ($_ eq 'group') {
	102	$gname = shift;
79072805	103	$out .= &tab . "(\$gid == \$gid{'$gname'})";
fe14fcc3	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') {
79072805	115	$out .= &tab . '($nlink ' . &n(shift);
fe14fcc3	116	}
fe14fcc3	117	elsif ($_ eq 'inum') {
79072805	118	$out .= &tab . '($ino ' . &n(shift);
fe14fcc3	119	}
fe14fcc3	120	elsif ($_ eq 'size') {
79072805	121	$out .= &tab . '(int((-s _ + 511) / 512) ' . &n(shift);
fe14fcc3	122	}
fe14fcc3	123	elsif ($_ eq 'atime') {
79072805	124	$out .= &tab . '(int(-A _) ' . &n(shift);
fe14fcc3	125	}
fe14fcc3	126	elsif ($_ eq 'mtime') {
79072805	127	$out .= &tab . '(int(-M _) ' . &n(shift);
fe14fcc3	128	}
fe14fcc3	129	elsif ($_ eq 'ctime') {
79072805	130	$out .= &tab . '(int(-C _) ' . &n(shift);
fe14fcc3	131	}
	132	elsif ($_ eq 'exec') {
	133	for (@cmd = (); @ARGV && $ARGV[0] ne ';'; push(@cmd,shift)) { }
	134	shift;
6e21c824	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	}
fe14fcc3	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;
79072805	176	$out .= "(-M _ < $newername)";
fe14fcc3	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') {
6e21c824	223	{ local($statdone) = 1; $out .= "\n" . &tab . "\|\|\n"; }
1c3d792e	224	$statdone = 0 if $indent == 1 && $delayedstat;
1c3d792e	225	$saw_or++;
fe14fcc3	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
8adcabd8	239	eval 'exec $bin/perl -S \$0 \${1+"\$@"}'
	240	if \$running_under_some_shell;
	241
fe14fcc3	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
6e21c824	270	$find = $depth ? "finddepth" : "find";
fe14fcc3	271	print <<"END";
6e21c824	272	require "$find.pl";
6e21c824	273
fe14fcc3	274	# Traverse desired filesystems
fe14fcc3	275
6e21c824	276	&$find($roots);
fe14fcc3	277	$flushall
	278	exit;
	279
	280	sub wanted {
	281	$out;
	282	}
	283
	284	END
	285
fe14fcc3	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 _) {
99b89507	391	open(IN, "./$_\0") \|\| do {
fe14fcc3	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 _) {
99b89507	481	open(IN, "./$_\0") \|\| do {
fe14fcc3	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);
1c3d792e	553	if (!$statdone) {
8adcabd8	554	if ($_ =~ /^(name\|print\|prune\|exec\|ok\|\(\|\))/) {
1c3d792e	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;
fe14fcc3	565	(($dev,$ino,$mode,$nlink,$uid,$gid) = lstat($_)) &&
fe14fcc3	566	ENDOFSTAT
1c3d792e	567	}
fe14fcc3	568	$statdone = 1;
	569	}
	570	}
	571	$tabstring =~ s/^\s+/ / if $out =~ /!$/;
	572	$tabstring;
	573	}
	574
	575	sub fileglob_to_re {
	576	local($tmp) = @_;
	577
79072805	578	$tmp =~ s#([./^\$()])#\\$1#g;
fe14fcc3	579	$tmp =~ s/([?*])/.$1/g;
	580	"^$tmp$";
	581	}
	582
	583	sub n {
	584	local($n) = @_;
	585
1c3d792e	586	$n =~ s/^-/< / \|\| $n =~ s/^\+/> / \|\| $n =~ s/^/== /;
1c3d792e	587	$n =~ s/ 0*(\d)/ $1/;
79072805	588	$n . ')';
fe14fcc3	589	}
	590
	591	sub quote {
	592	local($string) = @_;
	593	$string =~ s/'/\\'/;
	594	"'$string'";
	595	}
	596	!NO!SUBS!
	597	chmod 755 find2perl
	598	$eunicefix find2perl