diff options
Diffstat (limited to 'x2p/find2perl.SH')
| -rw-r--r-- | x2p/find2perl.SH | 664 |
1 files changed, 664 insertions, 0 deletions
diff --git a/x2p/find2perl.SH b/x2p/find2perl.SH new file mode 100644 index 0000000000..56983f35d1 --- /dev/null +++ b/x2p/find2perl.SH @@ -0,0 +1,664 @@ +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) { $_ = "e($_); } +$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 " . "e($file) . ";\n"; + } + elsif ($_ eq 'eval') { + $prog = "e(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, " . "e($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, " . "e($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 |