bldsystemtools/commonbldutils/start-perl.pl
author Dremov Kirill (Nokia-D-MSW/Tampere) <kirill.dremov@nokia.com>
Tue, 02 Feb 2010 01:39:43 +0200
changeset 0 83f4b4db085c
child 10 d4b442d23379
permissions -rw-r--r--
Revision: 201005 Kit: 201005

# 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;
}