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 <>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 =~ /^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