bldsystemtools/commonbldutils/start-perl.pl
changeset 0 83f4b4db085c
child 10 d4b442d23379
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/bldsystemtools/commonbldutils/start-perl.pl	Tue Feb 02 01:39:43 2010 +0200
@@ -0,0 +1,160 @@
+# Copyright (c) 2004-2009 Nokia Corporation and/or its subsidiary(-ies).
+# All rights reserved.
+# This component and the accompanying materials are made available
+# under the terms of "Eclipse Public License v1.0"
+# which accompanies this distribution, and is available
+# at the URL "http://www.eclipse.org/legal/epl-v10.html".
+#
+# Initial Contributors:
+# Nokia Corporation - initial contribution.
+#
+# Contributors:
+#
+# Description:
+# Program to start a perl script that may run for more than 5 second in a new console
+# and return to the caller.
+# 
+#
+
+use strict;
+use Carp;
+use Getopt::Long qw{:config pass_through};
+use Win32::Process;
+my %cpus_to_clients = (2 => 4,
+                       4 => 4,
+                       8 => 8,
+                      16 => 16);
+
+my $n = ProcessCommandLine();
+
+if($n == 0)
+{
+  exit LaunchCommand(@ARGV);
+}
+else # $n should be 2, 4 or 8 in this case
+{
+  my $max = $cpus_to_clients{$n};
+  my @exit_codes;
+  
+  # Now create $max processes. 
+  for my $i(1..$max)
+  {
+    # Make a copy of the initial arg so we can use the # as a placeholder
+    # for the client number.
+    my @updated_args = @ARGV;
+    
+    # Update each argument, replacing # with $i; should only be one "#"
+    for my $arg(@updated_args)
+    {
+      $arg =~ s/#/$i/;
+    }
+    
+    push @exit_codes, LaunchCommand(@updated_args); # Push the exit code onto the array.
+  }
+  
+  # Now process the exit codes. If one is non-zero exit with that code.
+  # If all are zero exit with 0.
+  for my $ec(@exit_codes)
+  {
+    if($ec != 0)
+    {
+      exit $ec; 
+    }
+  }
+  
+  exit 0;
+}
+
+################################################################################
+# LaunchCommand                                                                #
+# Inputs: List of arguments to pass to perl exe                                #
+# Outputs: Exit code of perl process, if it exits within 5 seconds; 0 if not   #
+################################################################################
+sub LaunchCommand
+{
+  my @argv = @_;
+  print "Starting @argv\n";
+  # Create the process
+  Win32::Process::Create(my $proc, "$^X", "$^X @argv", 0, CREATE_NEW_CONSOLE, ".") || croak "ERROR: start @argv :$!";
+
+  my $ret = $proc->Wait(5000);      # milliseconds. Return value is zero on timeout, else 1.
+  if ($ret == 0)    # Wait timed out
+  {                 # No error from child process (so far)
+    print "@argv Started\n";
+    return 0;
+  }
+  else              # Child process terminated. Wait usually returns 1.
+  {                 # Error in child process?? Get exit code
+    my $exitcode;
+    $proc->GetExitCode($exitcode);
+    if ($exitcode != 0)
+    {
+      printf "ERROR: @argv failed to start. Exit Code: 0x%04x.\n",$exitcode;
+    }
+    return $exitcode;
+  }
+}
+
+################################################################################
+# ProcessCommandLine                                                           #
+# Inputs: None                                                                 #
+# Returns: if specified on the command line, the number of processors;         #
+#          otherwise 0 - this indicates that traditional usage of start-perl.  #
+# Remarks: If the number of processors is not defined in hash %cpus_to_clients #
+#          return an "intelligent guess"                                       #
+################################################################################
+sub ProcessCommandLine
+{
+    my ($help, $num_of_cpus);
+    GetOptions('h' => \$help, 'n=s' => \$num_of_cpus);
+    if (($help)) # Help 
+    {
+        Usage();
+    }
+    elsif(defined($num_of_cpus)) # Check that the number of clients is valid
+    {
+	  unless(defined $cpus_to_clients{$num_of_cpus})
+	  {
+		  # Report if the number is not valid.
+		  my @iValidList = sort {$a <=> $b} keys %cpus_to_clients;
+		  printf "ERROR: Argument -n $num_of_cpus not valid. Must be one of: %s.\n", join (', ', @iValidList);
+		  
+		  # Then try to guess appropriate number:
+		  my $cpus = 0;
+		  $cpus = 2 if ($num_of_cpus < 4);
+		  $cpus = 4 if ($num_of_cpus > 4 && $num_of_cpus < 8);
+		  $cpus = 8 if ($num_of_cpus > 8);
+		  print "...choosing valid number: $cpus\n";
+		  return $cpus;
+	  }
+      return $num_of_cpus; # Return number if valid
+    }
+    else ## i.e if(!defined($num_of_cpus))
+    {
+      return 0;
+    }
+}
+
+################################################################################
+# Usage                                                                        #
+# Inputs: None                                                                 #
+# Outputs: Usage information for the user.                                     #
+# Remarks: None                                                                #
+################################################################################
+sub Usage
+{
+    print <<USAGE_EOF;
+
+Usage: start-perl.pl [Parameters]
+  start-perl.pl -n %NUMBER_OF_PROCESSORS% %CleanSourceDir%\\os\\buildtools\\bldsystemtools\\buildsystemtools\\BuildClient.pl -d localhost:15011 -d localhost:15012 -d localhost:15013 -w 5 -c Core#
+  start-perl.pl %CleanSourceDir%\\os\\buildtools\\bldsystemtools\\buildsystemtools\\BuildClient.pl -d localhost:15011 -d localhost:15012 -d localhost:15013 -w 5 -c Core1
+  
+  Either start the command with -n <number of processors> followed by a perl script
+  usually BuildClient.pl. In this case the -c argument to BuildClient will be used
+  as a place holder and the # will be replaced by either 4 or 8.
+  
+  The script is backwards compatable with its previous usage.
+
+USAGE_EOF
+    exit 1;
+}