usr/src/contrib/perl-4.036/x2p/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'";
}