#!/import/archperf/ws/devtools/4/v8plus/bin/perl
eval 'exec /import/archperf/ws/devtools/4/v8plus/bin/perl -S $0 ${1+"$@"}'
if $running_under_some_shell;
(my $perlpath = <<'/../') =~ s/\s*\z//;
/import/archperf/ws/devtools/4/v8plus/bin/perl
use File::Spec::Functions 'curdir';
my $startperl = "#! $perlpath -w";
# Modified September 26, 1993 to provide proper handling of years after 1999
# Tom Link <tml+@pitt.edu>
# University of Pittsburgh
# Modified April 7, 1998 with nasty hacks to implement the troublesome -follow
# Billy Constantine <wdconsta@cs.adelaide.edu.au> <billy@smug.adelaide.edu.au>
# University of Adelaide, Adelaide, South Australia
# Modified 1999-06-10, 1999-07-07 to migrate to cleaner perl5 usage
# Ken Pizzini <ken@halcyon.com>
# Modified 2000-01-28 to use the 'follow' option of File::Find
while ($ARGV[0] =~ /^[^-!(]/) {
@roots = (curdir()) unless @roots;
for (@roots) { $_ = quote($_) }
my $roots = join(', ', @roots);
my $declaresubs = "sub wanted;\n";
my ($follow_in_effect,$Skip_And) = (0,0);
s/^-// || /^[()!]/ || die "Unrecognized switch: $_\n";
} elsif ($_ eq 'follow') {
$out .= tab . '/' . fileglob_to_re(shift) . "/s$1";
$out .= tab . '$File::Find::name =~ /' . fileglob_to_re(shift) . "/s$1";
|| die "Malformed -perm argument: $onum\n";
$onum = sprintf("0%o", oct($onum) & 07777);
$out .= "((\$mode & $onum) == $onum)";
$out .= "((\$mode & 0777) == $onum)";
(my $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 .= '($dev >= 0)'; #XXX
$out .= tab . "(\$uid == \$uid{'$uname'})";
} elsif ($_ eq 'group') {
$out .= tab . "(\$gid == \$gid{'$gname'})";
} elsif ($_ eq 'nouser') {
$out .= tab . '!exists $uid{$uid}';
} elsif ($_ eq 'nogroup') {
$out .= tab . '!exists $gid{$gid}';
} elsif ($_ eq 'links') {
$out .= tab . n('$nlink', shift);
$out .= tab . n('$ino', shift);
my $n = 'int(((-s _) + 511) / 512)';
$n = 'int(((-s _) + 1023) / 1024)';
} elsif ($_ eq 'atime') {
$out .= tab . n('int(-A _)', shift);
} elsif ($_ eq 'mtime') {
$out .= tab . n('int(-M _)', shift);
} elsif ($_ eq 'ctime') {
$out .= tab . n('int(-C _)', shift);
while (@ARGV && $ARGV[0] ne ';')
if ($cmd[0] =~m#^(?:(?:/usr)?/bin/)?rm$#
&& (@cmd == 2 || (@cmd == 3 && $cmd[1] eq '-f'))) {
$out .= '(unlink($_) || warn "$name: $!\n")';
$out .= '(unlink($_) || 1)';
{ local $" = "','"; $out .= "doexec(0, '@cmd')"; }
$declaresubs .= "sub doexec (\$\@);\n";
while (@ARGV && $ARGV[0] ne ';')
{ local $" = "','"; $out .= "doexec(1, '@cmd')"; }
$declaresubs .= "sub doexec (\$\@);\n";
} elsif ($_ eq 'prune') {
$out .= tab . '($File::Find::prune = 1)';
$out .= tab . '!($File::Find::prune |= ($dev != $File::Find::topdev))'
} elsif ($_ eq 'newer') {
my $newername = 'AGE_OF' . $file;
$newername = '$' . $newername;
$out .= tab . "(-M _ < $newername)";
$initnewer .= "my $newername = -M " . quote($file) . ";\n";
$out .= tab . "eval {$prog}";
} elsif ($_ eq 'depth') {
$declaresubs .= "sub ls ();\n";
die "-tar must have a filename argument\n" unless @ARGV;
$out .= tab . "tar(*$fh, \$name)";
$flushall .= "tflushall;\n";
$declaresubs .= "sub tar;\nsub tflushall ();\n";
$initfile .= "open($fh, " . quote('> ' . $file) .
qq{) || die "Can't open $fh: \$!\\n";\n};
} elsif (/^(n?)cpio\z/) {
die "-$_ must have a filename argument\n" unless @ARGV;
$out .= tab . "cpio(*$fh, \$name, '$1')";
$flushall .= "cflushall;\n";
$declaresubs .= "sub cpio;\nsub cflushall ();\n";
$initfile .= "open($fh, " . quote('> ' . $file) .
qq{) || die "Can't open $fh: \$!\\n";\n};
die "Unrecognized switch: -$_\n";
{ local($statdone) = 1; $out .= "\n" . tab . "||\n"; }
$statdone = 0 if $indent_depth == 1 && exists $init{delayedstat};
$out .= " &&" unless $Skip_And || $ARGV[0] eq ')';
shift if $ARGV[0] eq '-a';
if ($t !~ /&&\s*$/) { $t .= '&& ' }
$out .= "\n" . $t . 'print("$name\n")';
eval 'exec $perlpath -S \$0 \${1+"\$@"}'
if 0; #\$running_under_some_shell
# Set the variable \$File::Find::dont_use_nlink if you're using AFS,
# for the convenience of &wanted calls, including -eval statements:
use vars qw/*name *dir *prune/;
*name = *File::Find::name;
*prune = *File::Find::prune;
if (exists $init{doexec}) {
my @rwx = qw(--- --x -w- -wx r-- r-x rw- rwx);
my @moname = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
if (exists $init{user} || exists $init{ls} || exists $init{tar}) {
print "my (%uid, %user);\n";
print "while (my (\$name, \$pw, \$uid) = getpwent) {\n";
print ' $uid{$name} = $uid{$uid} = $uid;', "\n"
print ' $user{$uid} = $name unless exists $user{$uid};', "\n"
if exists $init{ls} || exists $init{tar};
if (exists $init{group} || exists $init{ls} || exists $init{tar}) {
print "my (%gid, %group);\n";
print "while (my (\$name, \$pw, \$gid) = getgrent) {\n";
print ' $gid{$name} = $gid{$gid} = $gid;', "\n"
print ' $group{$gid} = $name unless exists $group{$gid};', "\n"
if exists $init{ls} || exists $init{tar};
print $initnewer, "\n" if $initnewer ne '';
print $initfile, "\n" if $initfile ne '';
if (exists $init{declarestat}) {
my ($dev,$ino,$mode,$nlink,$uid,$gid);
if ( $follow_in_effect ) {
$out =~ s/lstat\(\$_\)/lstat(_)/;
# Traverse desired filesystems
File::Find::$find( {wanted => \\&wanted, follow => 1}, $roots);
# Traverse desired filesystems
File::Find::$find({wanted => \\&wanted}, $roots);
if (exists $init{doexec}) {
my @command = @_; # copy so we don't try to s/// aliases to constants
{ $word =~ s#{}#$name#g }
my $old = select(STDOUT);
return 0 unless <STDIN> =~ /^y/;
print <<'INTRO', <<"SUB", <<'END';
sprintf("%3d, %3d", ($rdev >> 8) & 0xff, $rdev & 0xff);
my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
\$atime,\$mtime,\$ctime,\$blksize,\$blocks) = $stat(_);
or $blocks = int(($size + 1023) / 1024);
my $perms = $rwx[$mode & 7];
$perms = $rwx[$mode & 7] . $perms;
$perms = $rwx[$mode & 7] . $perms;
substr($perms, 2, 1) =~ tr/-x/Ss/ if -u _;
substr($perms, 5, 1) =~ tr/-x/Ss/ if -g _;
substr($perms, 8, 1) =~ tr/-x/Tt/ if -k _;
if (-f _) { $perms = '-' . $perms; }
elsif (-d _) { $perms = 'd' . $perms; }
elsif (-l _) { $perms = 'l' . $perms; $pname .= ' -> ' . readlink($_); }
elsif (-c _) { $perms = 'c' . $perms; $size = sizemm($rdev); }
elsif (-b _) { $perms = 'b' . $perms; $size = sizemm($rdev); }
elsif (-p _) { $perms = 'p' . $perms; }
elsif (-S _) { $perms = 's' . $perms; }
else { $perms = '?' . $perms; }
my $user = $user{$uid} || $uid;
my $group = $group{$gid} || $gid;
my ($sec,$min,$hour,$mday,$mon,$timeyear) = localtime($mtime);
$timeyear = sprintf("%02d:%02d", $hour, $min);
printf "%5lu %4ld %-10s %3d %-8s %-8s %8s %s %2d %5s %s\n",
if (exists $init{cpio} || exists $init{tar}) {
my ($fh, $varref, $blksz) = @_;
while (length($$varref) >= $blksz) {
syswrite($fh, $$varref, $blksz);
substr($$varref, 0, $blksz) = '';
if (exists $init{cpio}) {
print <<'INTRO', <<"SUB", <<'END';
my ($fh, $fname, $nc) = @_;
my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
$atime,$mtime,$ctime,$blksize,$blocks);
if ( ! defined $fname ) {
($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
$atime,$mtime,$ctime,$blksize,$blocks) = (0) x 13;
($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
\$atime,\$mtime,\$ctime,\$blksize,\$blocks) = $stat(_);
open(IN, "./$_\0") || do {
warn "Couldn't open $fname: $!\n";
$size = 0 unless defined $text;
sprintf("%06o%06o%06o%06o%06o%06o%06o%06o%011lo%06o%011lo%s\0",
$cpout{$fh} .= "\0" if length($cpout{$fh}) & 1;
$cpout{$fh} .= pack("SSSSSSSSLSLa*",
070707, $dev, $ino, $mode, $uid, $gid, $nlink, $rdev, $mtime,
$fname . (length($fname) & 1 ? "\0" : "\0\0"));
flush($fh, \$cpout{$fh}, 5120)
while ($l = length($cpout{$fh})) >= 5120;
while (sysread(IN, $cpout{$fh}, 5120 - $l, $l)) {
flush($fh, \$cpout{$fh}, 5120);
$l = length($cpout{$fh});
for my $fh (keys %cpout) {
cpio($fh, undef, $nc{$fh});
$cpout{$fh} .= "0" x (5120 - length($cpout{$fh}));
flush($fh, \$cpout{$fh}, 5120);
print $blocks{$fh} * 10, " blocks\n";
print <<'INTRO', <<"SUB", <<'END';
my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
\$atime,\$mtime,\$ctime,\$blksize,\$blocks) = $stat(_);
if ($linkname = $linkseen{$fh, $dev, $ino}) {
if (length($linkname) > 100) {
warn "$0: omitting file with linkname ",
"too long for tar output: $linkname\n";
$linkseen{$fh, $dev, $ino} = $fname;
open(IN, "./$_\0") || do {
warn "Couldn't open $fname: $!\n";
$linkname = readlink($_);
if (defined $linkname) { $typeflag = '2' }
elsif (-c _) { $typeflag = '3' }
elsif (-b _) { $typeflag = '4' }
elsif (-d _) { $typeflag = '5' }
elsif (-p _) { $typeflag = '6' }
if (length($fname) > 100) {
($prefix, $fname) = ($fname =~ m#\A(.*?)/(.{,100})\Z(?!\n)#);
if (!defined($fname) || length($prefix) > 155) {
warn "$0: omitting file with name too long for tar output: ",
$size = 0 if $typeflag ne '0';
my $header = pack("a100a8a8a8a12a12a8a1a100a6a2a32a32a8a8a155",
sprintf("%7o ", $mode & 0777),
sprintf("%7o ", $uid & 0777777),
sprintf("%7o ", $gid & 0777777),
sprintf("%11o ", $mtime),
defined $linkname ? $linkname : '',
substr($header, 148, 8) = sprintf("%7o ", unpack("%16C*", $header));
my $l = length($header) % 512;
$tarout{$fh} .= "\0" x (512 - $l) if $l;
flush($fh, \$tarout{$fh}, 10240)
while ($l = length($tarout{$fh})) >= 10240;
while (sysread(IN, $tarout{$fh}, 10240 - $l, $l)) {
my $slop = length($tarout{$fh}) % 512;
$tarout{$fh} .= "\0" x (512 - $slop) if $slop;
flush($fh, \$tarout{$fh}, 10240);
$l = length($tarout{$fh});
for my $fh (keys %tarout) {
$len = 10240 - length($tarout{$fh});
$len += 10240 if $len < 1024;
$tarout{$fh} .= "\0" x $len;
flush($fh, \$tarout{$fh}, 10240);
############################################################################
$tabstring = "\t" x ($indent_depth/2) . ' ' x ($indent_depth%2 * 4);
if ($_ =~ /^(?:name|print|prune|exec|ok|\(|\))/) {
my $statcall = '(($dev,$ino,$mode,$nlink,$uid,$gid) = '
if (exists $init{saw_or}) {
$tabstring .= "(\$nlink || $statcall) &&\n" . $tabstring;
$tabstring .= "$statcall &&\n" . $tabstring;
$tabstring =~ s/^\s+/ / if $out =~ /!$/;
$x =~ s#([./^\$()+])#\\$1#g;
$n =~ s/^-/< / || $n =~ s/^\+/> / || $n =~ s/^/== /;
find2perl - translate find command lines to Perl code
find2perl [paths] [predicates] | perl
find2perl is a little translator to convert find command lines to
equivalent Perl code. The resulting code is typically faster than
"paths" are a set of paths where find2perl will start its searches and
"predicates" are taken from the following list.
Negate the sense of the following predicate. The C<!> must be passed as
a distinct argument, so it may need to be surrounded by whitespace and/or
quoted from interpretation by the shell using a backslash (just as with
Group the given PREDICATES. The parentheses must be passed as distinct
arguments, so they may need to be surrounded by whitespace and/or
quoted from interpretation by the shell using a backslash (just as with
=item C<PREDICATE1 PREDICATE2>
True if _both_ PREDICATE1 and PREDICATE2 are true; PREDICATE2 is not
evaluated if PREDICATE1 is false.
=item C<PREDICATE1 -o PREDICATE2>
True if either one of PREDICATE1 or PREDICATE2 is true; PREDICATE2 is
not evaluated if PREDICATE1 is true.
Follow (dereference) symlinks. The checking of file attributes depends
on the position of the C<-follow> option. If it precedes the file
check option, an C<stat> is done which means the file check applies to the
file the symbolic link is pointing to. If C<-follow> option follows the
file check option, this now applies to the symbolic link itself, i.e.
Change directory traversal algorithm from breadth-first to depth-first.
Do not descend into the directory currently matched.
Do not traverse mount points (prunes search at mount-point directories).
File name matches specified GLOB wildcard pattern. GLOB may need to be
quoted to avoid interpretation by the shell (just as with using
Like C<-name>, but the match is case insensitive.
Path name matches specified GLOB wildcard pattern.
Like C<-path>, but the match is case insensitive.
Low-order 9 bits of permission match octal value PERM.
The bits specified in PERM are all set in file's permissions.
The file's type matches perl's C<-X> operator.
Filesystem of current path is of type TYPE (only NFS/non-NFS distinction
True if USER is owner of file.
True if file's group is GROUP.
True if file's owner is not in password database.
True if file's group is not in group database.
True file's inode number is INUM.
True if (hard) link count of file matches N (see below).
True if file's size matches N (see below) N is normally counted in
512-byte blocks, but a suffix of "c" specifies that size should be
counted in characters (bytes) and a suffix of "k" specifes that
size should be counted in 1024-byte blocks.
True if last-access time of file matches N (measured in days) (see
True if last-changed time of file's inode matches N (measured in days,
True if last-modified time of file matches N (measured in days, see below).
True if last-modified time of file matches N.
Print out path of file (always true). If none of C<-exec>, C<-ls>,
C<-print0>, or C<-ok> is specified, then C<-print> will be added
Like -print, but terminates with \0 instead of \n.
exec() the arguments in OPTIONS in a subprocess; any occurrence of {} in
OPTIONS will first be substituted with the path of the current
file. Note that the command "rm" has been special-cased to use perl's
unlink() function instead (as an optimization). The C<;> must be passed as
a distinct argument, so it may need to be surrounded by whitespace and/or
quoted from interpretation by the shell using a backslash (just as with
Like -exec, but first prompts user; if user's response does not begin
with a y, skip the exec. The C<;> must be passed as
a distinct argument, so it may need to be surrounded by whitespace and/or
quoted from interpretation by the shell using a backslash (just as with
Has the perl script eval() the EXPR.
Simulates C<-exec ls -dils {} ;>
Adds current output to tar-format FILE.
Adds current output to old-style cpio-format FILE.
Adds current output to "new"-style cpio-format FILE.
Predicates which take a numeric argument N can come in three forms:
* N is prefixed with a +: match values greater than N
* N is prefixed with a -: match values less than N
* N is not prefixed with either + or -: match only values equal to N