fix int vs STRLEN issue

[p5sagit/p5-mst-13.2.git] / x2p / find2perl.PL

diff --git a/x2p/find2perl.PL b/x2p/find2perl.PL
index 785ffa6..cbb32fd 100644 (file)
--- a/x2p/find2perl.PL
+++ b/x2p/find2perl.PL
@@ -2,6 +2,7 @@
 
 use Config;
 use File::Basename qw(&basename &dirname);
+use Cwd;
 
 # List explicitly here the variables you want Configure to
 # generate.  Metaconfig only looks for shell variables, so you
@@ -12,11 +13,10 @@ use File::Basename qw(&basename &dirname);
 
 # This forces PL files to create target in same directory as PL file.
 # This is so that make depend always knows where to find PL derivatives.
-chdir(dirname($0));
-($file = basename($0)) =~ s/\.PL$//;
-$file =~ s/\.pl$//
-       if ($Config{'osname'} eq 'VMS' or
-           $Config{'osname'} eq 'OS2');  # "case-forgiving"
+$origdir = cwd;
+chdir dirname($0);
+$file = basename($0, '.PL');
+$file .= '.com' if $^O eq 'VMS';
 
 open OUT,">$file" or die "Can't create $file: $!";
 
@@ -26,19 +26,26 @@ print "Extracting $file (with variable substitutions)\n";
 # You can use $Config{...} to use Configure variables.
 
 print OUT <<"!GROK!THIS!";
-$Config{'startperl'}
-    eval 'exec perl -S \$0 "\$@"'
-       if 0;
-\$startperl = $Config{startperl};
+$Config{startperl}
+    eval 'exec $Config{perlpath} -S \$0 \${1+"\$@"}'
+      if \$running_under_some_shell;
+\$startperl = "$Config{startperl}";
+\$perlpath = "$Config{perlpath}";
 !GROK!THIS!
 
 # In the following, perl variables are not expanded during extraction.
 
 print OUT <<'!NO!SUBS!';
+
 # 
 # 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
+# 
 
 while ($ARGV[0] =~ /^[^-!(]/) {
     push(@roots, shift);
@@ -48,6 +55,8 @@ for (@roots) { $_ = &quote($_); }
 $roots = join(',', @roots);
 
 $indent = 1;
+$stat = 'lstat';
+$decl = '';
 
 while (@ARGV) {
     $_ = shift;
@@ -61,6 +70,12 @@ while (@ARGV) {
        $indent--;
        $out .= &tab . ")";
     }
+    elsif ($_ eq 'follow') {
+       $stat = 'stat';
+       $decl = '%already_seen = ();';
+       $out .= &tab . '(not $already_seen{"$dev,$ino"}) &&';
+       $out .= "\n" . &tab . '(($already_seen{"$dev,$ino"} = !(-d _)) || 1)';
+    }
     elsif ($_ eq '!') {
        $out .= &tab . "!";
        next;
@@ -125,7 +140,12 @@ while (@ARGV) {
        $out .= &tab . '($ino ' . &n(shift);
     }
     elsif ($_ eq 'size') {
-       $out .= &tab . '(int(((-s _) + 511) / 512) ' . &n(shift);
+       $_ = shift;
+       if (s/c$//) {
+           $out .= &tab . '(int(-s _) ' . &n($_);
+       } else {
+           $out .= &tab . '(int(((-s _) + 511) / 512) ' . &n($_);
+       }
     }
     elsif ($_ eq 'atime') {
        $out .= &tab . '(int(-A _) ' . &n(shift);
@@ -179,7 +199,7 @@ while (@ARGV) {
        $file = shift;
        $newername = 'AGE_OF' . $file;
        $newername =~ s/[^\w]/_/g;
-       $newername = '$' . $newername;
+       $newername = "\$$newername";
        $out .= "(-M _ < $newername)";
        $initnewer .= "$newername = -M " . &quote($file) . ";\n";
     }
@@ -242,8 +262,7 @@ while (@ARGV) {
 
 print <<"END";
 $startperl
-
-eval 'exec perl -S \$0 \${1+"\$@"}'
+    eval 'exec $perlpath -S \$0 \${1+"\$@"}'
        if \$running_under_some_shell;
 
 END
@@ -280,10 +299,10 @@ require "$find.pl";
 
 # Traverse desired filesystems
 
+$decl
 &$find($roots);
 $flushall
 exit;
-
 sub wanted {
 $out;
 }
@@ -314,10 +333,11 @@ END
 }
 
 if ($initls) {
-    print <<'END';
+    print <<"INTERP", <<'END';
 sub ls {
-    ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$sizemm,
-      $atime,$mtime,$ctime,$blksize,$blocks) = lstat(_);
+    (\$dev,\$ino,\$mode,\$nlink,\$uid,\$gid,\$rdev,\$sizemm,
+      \$atime,\$mtime,\$ctime,\$blksize,\$blocks) = $stat\(_\);
+INTERP
 
     $pname = $name;
 
@@ -382,7 +402,7 @@ END
 }
 
 if ($initcpio) {
-print <<'END';
+print <<'START', <<"INTERP", <<'END';
 sub cpio {
     local($nc,$fh) = @_;
     local($text);
@@ -392,8 +412,10 @@ sub cpio {
        $size = 0;
     }
     else {
-       ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
-         $atime,$mtime,$ctime,$blksize,$blocks) = lstat(_);
+START
+       (\$dev,\$ino,\$mode,\$nlink,\$uid,\$gid,\$rdev,\$size,
+         \$atime,\$mtime,\$ctime,\$blksize,\$blocks) = $stat\(_\);
+INTERP
        if (-f _) {
            open(IN, "./$_\0") || do {
                warn "Couldn't open $name: $!\n";
@@ -467,14 +489,16 @@ END
 }
 
 if ($inittar) {
-print <<'END';
+print <<'START', <<"INTERP", <<'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(_);
+START
+    (\$dev,\$ino,\$mode,\$nlink,\$uid,\$gid,\$rdev,\$size,
+      \$atime,\$mtime,\$ctime,\$blksize,\$blocks) = $stat\(_\);
+INTERP
     $nm = $name;
     if ($nlink > 1) {
        if ($linkname = $linkseen{$fh,$dev,$ino}) {
@@ -563,13 +587,13 @@ sub tab {
        }
        else {
            if ($saw_or) {
-               $tabstring .= <<'ENDOFSTAT' . $tabstring;
-($nlink || (($dev,$ino,$mode,$nlink,$uid,$gid) = lstat($_))) &&
+               $tabstring .= <<"ENDOFSTAT" . $tabstring;
+(\$nlink || ((\$dev,\$ino,\$mode,\$nlink,\$uid,\$gid) = $stat\(\$_\))) &&
 ENDOFSTAT
            }
            else {
-               $tabstring .= <<'ENDOFSTAT' . $tabstring;
-(($dev,$ino,$mode,$nlink,$uid,$gid) = lstat($_)) &&
+               $tabstring .= <<"ENDOFSTAT" . $tabstring;
+((\$dev,\$ino,\$mode,\$nlink,\$uid,\$gid) = $stat\(\$_\)) &&
 ENDOFSTAT
            }
            $statdone = 1;
@@ -605,3 +629,4 @@ sub quote {
 close OUT or die "Can't close $file: $!";
 chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
 exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';
+chdir $origdir;