[win32] merge change#897 from maintbranch

p4raw-link: @897 on //depot/maint-5.004/perl: f06f9b6fc5a686f0169ee2a91b32d5e7125a44ae

p4raw-id: //depot/win32/perl@974

1 files changed, 35 insertions, 16 deletions

diff --git a/x2p/find2perl.PL b/x2p/find2perl.PL
index c23fc923a8..ea13c710f9 100644
--- a/x2p/find2perl.PL
+++ b/x2p/find2perl.PL
@@ -26,7 +26,7 @@ print "Extracting $file (with variable substitutions)\n";
 print OUT <<"!GROK!THIS!";
 $Config{startperl}
     eval 'exec $Config{perlpath} -S \$0 \${1+"\$@"}'
-	if \$running_under_some_shell;
+      if \$running_under_some_shell;
 \$startperl = "$Config{startperl}";
 \$perlpath = "$Config{perlpath}";
 !GROK!THIS!
@@ -34,10 +34,16 @@ $Config{startperl}
 # 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);
@@ -47,6 +53,8 @@ for (@roots) { $_ = &quote($_); }
 $roots = join(',', @roots);
 
 $indent = 1;
+$stat = 'lstat';
+$decl = '';
 
 while (@ARGV) {
     $_ = shift;
@@ -60,6 +68,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;
@@ -178,7 +192,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";
     }
@@ -278,10 +292,10 @@ require "$find.pl";
 
 # Traverse desired filesystems
 
+$decl
 &$find($roots);
 $flushall
 exit;
-
 sub wanted {
 $out;
 }
@@ -312,10 +326,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;
 
@@ -380,7 +395,7 @@ END
 }
 
 if ($initcpio) {
-print <<'END';
+print <<'START', <<"INTERP", <<'END';
 sub cpio {
     local($nc,$fh) = @_;
     local($text);
@@ -390,8 +405,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";
@@ -465,14 +482,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}) {
@@ -561,13 +580,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;