|
1 # Copyright (c) 2004-2009 Nokia Corporation and/or its subsidiary(-ies). |
|
2 # All rights reserved. |
|
3 # This component and the accompanying materials are made available |
|
4 # under the terms of "Eclipse Public License v1.0" |
|
5 # which accompanies this distribution, and is available |
|
6 # at the URL "http://www.eclipse.org/legal/epl-v10.html". |
|
7 # |
|
8 # Initial Contributors: |
|
9 # Nokia Corporation - initial contribution. |
|
10 # |
|
11 # Contributors: |
|
12 # |
|
13 # Description: |
|
14 # Program to start a perl script that may run for more than 5 second in a new console |
|
15 # and return to the caller. |
|
16 # |
|
17 # |
|
18 |
|
19 use strict; |
|
20 use Carp; |
|
21 use Getopt::Long qw{:config pass_through}; |
|
22 use Win32::Process; |
|
23 my %cpus_to_clients = (2 => 4, |
|
24 4 => 4, |
|
25 8 => 8, |
|
26 16 => 16); |
|
27 |
|
28 my $n = ProcessCommandLine(); |
|
29 |
|
30 if($n == 0) |
|
31 { |
|
32 exit LaunchCommand(@ARGV); |
|
33 } |
|
34 else # $n should be 2, 4 or 8 in this case |
|
35 { |
|
36 my $max = $cpus_to_clients{$n}; |
|
37 my @exit_codes; |
|
38 |
|
39 # Now create $max processes. |
|
40 for my $i(1..$max) |
|
41 { |
|
42 # Make a copy of the initial arg so we can use the # as a placeholder |
|
43 # for the client number. |
|
44 my @updated_args = @ARGV; |
|
45 |
|
46 # Update each argument, replacing # with $i; should only be one "#" |
|
47 for my $arg(@updated_args) |
|
48 { |
|
49 $arg =~ s/#/$i/; |
|
50 } |
|
51 |
|
52 push @exit_codes, LaunchCommand(@updated_args); # Push the exit code onto the array. |
|
53 } |
|
54 |
|
55 # Now process the exit codes. If one is non-zero exit with that code. |
|
56 # If all are zero exit with 0. |
|
57 for my $ec(@exit_codes) |
|
58 { |
|
59 if($ec != 0) |
|
60 { |
|
61 exit $ec; |
|
62 } |
|
63 } |
|
64 |
|
65 exit 0; |
|
66 } |
|
67 |
|
68 ################################################################################ |
|
69 # LaunchCommand # |
|
70 # Inputs: List of arguments to pass to perl exe # |
|
71 # Outputs: Exit code of perl process, if it exits within 5 seconds; 0 if not # |
|
72 ################################################################################ |
|
73 sub LaunchCommand |
|
74 { |
|
75 my @argv = @_; |
|
76 print "Starting @argv\n"; |
|
77 # Create the process |
|
78 Win32::Process::Create(my $proc, "$^X", "$^X @argv", 0, CREATE_NEW_CONSOLE, ".") || croak "ERROR: start @argv :$!"; |
|
79 |
|
80 my $ret = $proc->Wait(5000); # milliseconds. Return value is zero on timeout, else 1. |
|
81 if ($ret == 0) # Wait timed out |
|
82 { # No error from child process (so far) |
|
83 print "@argv Started\n"; |
|
84 return 0; |
|
85 } |
|
86 else # Child process terminated. Wait usually returns 1. |
|
87 { # Error in child process?? Get exit code |
|
88 my $exitcode; |
|
89 $proc->GetExitCode($exitcode); |
|
90 if ($exitcode != 0) |
|
91 { |
|
92 printf "ERROR: @argv failed to start. Exit Code: 0x%04x.\n",$exitcode; |
|
93 } |
|
94 return $exitcode; |
|
95 } |
|
96 } |
|
97 |
|
98 ################################################################################ |
|
99 # ProcessCommandLine # |
|
100 # Inputs: None # |
|
101 # Returns: if specified on the command line, the number of processors; # |
|
102 # otherwise 0 - this indicates that traditional usage of start-perl. # |
|
103 # Remarks: If the number of processors is not defined in hash %cpus_to_clients # |
|
104 # return an "intelligent guess" # |
|
105 ################################################################################ |
|
106 sub ProcessCommandLine |
|
107 { |
|
108 my ($help, $num_of_cpus); |
|
109 GetOptions('h' => \$help, 'n=s' => \$num_of_cpus); |
|
110 if (($help)) # Help |
|
111 { |
|
112 Usage(); |
|
113 } |
|
114 elsif(defined($num_of_cpus)) # Check that the number of clients is valid |
|
115 { |
|
116 unless(defined $cpus_to_clients{$num_of_cpus}) |
|
117 { |
|
118 # Report if the number is not valid. |
|
119 my @iValidList = sort {$a <=> $b} keys %cpus_to_clients; |
|
120 printf "ERROR: Argument -n $num_of_cpus not valid. Must be one of: %s.\n", join (', ', @iValidList); |
|
121 |
|
122 # Then try to guess appropriate number: |
|
123 my $cpus = 0; |
|
124 $cpus = 2 if ($num_of_cpus < 4); |
|
125 $cpus = 4 if ($num_of_cpus > 4 && $num_of_cpus < 8); |
|
126 $cpus = 8 if ($num_of_cpus > 8); |
|
127 print "...choosing valid number: $cpus\n"; |
|
128 return $cpus; |
|
129 } |
|
130 return $num_of_cpus; # Return number if valid |
|
131 } |
|
132 else ## i.e if(!defined($num_of_cpus)) |
|
133 { |
|
134 return 0; |
|
135 } |
|
136 } |
|
137 |
|
138 ################################################################################ |
|
139 # Usage # |
|
140 # Inputs: None # |
|
141 # Outputs: Usage information for the user. # |
|
142 # Remarks: None # |
|
143 ################################################################################ |
|
144 sub Usage |
|
145 { |
|
146 print <<USAGE_EOF; |
|
147 |
|
148 Usage: start-perl.pl [Parameters] |
|
149 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# |
|
150 start-perl.pl %CleanSourceDir%\\os\\buildtools\\bldsystemtools\\buildsystemtools\\BuildClient.pl -d localhost:15011 -d localhost:15012 -d localhost:15013 -w 5 -c Core1 |
|
151 |
|
152 Either start the command with -n <number of processors> followed by a perl script |
|
153 usually BuildClient.pl. In this case the -c argument to BuildClient will be used |
|
154 as a place holder and the # will be replaced by either 4 or 8. |
|
155 |
|
156 The script is backwards compatable with its previous usage. |
|
157 |
|
158 USAGE_EOF |
|
159 exit 1; |
|
160 } |