diff -r 000000000000 -r 83f4b4db085c bldsystemtools/commonbldutils/start-perl.pl --- /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 < 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; +}