[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.
$spitshell >find2perl <<!GROK!THIS!
#!$bin/perl

\$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;
	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($indent) = $indent - 4;
	    $out .= "\n" . &tab . "||\n";
	    shift;
	}
	else {
	    $out .= " &&" unless $ARGV[0] eq ')';
	    $out .= "\n";
	    shift if $ARGV[0] eq '-a';
	}
    }
}

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

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;

print <<"END";
# Traverse desired filesystems

&dodirs($roots);
$flushall
exit;

sub wanted {
$out;
}

END

print <<'END';
sub dodirs {
    chop($cwd = `pwd`);
    foreach $topdir (@_) {
	(($topdev,$topino,$topmode,$topnlink) = stat($topdir))
	  || (warn("Can't stat $topdir: $!\n"), next);
	if (-d _) {
	    if (chdir($topdir)) {
END
if ($depth) {
    print <<'END';
		$topdir = '' if $topdir eq '/';
		&dodir($topdir,$topnlink);
		($dir,$_) = ($topdir,'.');
		$name = $topdir;
		&wanted;
END
}
else {
    print <<'END';
		($dir,$_) = ($topdir,'.');
		$name = $topdir;
		&wanted;
		$topdir = '' if $topdir eq '/';
		&dodir($topdir,$topnlink);
END
}
print <<'END';
	    }
	    else {
		warn "Can't cd to $topdir: $!\n";
	    }
	}
	else {
	    unless (($dir,$_) = $topdir =~ m#^(.*/)(.*)$#) {
		($dir,$_) = ('.', $topdir);
	    }
	    chdir $dir && &wanted;
	}
	chdir $cwd;
    }
}

sub dodir {
    local($dir,$nlink) = @_;
    local($dev,$ino,$mode,$subcount);
    local($name);

    # Get the list of files in the current directory.

    opendir(DIR,'.') || warn "Can't open $dir: $!\n";
    local(@filenames) = readdir(DIR);
    closedir(DIR);

    if ($nlink == 2) {        # This dir has no subdirectories.
	for (@filenames) {
	    next if $_ eq '.';
	    next if $_ eq '..';
	    $name = "$dir/$_";
	    &wanted;
	}
    }
    else {                    # This dir has subdirectories.
	$subcount = $nlink - 2;
	for (@filenames) {
	    next if $_ eq '.';
	    next if $_ eq '..';
	    $nlink = $prune = 0;
	    $name = "$dir/$_";
END
print <<'END' unless $depth;
	    &wanted;
END
print <<'END';
	    if ($subcount > 0) {    # Seen all the subdirs?

		# Get link count and check for directoriness.

		($dev,$ino,$mode,$nlink) = lstat($_) unless $nlink;
		
		if (-d _) {

		    # It really is a directory, so do it recursively.

		    if (!$prune && chdir $_) {
			&dodir($name,$nlink);
			chdir '..';
		    }
		    --$subcount;
		}
	    }
END
print <<'END' if $depth;
	    &wanted;
END
print <<'END';
	}
    }
}

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, $_) || 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, $_) || 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 ($_ !~ /^(name|print)/) {
	if (!$statdone) {
	    $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/^-0*/< / || $n =~ s/^\+0*/> / || $n =~ s/^0*/== /;
    $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
	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