ChangeLogTag: Tue Jun 10 11:09:12 2003 Chad Elliott <elliott_c@ociweb.com>

3 files changed, 182 insertions, 37 deletions

diff --git a/bin/PerlACE/Process.pm b/bin/PerlACE/Process.pm
index 62c0565cb2c..9d671598f96 100644
--- a/bin/PerlACE/Process.pm
+++ b/bin/PerlACE/Process.pm
@@ -4,9 +4,33 @@ package PerlACE::Process;
 
 use strict;
 use English;
+use POSIX qw(:time_h);
 
 $PerlACE::Process::ExeSubDir = './';
 
+sub delay_factor {
+  my($lps)    = 128;
+  my($factor) = 1;
+
+  ## Keep increasing the loops per second until the amount of time
+  ## exceeds the number of clocks per second.  The original code
+  ## did not multiply $ticks by 8 but, for faster machines, it doesn't
+  ## seem to return false values.  The multiplication is done to minimize
+  ## the amount of time it takes to determine the correct factor.
+  while(($lps <<= 1)) {
+    my($ticks) = clock();
+    for(my $i = $lps; $i >= 0; $i--) {
+    }
+    $ticks = clock() - $ticks;
+    if ($ticks * 8 >= CLOCKS_PER_SEC) {
+      $factor = 500000 / (($lps / $ticks) * CLOCKS_PER_SEC);
+      last;
+    }
+  }
+
+  return $factor;
+}
+
 ### Check for -ExeSubDir commands, store the last one
 my @new_argv = ();
 
diff --git a/bin/PerlACE/Run_Test.pm b/bin/PerlACE/Run_Test.pm
index d56899d5ae6..50a41484e3d 100644
--- a/bin/PerlACE/Run_Test.pm
+++ b/bin/PerlACE/Run_Test.pm
@@ -27,6 +27,10 @@ sub LocalFile ($)
     if ($^O eq "MSWin32") {
         $newfile =~ s/\//\\/g;
     }
+    elsif ($^O eq 'cygwin') {
+        chop($newfile = `/usr/bin/cygpath -w $newfile`);
+        $newfile =~ s/\\/\\\\/g;
+    }
 
     return $newfile;
 }
@@ -55,7 +59,7 @@ sub uniqueid
   }
   else
   {
-    return getpwnam (getlogin ());
+    return $>;
   }
 }
 
diff --git a/bin/create_ace_build b/bin/create_ace_build
index 9c917d564b8..fa3151e0546 100755
--- a/bin/create_ace_build
+++ b/bin/create_ace_build
@@ -30,6 +30,10 @@ eval '(exit $?0)' && eval 'exec perl -S $0 ${1+"$@"}'
 # full path to perl, as long as it is in the user's PATH.
 # Taken from perlrun man page.
 
+use File::Find ();
+use File::Basename;
+use FileHandle;
+
 $usage = "usage: $0 -? | [-a] [-d <directory mode>] [-v] <build name>\n";
 $directory_mode = 0777;   #### Will be modified by umask, also.
 $verbose = 0;
@@ -55,6 +59,35 @@ PERL5_CWD
   }
 }
 
+my($starting_dir) = cwd ();
+my(@nlinks)       = ();
+my($build_re)     = undef;
+
+sub cab_link {
+  my($real) = shift;
+  my($fake) = shift;
+  my($uif)  = ($^O eq 'MSWin32' ? 'link' : 'symlink');
+
+  print "$uif $real $fake\n" if $verbose;
+
+  my($status) = 0;
+  if ($^O eq 'MSWin32') {
+    my($fixed) = $fake;
+    $fixed =~ s/$build_re//;
+    push(@nlinks, $fixed);
+
+    chdir(dirname($fake));
+    $status = link ($real, basename($fake));
+    chdir($starting_dir);
+  }
+  else {
+    $status = symlink ($real, $fake);
+  }
+  if (!$status) {
+    warn "$0: $uif to $fake failed\n";
+  }
+}
+
 ####
 #### Process command line args.
 ####
