[unix-history] / usr / contrib / bin / find2perl

#!/usr/contrib/bin/perl

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

$bin = "/usr/contrib/bin";


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'";
}
Commit	Line	Data
d19794d1 C	1	#!/usr/contrib/bin/perl
	2
	3	eval 'exec /usr/contrib/bin/perl -S $0 ${1+"$@"}'
	4	if $running_under_some_shell;
	5
	6	$bin = "/usr/contrib/bin";
	7
	8
	9	while ($ARGV[0] =~ /^[^-!(]/) {
	10	push(@roots, shift);
	11	}
	12	@roots = ('.') unless @roots;
	13	for (@roots) { $_ = &quote($_); }
	14	$roots = join(',', @roots);
	15
	16	$indent = 1;
	17
	18	while (@ARGV) {
	19	$_ = shift;
	20	s/^-// \|\| /^[()!]/ \|\| die "Unrecognized switch: $_\n";
	21	if ($_ eq '(') {
	22	$out .= &tab . "(\n";
	23	$indent++;
	24	next;
	25	}
	26	elsif ($_ eq ')') {
	27	$indent--;
	28	$out .= &tab . ")";
	29	}
	30	elsif ($_ eq '!') {
	31	$out .= &tab . "!";
	32	next;
	33	}
	34	elsif ($_ eq 'name') {
	35	$out .= &tab;
	36	$pat = &fileglob_to_re(shift);
	37	$out .= '/' . $pat . "/";
	38	}
	39	elsif ($_ eq 'perm') {
	40	$onum = shift;
	41	die "Malformed -perm argument: $onum\n" unless $onum =~ /^-?[0-7]+$/;
	42	if ($onum =~ s/^-//) {
	43	$onum = '0' . sprintf("%o", oct($onum) & 017777); # s/b 07777 ?
	44	$out .= &tab . "((\$mode & $onum) == $onum)";
	45	}
	46	else {
	47	$onum = '0' . $onum unless $onum =~ /^0/;
	48	$out .= &tab . "((\$mode & 0777) == $onum)";
	49	}
	50	}
	51	elsif ($_ eq 'type') {
	52	($filetest = shift) =~ tr/s/S/;
	53	$out .= &tab . "-$filetest _";
	54	}
	55	elsif ($_ eq 'print') {
	56	$out .= &tab . 'print("$name\n")';
	57	}
	58	elsif ($_ eq 'print0') {
	59	$out .= &tab . 'print("$name\0")';
	60	}
	61	elsif ($_ eq 'fstype') {
	62	$out .= &tab;
	63	$type = shift;
	64	if ($type eq 'nfs')
65	{ $out .= '$dev < 0'; }
66	else
67	{ $out .= '$dev >= 0'; }
68	}
69	elsif ($_ eq 'user') {
70	$uname = shift;
71	$out .= &tab . "\$uid == \$uid{'$uname'}";
72	$inituser++;
73	}
74	elsif ($_ eq 'group') {
75	$gname = shift;
76	$out .= &tab . "\$gid == \$gid{'$gname'}";
77	$initgroup++;
78	}
79	elsif ($_ eq 'nouser') {
80	$out .= &tab . '!defined $uid{$uid}';
81	$inituser++;
82	}
83	elsif ($_ eq 'nogroup') {
84	$out .= &tab . '!defined $gid{$gid}';
85	$initgroup++;
86	}
87	elsif ($_ eq 'links') {
88	$out .= &tab . '$nlink ' . &n(shift);
89	}
90	elsif ($_ eq 'inum') {
91	$out .= &tab . '$ino ' . &n(shift);
92	}
93	elsif ($_ eq 'size') {
94	$out .= &tab . 'int((-s _ + 511) / 512) ' . &n(shift);
95	}
96	elsif ($_ eq 'atime') {
97	$out .= &tab . 'int(-A _) ' . &n(shift);
98	}
99	elsif ($_ eq 'mtime') {
100	$out .= &tab . 'int(-M _) ' . &n(shift);
101	}
102	elsif ($_ eq 'ctime') {
103	$out .= &tab . 'int(-C _) ' . &n(shift);
104	}
105	elsif ($_ eq 'exec') {
106	for (@cmd = (); @ARGV && $ARGV[0] ne ';'; push(@cmd,shift)) { }
107	shift;
108	$_ = "@cmd";
109	if (m#^(/bin/)?rm -f {}$#) {
110	if (!@ARGV) {
111	$out .= &tab . 'unlink($_)';
112	}
113	else {
114	$out .= &tab . '(unlink($_) \|\| 1)';
115	}
116	}
117	elsif (m#^(/bin/)?rm {}$#) {
118	$out .= &tab . '(unlink($_) \|\| warn "$name: $!\n")';
119	}
120	else {
121	for (@cmd) { s/'/\\'/g; }
122	$" = "','";
123	$out .= &tab . "&exec(0, '@cmd')";
124	$" = ' ';
125	$initexec++;
126	}
127	}
128	elsif ($_ eq 'ok') {
129	for (@cmd = (); @ARGV && $ARGV[0] ne ';'; push(@cmd,shift)) { }
130	shift;
131	for (@cmd) { s/'/\\'/g; }
132	$" = "','";
133	$out .= &tab . "&exec(1, '@cmd')";
134	$" = ' ';
135	$initexec++;
136	}
137	elsif ($_ eq 'prune') {
138	$out .= &tab . '($prune = 1)';
139	}
140	elsif ($_ eq 'xdev') {
141	$out .= &tab . '(($prune \|= ($dev != $topdev)),1)';
142	}
143	elsif ($_ eq 'newer') {
144	$out .= &tab;
145	$file = shift;
146	$newername = 'AGE_OF' . $file;
147	$newername =~ s/[^\w]/_/g;
148	$newername = '$' . $newername;
149	$out .= "-M _ < $newername";
150	$initnewer .= "$newername = -M " . &quote($file) . ";\n";
151	}
152	elsif ($_ eq 'eval') {
153	$prog = &quote(shift);
154	$out .= &tab . "eval $prog";
155	}
156	elsif ($_ eq 'depth') {
157	$depth++;
158	next;
159	}
160	elsif ($_ eq 'ls') {
161	$out .= &tab . "&ls";
162	$initls++;
163	}
164	elsif ($_ eq 'tar') {
165	$out .= &tab;
166	die "-tar must have a filename argument\n" unless @ARGV;
167	$file = shift;
168	$fh = 'FH' . $file;
169	$fh =~ s/[^\w]/_/g;
170	$out .= "&tar($fh)";
171	$file = '>' . $file;
172	$initfile .= "open($fh, " . &quote($file) .
173	qq{) \|\| die "Can't open $fh: \$!\\n";\n};
174	$inittar++;
175	$flushall = "\n&tflushall;\n";
176	}
177	elsif (/^n?cpio$/) {
178	$depth++;
179	$out .= &tab;
180	die "-$_ must have a filename argument\n" unless @ARGV;
181	$file = shift;
182	$fh = 'FH' . $file;
183	$fh =~ s/[^\w]/_/g;
184	$out .= "&cpio('" . substr($_,0,1) . "', $fh)";
185	$file = '>' . $file;
186	$initfile .= "open($fh, " . &quote($file) .
187	qq{) \|\| die "Can't open $fh: \$!\\n";\n};
188	$initcpio++;
189	$flushall = "\n&flushall;\n";
190	}
191	else {
192	die "Unrecognized switch: -$_\n";
193	}
194	if (@ARGV) {
195	if ($ARGV[0] eq '-o') {
196	{ local($statdone) = 1; $out .= "\n" . &tab . "\|\|\n"; }
197	$statdone = 0 if $indent == 1 && $delayedstat;
198	$saw_or++;
199	shift;
200	}
201	else {
202	$out .= " &&" unless $ARGV[0] eq ')';
203	$out .= "\n";
204	shift if $ARGV[0] eq '-a';
205	}
206	}
207	}
208
209	print <<"END";
210	#!$bin/perl
211
212	eval 'exec $bin/perl -S \$0 \${1+"\$@"}'
213	if \$running_under_some_shell;
214
215	END
216
217	if ($initls) {
218	print <<'END';
219	@rwx = ('---','--x','-w-','-wx','r--','r-x','rw-','rwx');
220	@moname = (Jan,Feb,Mar,Apr,May,Jun,Jul,Aug,Sep,Oct,Nov,Dec);
221
222	END
223	}
224
225	if ($inituser \|\| $initls) {
226	print 'while (($name, $pw, $uid) = getpwent) {', "\n";
227	print ' $uid{$name} = $uid{$uid} = $uid;', "\n" if $inituser;
228	print ' $user{$uid} = $name unless $user{$uid};', "\n" if $initls;
229	print "}\n\n";
230	}
231
232	if ($initgroup \|\| $initls) {
233	print 'while (($name, $pw, $gid) = getgrent) {', "\n";
234	print ' $gid{$name} = $gid{$gid} = $gid;', "\n" if $initgroup;
235	print ' $group{$gid} = $name unless $group{$gid};', "\n" if $initls;
236	print "}\n\n";
237	}
238
239	print $initnewer, "\n" if $initnewer;
240
241	print $initfile, "\n" if $initfile;
242
243	$find = $depth ? "finddepth" : "find";
244	print <<"END";
245	require "$find.pl";
246
247	# Traverse desired filesystems
248
249	&$find($roots);
250	$flushall
251	exit;
252
253	sub wanted {
254	$out;
255	}
256
257	END
258
259	if ($initexec) {
260	print <<'END';
261	sub exec {
262	local($ok, @cmd) = @_;
263	foreach $word (@cmd) {
264	$word =~ s#{}#$name#g;
265	}
266	if ($ok) {
267	local($old) = select(STDOUT);
268	$\| = 1;
269	print "@cmd";
270	select($old);
271	return 0 unless <STDIN> =~ /^y/;
272	}
273	chdir $cwd; # sigh
274	system @cmd;
275	chdir $dir;
276	return !$?;
277	}
278
279	END
280	}
281
282	if ($initls) {
283	print <<'END';
284	sub ls {
285	($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$sizemm,
286	$atime,$mtime,$ctime,$blksize,$blocks) = lstat(_);
287
288	$pname = $name;
289
290	if (defined $blocks) {
291	$blocks = int(($blocks + 1) / 2);
292	}
293	else {
294	$blocks = int(($size + 1023) / 1024);
295	}
296
297	if (-f _) { $perms = '-'; }
298	elsif (-d _) { $perms = 'd'; }
299	elsif (-c _) { $perms = 'c'; $sizemm = &sizemm; }
300	elsif (-b _) { $perms = 'b'; $sizemm = &sizemm; }
301	elsif (-p _) { $perms = 'p'; }
302	elsif (-S _) { $perms = 's'; }
303	else { $perms = 'l'; $pname .= ' -> ' . readlink($_); }
304
305	$tmpmode = $mode;
306	$tmp = $rwx[$tmpmode & 7];
307	$tmpmode >>= 3;
308	$tmp = $rwx[$tmpmode & 7] . $tmp;
309	$tmpmode >>= 3;
310	$tmp = $rwx[$tmpmode & 7] . $tmp;
311	substr($tmp,2,1) =~ tr/-x/Ss/ if -u _;
312	substr($tmp,5,1) =~ tr/-x/Ss/ if -g _;
313	substr($tmp,8,1) =~ tr/-x/Tt/ if -k _;
314	$perms .= $tmp;
315
316	$user = $user{$uid} \|\| $uid;
317	$group = $group{$gid} \|\| $gid;
318
319	($sec,$min,$hour,$mday,$mon,$year) = localtime($mtime);
320	$moname = $moname[$mon];
321	if (-M _ > 365.25 / 2) {
322	$timeyear = '19' . $year;
323	}
324	else {
325	$timeyear = sprintf("%02d:%02d", $hour, $min);
326	}
327
328	printf "%5lu %4ld %-10s %2d %-8s %-8s %8s %s %2d %5s %s\n",
329	$ino,
330	$blocks,
331	$perms,
332	$nlink,
333	$user,
334	$group,
335	$sizemm,
336	$moname,
337	$mday,
338	$timeyear,
339	$pname;
340	1;
341	}
342
343	sub sizemm {
344	sprintf("%3d, %3d", ($rdev >> 8) & 255, $rdev & 255);
345	}
346
347	END
348	}
349
350	if ($initcpio) {
351	print <<'END';
352	sub cpio {
353	local($nc,$fh) = @_;
354	local($text);
355
356	if ($name eq 'TRAILER!!!') {
357	$text = '';
358	$size = 0;
359	}
360	else {
361	($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
362	$atime,$mtime,$ctime,$blksize,$blocks) = lstat(_);
363	if (-f _) {
364	open(IN, "./$_\0") \|\| do {
365	warn "Couldn't open $name: $!\n";
366	return;
367	};
368	}
369	else {
370	$text = readlink($_);
371	$size = 0 unless defined $text;
372	}
373	}
374
375	($nm = $name) =~ s#^\./##;
376	$nc{$fh} = $nc;
377	if ($nc eq 'n') {
378	$cpout{$fh} .=
379	sprintf("%06o%06o%06o%06o%06o%06o%06o%06o%011lo%06o%011lo%s\0",
380	070707,
381	$dev & 0777777,
382	$ino & 0777777,
383	$mode & 0777777,
384	$uid & 0777777,
385	$gid & 0777777,
386	$nlink & 0777777,
387	$rdev & 0177777,
388	$mtime,
389	length($nm)+1,
390	$size,
391	$nm);
392	}
393	else {
394	$cpout{$fh} .= "\0" if length($cpout{$fh}) & 1;
395	$cpout{$fh} .= pack("SSSSSSSSLSLa*",
396	070707, $dev, $ino, $mode, $uid, $gid, $nlink, $rdev, $mtime,
397	length($nm)+1, $size, $nm . (length($nm) & 1 ? "\0" : "\0\0"));
398	}
399	if ($text ne '') {
400	$cpout{$fh} .= $text;
401	}
402	elsif ($size) {
403	&flush($fh) while ($l = length($cpout{$fh})) >= 5120;
404	while (sysread(IN, $cpout{$fh}, 5120 - $l, $l)) {
405	&flush($fh);
406	$l = length($cpout{$fh});
407	}
408	}
409	close IN;
410	}
411
412	sub flush {
413	local($fh) = @_;
414
415	while (length($cpout{$fh}) >= 5120) {
416	syswrite($fh,$cpout{$fh},5120);
417	++$blocks{$fh};
418	substr($cpout{$fh}, 0, 5120) = '';
419	}
420	}
421
422	sub flushall {
423	$name = 'TRAILER!!!';
424	foreach $fh (keys %cpout) {
425	&cpio($nc{$fh},$fh);
426	$cpout{$fh} .= "0" x (5120 - length($cpout{$fh}));
427	&flush($fh);
428	print $blocks{$fh} * 10, " blocks\n";
429	}
430	}
431
432	END
433	}
434
435	if ($inittar) {
436	print <<'END';
437	sub tar {
438	local($fh) = @_;
439	local($linkname,$header,$l,$slop);
440	local($linkflag) = "\0";
441
442	($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
443	$atime,$mtime,$ctime,$blksize,$blocks) = lstat(_);
444	$nm = $name;
445	if ($nlink > 1) {
446	if ($linkname = $linkseen{$fh,$dev,$ino}) {
447	$linkflag = 1;
448	}
449	else {
450	$linkseen{$fh,$dev,$ino} = $nm;
451	}
452	}
453	if (-f _) {
454	open(IN, "./$_\0") \|\| do {
455	warn "Couldn't open $name: $!\n";
456	return;
457	};
458	$size = 0 if $linkflag ne "\0";
459	}
460	else {
461	$linkname = readlink($_);
462	$linkflag = 2 if defined $linkname;
463	$nm .= '/' if -d _;
464	$size = 0;
465	}
466
467	$header = pack("a100a8a8a8a12a12a8a1a100",
468	$nm,
469	sprintf("%6o ", $mode & 0777),
470	sprintf("%6o ", $uid & 0777777),
471	sprintf("%6o ", $gid & 0777777),
472	sprintf("%11o ", $size),
473	sprintf("%11o ", $mtime),
474	" ",
475	$linkflag,
476	$linkname);
477	$l = length($header) % 512;
478	substr($header, 148, 6) = sprintf("%6o", unpack("%16C*", $header));
479	substr($header, 154, 1) = "\0"; # blech
480	$tarout{$fh} .= $header;
481	$tarout{$fh} .= "\0" x (512 - $l) if $l;
482	if ($size) {
483	&tflush($fh) while ($l = length($tarout{$fh})) >= 10240;
484	while (sysread(IN, $tarout{$fh}, 10240 - $l, $l)) {
485	$slop = length($tarout{$fh}) % 512;
486	$tarout{$fh} .= "\0" x (512 - $slop) if $slop;
487	&tflush($fh);
488	$l = length($tarout{$fh});
489	}
490	}
491	close IN;
492	}
493
494	sub tflush {
495	local($fh) = @_;
496
497	while (length($tarout{$fh}) >= 10240) {
498	syswrite($fh,$tarout{$fh},10240);
499	++$blocks{$fh};
500	substr($tarout{$fh}, 0, 10240) = '';
501	}
502	}
503
504	sub tflushall {
505	local($len);
506
507	foreach $fh (keys %tarout) {
508	$len = 10240 - length($tarout{$fh});
509	$len += 10240 if $len < 1024;
510	$tarout{$fh} .= "\0" x $len;
511	&tflush($fh);
512	}
513	}
514
515	END
516	}
517
518	exit;
519
520	############################################################################
521
522	sub tab {
523	local($tabstring);
524
525	$tabstring = "\t" x ($indent / 2) . ' ' x ($indent % 2 * 4);
526	if (!$statdone) {
527	if ($_ =~ /^(name\|print\|prune\|exec\|ok\|\(\|\))/) {
528	$delayedstat++;
529	}
530	else {
531	if ($saw_or) {
532	$tabstring .= <<'ENDOFSTAT' . $tabstring;
533	($nlink \|\| (($dev,$ino,$mode,$nlink,$uid,$gid) = lstat($_))) &&
534	ENDOFSTAT
535	}
536	else {
537	$tabstring .= <<'ENDOFSTAT' . $tabstring;
538	(($dev,$ino,$mode,$nlink,$uid,$gid) = lstat($_)) &&
539	ENDOFSTAT
540	}
541	$statdone = 1;
542	}
543	}
544	$tabstring =~ s/^\s+/ / if $out =~ /!$/;
545	$tabstring;
546	}
547
548	sub fileglob_to_re {
549	local($tmp) = @_;
550
551	$tmp =~ s/([.^\$()])/\\$1/g;
552	$tmp =~ s/([?*])/.$1/g;
553	"^$tmp$";
554	}
555
556	sub n {
557	local($n) = @_;
558
559	$n =~ s/^-/< / \|\| $n =~ s/^\+/> / \|\| $n =~ s/^/== /;
560	$n =~ s/ 0*(\d)/ $1/;
561	$n;
562	}
563
564	sub quote {
565	local($string) = @_;
566	$string =~ s/'/\\'/;
567	"'$string'";
568	}