summaryrefslogtreecommitdiff
path: root/x2p/find2perl
diff options
context:
space:
mode:
Diffstat (limited to 'x2p/find2perl')
-rwxr-xr-xx2p/find2perl568
1 files changed, 568 insertions, 0 deletions
diff --git a/x2p/find2perl b/x2p/find2perl
new file mode 100755
index 0000000000..62e6b1b740
--- /dev/null
+++ b/x2p/find2perl
@@ -0,0 +1,568 @@
+#!/usr/local/bin/perl
+
+eval 'exec /usr/local/bin/perl -S $0 ${1+"$@"}'
+ if $running_under_some_shell;
+
+$bin = "/usr/local/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'";
+}