@@ -83,15 +116,22 @@ while ($#ARGV >= 0  &&  $ARGV[0] =~ /^-/) {
 
 die $usage unless $#ARGV == 0;
 $build = $ARGV[0];
-$build =~ s%^build/%%;        #### remove leading "build/", if any
+$build =~ s%^build[/\\]%%;        #### remove leading "build/", if any
 $build = "build/$build";
 
-if (-e '/usr/bin/find') {
-  $find = '/usr/bin/find';
-} elsif (-e '/bin/find') {
-  $find = '/bin/find';
-} else {
-  $find = '/find';
+## Set up the build regular expression use under MSWin32
+if ($^O eq 'MSWin32') {
+  ## Get the original build name
+  $build_re = $build;
+
+  ## Remove any trailing slashes
+  $build_re =~ s/[\\\/]+$//;
+
+  ## Add a single trailing slash
+  $build_re .= '/';
+
+  ## Escape any special characters
+  $build_re =~ s/([\\\$\[\]\(\)\.])/\\$1/g;
 }
 
 ####
@@ -109,19 +149,59 @@ if (-e '/usr/bin/find') {
 ####
 #### Get all ACE plain file and directory names.
 ####
-@files = (`$find . -name CVS -prune \\\
-        -o -name build -prune -o \\\
-    -name '.*obj' -prune -o -name Templates.DB -prune -o \\\
-    \\( ! -type l ! -name core ! -name '*.state' ! -name '*.so' \\\
-    ! -name '*.[oa]' ! -name '*~' ! -name '.' ! -name '.#*' \\\
-    ! -name '*.log' \\) \\\
-    -print`);
+@files = ();
+
+sub wanted {
+    my ($dev,$ino,$mode,$nlink,$uid,$gid);
+
+    /^CVS\z/s &&
+    ($File::Find::prune = 1)
+    ||
+    /^build\z/s &&
+    ($File::Find::prune = 1)
+    ||
+    /^\..*obj\z/s &&
+    ($File::Find::prune = 1)
+    ||
+    /^Templates\.DB\z/s &&
+    ($File::Find::prune = 1)
+    ||
+    /^Debug\z/s &&
+    ($File::Find::prune = 1)
+    ||
+    /^Release\z/s &&
+    ($File::Find::prune = 1)
+    ||
+    /^Static_Debug\z/s &&
+    ($File::Find::prune = 1)
+    ||
+    /^Static_Release\z/s &&
+    ($File::Find::prune = 1)
+    ||
+    ( 
+        ($nlink || (($dev,$ino,$mode,$nlink,$uid,$gid) = lstat($_))) &&
+        ! -l $_ &&
+        ! /^core\z/s &&
+        ! /^.*\.state\z/s &&
+        ! /^.*\.so\z/s &&   
+        ! /^.*\.[oa]\z/s && 
+        ! /^.*\.dll\z/s &&   
+        ! /^.*\.lib\z/s && 
+        ! /^.*\.obj\z/s && 
+        ! /^.*~\z/s &&
+        ! /^\.\z/s && 
+        ! /^\.#.*\z/s &&
+        ! /^.*\.log\z/s 
+    ) &&
+    push(@files, $File::Find::name);
+}
+
+File::Find::find({wanted => \&wanted}, '.');
 
 ####
 #### Create directories and symlinks to files.
 ####
 foreach $file (@files) {
-  chop $file;         #### remove trailing newline (from find command above)
   $file =~ s%^./%%g;  #### excise leading ./ directory component
 
   if (-d $file) {
@@ -137,14 +217,10 @@ foreach $file (@files) {
           $up .= '/..';
         }
 
-        print "symlink $up/$file $build/$file\n" if $verbose;
-        symlink ("$up/$file", "$build/$file")  ||
-          warn "$0: symlink to $build/$file failed\n";
+        cab_link("$up/$file", "$build/$file");
       } else {
         $path = $source . '/' . $file;
-        print "symlink $path $build/$file\n" if $verbose;
-        symlink ("$path", "$build/$file")  ||
-        warn "$0: symlink to $build/$file failed\n";
+        cab_link("$path", "$build/$file");
       }
     }
   }
@@ -154,29 +230,70 @@ foreach $file (@files) {
 #### Find all the symlinks in the build directory, and remove ones
 #### that are no longer actually linked to a file.
 ####
-open (LINKS, "$find $build -type l |") ||
-  die "$0: cannot find symlinks in $build\n";
-
-while (<LINKS>) {
-  chop;
-  local @s = stat $_;
-  if ($#s == -1) {
-    print "Removing $_ \n" if $verbose;
-    unlink $_  ||  warn "$0: unlink of $_ failed\n";
+
+if ($^O eq 'MSWin32') {
+  my($lfh) = new FileHandle();
+  my($txt) = "$build/create_ace_build.links";
+  if (open($lfh, "$txt")) {
+    while(<$lfh>) {
+      my($line) = $_;
+      $line =~ s/\s+$//;
+      if (-e $line) {
+        push(@nlinks, $line);
+      }
+      else {
+        print "Removing $build/$line \n" if $verbose;
+        unlink("$build/$line") || warn "$0: unlink of $build/$line failed\n";
+      }
+    }
+    close($lfh);
+  }
+
+  ## Rewrite the link file.
+  unlink($txt);
+  if (open($lfh, ">$txt")) {
+    foreach my $file (@nlinks) {
+      print $lfh "$file\n";
+    }
+    close($lfh);
+  }
+}
+else {
+  @lfiles = ();
+
+  sub lcheck {
+    ## There's no way to know if we have hard linked back to a now
+    ## non-existent file.  So, just do the normal -l on the file
+    ## which will cause no files to be pushed on Windows.
+    if (-l $_) {
+      push(@lfiles, $File::Find::name);
+    }
+  }
+
+  File::Find::find({wanted => \&lcheck}, $build);
+
+  foreach (@lfiles) {
+    local @s = stat $_;
+    if ($#s == -1) {
+      print "Removing $_ \n" if $verbose;
+      unlink $_  ||  warn "$0: unlink of $_ failed\n";
+    }
   }
 }
-close (LINKS) ||
-  die "$0: cannot close symlinks pipe\n";
 
 ####
 #### Done: print message.
 ####
 print "\nCompleted creation of $build/.\n";
 
-unless (-e "$build/ace/config.h"  &&
-        -e "$build/include/makeinclude/platform_macros.GNU") {
-  print "Be sure to setup $build/ace/config.h and\n" .
-        "$build/include/makeinclude/platform_macros.GNU symlinks.\n";
+if (! -e "$build/ace/config.h") {
+  print "Be sure to setup $build/ace/config.h";
+}
+
+if ($^O ne 'MSWin32' &&
+    ! -e "$build/include/makeinclude/platform_macros.GNU") {
+  print " and\n$build/include/makeinclude/platform_macros.GNU";
 }
+print ".\n";
 
 #### EOF