|
1 #!\bin\perl -w |
|
2 # Copyright (c) 2003-2009 Nokia Corporation and/or its subsidiary(-ies). |
|
3 # All rights reserved. |
|
4 # This component and the accompanying materials are made available |
|
5 # under the terms of the License "Eclipse Public License v1.0" |
|
6 # which accompanies this distribution, and is available |
|
7 # at the URL "http://www.eclipse.org/legal/epl-v10.html". |
|
8 # |
|
9 # Initial Contributors: |
|
10 # Nokia Corporation - initial contribution. |
|
11 # |
|
12 # Contributors: |
|
13 # |
|
14 # Description: |
|
15 # CConfig |
|
16 # |
|
17 |
|
18 package CConfig; |
|
19 |
|
20 use strict; |
|
21 use IO::File; |
|
22 use COutputHandler; |
|
23 |
|
24 # Added for scanlog compatibility |
|
25 use Time::localtime; |
|
26 |
|
27 # CConfig New(scalar aFilename) : constructor |
|
28 sub New($) |
|
29 { |
|
30 my $proto = shift; |
|
31 my ($aFilename) = @_; |
|
32 |
|
33 my $class = ref($proto) || $proto; |
|
34 |
|
35 my $self = { RELTOOLS_REQUIRED => "", |
|
36 outputHandler => COutputHandler->new()}; |
|
37 bless($self, $class); |
|
38 # undef the logfile here so that the folowing warning goes to stdout |
|
39 $self->{iLOGFILE} = undef; |
|
40 # Load in options |
|
41 if (defined($aFilename)) |
|
42 { |
|
43 if (!$self->Reload($aFilename)) |
|
44 { |
|
45 $self->Warning("Option file could not be loaded.\n"); |
|
46 } |
|
47 } |
|
48 |
|
49 # Added support for scanlog and Die() control. |
|
50 $self->{iPhaseErrorCount} = 0; |
|
51 $self->{iPhase} = undef; |
|
52 |
|
53 return $self; |
|
54 } |
|
55 |
|
56 # boolean Set(scalar aOptionName, scalar aValue) |
|
57 sub Set($$) |
|
58 { |
|
59 my $self = shift; |
|
60 my ($aOptionName, $aValue) = @_; |
|
61 |
|
62 if (!defined($aOptionName)) |
|
63 { |
|
64 $self->Warning("Cannot set undefined option"); |
|
65 |
|
66 return 0; |
|
67 } |
|
68 |
|
69 if (!defined($aValue)) |
|
70 { |
|
71 $self->Warning("Cannot set option '$aOptionName' to undefined value."); |
|
72 return 0; |
|
73 } |
|
74 |
|
75 if ((ref($aValue) ne "") && (ref($aValue) ne "ARRAY")) |
|
76 { |
|
77 $self->Warning("Value of '$aOptionName' must be either a string or list."); |
|
78 return 0; |
|
79 } |
|
80 |
|
81 $self->{iOptions}->{lc($aOptionName)} = [$aOptionName, $aValue]; |
|
82 return 1; |
|
83 } |
|
84 |
|
85 # scalar Get(scalar aOptionName) |
|
86 sub Get($) |
|
87 { |
|
88 my $self = shift; |
|
89 my ($aOptionName) = @_; |
|
90 |
|
91 if (defined($self->{iOptions}->{lc($aOptionName)})) |
|
92 { |
|
93 return ($self->{iOptions}->{lc($aOptionName)})->[1]; |
|
94 } |
|
95 else |
|
96 { |
|
97 return undef; |
|
98 } |
|
99 } |
|
100 |
|
101 # boolean Reload(scalar aFilename) |
|
102 sub Reload($) |
|
103 { |
|
104 my $self = shift; |
|
105 my ($aFilename) = @_; |
|
106 my $okay = 1; |
|
107 |
|
108 $self->{iOptions}={}; # Blank existing options |
|
109 |
|
110 if (!open(FILE, $aFilename)) |
|
111 { |
|
112 $self->Warning("Option file '$aFilename' could not be opened."); |
|
113 $okay = 0; |
|
114 } |
|
115 else |
|
116 { |
|
117 foreach my $line (<FILE>) |
|
118 { |
|
119 chomp ($line); |
|
120 |
|
121 # Split on colon |
|
122 my $parms = $line; |
|
123 $parms =~ s/([^\\]):/$1\x08/g; # Turn unescaped colons into 0x08 chars |
|
124 $parms =~ s/\\:/:/g; # Unescape escaped colons |
|
125 my @parms = split(/\x08/,$parms); # Split on 0x08 |
|
126 |
|
127 if (scalar(@parms) != 0) |
|
128 { |
|
129 if (scalar(@parms) == 2) |
|
130 { |
|
131 my $key = $parms[0]; |
|
132 $key =~ s/^\s+//; # Remove preceding spaces |
|
133 $key =~ s/([^\\])\s$/$1/g; # Remove unescaped trailing spaces |
|
134 $key =~ s/\\(\s)/$1/g; # Unescape space characters |
|
135 |
|
136 my $value = $parms[1]; |
|
137 if ($value =~ /\s*\[.*\]\s*$/) |
|
138 { |
|
139 # Value is a [list] |
|
140 |
|
141 # Remove square brackets |
|
142 $value =~ s/^\s*\[//; |
|
143 $value =~ s/\]\s*$//; |
|
144 |
|
145 # Split on comma |
|
146 $value =~ s/([^\\]),/$1\x08/g; # Turn unescaped commas into 0x08 chars |
|
147 $value =~ s/\\,/,/g; # Unescape escaped commas |
|
148 my @values = split(/\x08/,$value); # Split on 0x08 |
|
149 |
|
150 map(s/^\s+//, @values); # Remove preceding spaces |
|
151 map(s/([^\\])\s$/$1/g, @values); # Remove unescaped trailing spaces |
|
152 map(s/\\(\s)/$1/g, @values); # Unescape space characters |
|
153 |
|
154 $value = [@values]; |
|
155 } |
|
156 else |
|
157 { |
|
158 # Value is a scalar |
|
159 |
|
160 $value =~ s/^\s+//; # Remove preceding spaces |
|
161 $value =~ s/([^\\])\s$/$1/g; # Remove unescaped trailing spaces |
|
162 $value =~ s/\\(\s)/$1/g; # Unescape space characters |
|
163 } |
|
164 |
|
165 if (!($self->Set($key, $value))) |
|
166 { |
|
167 $okay = 0; |
|
168 } |
|
169 } |
|
170 else |
|
171 { |
|
172 $self->Warning("In file '$aFilename', ".scalar(@parms)." parameters found on a line.\nOnly two parameters, colon separated, are supported.\nLine: '$line'"); |
|
173 $okay = 0; |
|
174 } |
|
175 } |
|
176 } |
|
177 close(FILE); |
|
178 } |
|
179 |
|
180 return ($okay); |
|
181 } |
|
182 |
|
183 # boolean Save(scalar aFilename) |
|
184 sub Save($) |
|
185 { |
|
186 my $self = shift; |
|
187 my ($aFilename) = @_; |
|
188 my $okay = 1; |
|
189 |
|
190 if (!open(FILE, ">$aFilename")) |
|
191 { |
|
192 $self->Warning("Could not open option file '$aFilename' to save to."); |
|
193 $okay = 0; |
|
194 } |
|
195 else |
|
196 { |
|
197 foreach my $pair (values(%{$self->{iOptions}})) |
|
198 { |
|
199 my $key = $pair->[0]; |
|
200 my $value = $pair->[1]; |
|
201 |
|
202 if (!defined($value)) |
|
203 { |
|
204 $self->Error("Cannot write undefined value for key '$key' when saving options."); |
|
205 $okay = 0; |
|
206 } |
|
207 else |
|
208 { |
|
209 |
|
210 if (ref($value)) |
|
211 { |
|
212 if (ref($value) ne "ARRAY") |
|
213 { |
|
214 $self->Error("Cannot write ".ref($value)." for key '$key' when saving options."); |
|
215 $okay = 0; |
|
216 } |
|
217 else |
|
218 { |
|
219 # It's a list: [value,value,value] and escape any commas or opening spaces |
|
220 my @values = @{$value}; |
|
221 map(s/^(\s)/\\$1/,@values); |
|
222 map(s/,/\\,/g,@values); |
|
223 $value = "[".join(",",@values)."]"; |
|
224 } |
|
225 } |
|
226 else |
|
227 { |
|
228 # It's a scalar string |
|
229 # Escape opening space |
|
230 $key =~ s/^(\s)/\\$1/; |
|
231 # Escape square brackets; |
|
232 } |
|
233 |
|
234 # Escape colons |
|
235 $key =~ s/:/\\:/g; |
|
236 $value =~ s/:/\\:/g; |
|
237 |
|
238 print FILE $key.":".$value."\n"; |
|
239 } |
|
240 } |
|
241 close (FILE) |
|
242 } |
|
243 return $okay; |
|
244 } |
|
245 |
|
246 # boolean SetLog(scalar aFilename) |
|
247 sub SetLog($) |
|
248 { |
|
249 my $self = shift; |
|
250 my ($aLogFile) = @_; |
|
251 |
|
252 if (defined($self->{iLOGFILE})) |
|
253 { |
|
254 $self->{iLOGFILE}->close(); |
|
255 # This forces any subsequent error message to go to stdout |
|
256 $self->{iLOGFILE} = undef; |
|
257 } |
|
258 |
|
259 if (-e $aLogFile) |
|
260 { |
|
261 if (-e $aLogFile."~") |
|
262 { |
|
263 if (!unlink $aLogFile."~") |
|
264 { |
|
265 $self->Error("Couldn't delete backup log file\n"); |
|
266 return 0; |
|
267 } |
|
268 } |
|
269 |
|
270 if (system("copy $aLogFile $aLogFile~ > nul 2>&1")) |
|
271 { |
|
272 $self->Error("Couldn't back-up existing log file\n"); |
|
273 return 0; |
|
274 } |
|
275 } |
|
276 |
|
277 $self->{iLOGFILE}=new IO::File("> $aLogFile"); |
|
278 |
|
279 if (defined($self->{iLOGFILE})) |
|
280 { |
|
281 return 1; |
|
282 } |
|
283 else |
|
284 { |
|
285 $self->Error("Couldn't open logfile $aLogFile\n"); |
|
286 return 0; |
|
287 } |
|
288 } |
|
289 |
|
290 # void Print(scalar aLogLine) |
|
291 sub Print($) |
|
292 { |
|
293 my $self = shift; |
|
294 my ($aLogLine) = @_; |
|
295 |
|
296 my $logfile = $self->{iLOGFILE}; |
|
297 |
|
298 if ($aLogLine !~ /\n$/) |
|
299 { |
|
300 $aLogLine = $aLogLine."\n"; |
|
301 } |
|
302 |
|
303 $aLogLine = $self->{outputHandler}->CheckOutput($aLogLine); |
|
304 |
|
305 if (!defined($logfile)) |
|
306 { |
|
307 print $aLogLine; |
|
308 } |
|
309 else |
|
310 { |
|
311 print $logfile $aLogLine; |
|
312 } |
|
313 } |
|
314 |
|
315 # void Die(scalar aError) |
|
316 sub Die($) |
|
317 { |
|
318 my $self = shift; |
|
319 my ($aError) = @_; |
|
320 |
|
321 my $logfile = $self->{iLOGFILE}; |
|
322 |
|
323 if ($aError !~ /\n$/) |
|
324 { |
|
325 $aError = $aError."\n"; |
|
326 } |
|
327 |
|
328 if (!defined($logfile)) |
|
329 { |
|
330 die $aError; |
|
331 } |
|
332 else |
|
333 { |
|
334 print $logfile $aError; |
|
335 die "ERROR: System experienced a fatal error; check the log file.\n"; |
|
336 } |
|
337 } |
|
338 |
|
339 # void Status(scalar aMessage) |
|
340 sub Status($) |
|
341 { |
|
342 my $self = shift; |
|
343 my ($aMessage) = @_; |
|
344 |
|
345 if (defined($self->{iLOGFILE})) |
|
346 { |
|
347 print STDOUT $aMessage."\n"; # Only display status (to STDOUT) if everything else is going to the logfile |
|
348 } |
|
349 } |
|
350 |
|
351 # Returns the number of errors encountered in a phase |
|
352 sub GetErrorCount() |
|
353 { |
|
354 my $self = shift; |
|
355 return $self->{iPhaseErrorCount}; |
|
356 } |
|
357 |
|
358 ########################################### |
|
359 # Utility functions |
|
360 ########################################### |
|
361 |
|
362 # boolean CheckRelTools() |
|
363 |
|
364 sub CheckRelTools() |
|
365 { |
|
366 # Search for reldata API |
|
367 my $found = 0; |
|
368 foreach my $path (split(/;/,$ENV{PATH})) |
|
369 { |
|
370 if (-e $path."\\reldata\.pm") |
|
371 { |
|
372 $found = 1; |
|
373 last; |
|
374 } |
|
375 } |
|
376 |
|
377 return $found |
|
378 } |
|
379 |
|
380 # void RequireRelTools() - Requires RelData and IniData. Dies if tools can't be located, or die when being required. |
|
381 |
|
382 sub RequireRelTools() |
|
383 { |
|
384 my $self = shift; |
|
385 |
|
386 if ($self->{RELTOOLS_REQUIRED} ne "required") |
|
387 { |
|
388 # Locate reldata API |
|
389 my $found = 0; |
|
390 foreach my $path (split(/;/,$ENV{PATH})) |
|
391 { |
|
392 if (-e $path."\\reldata\.pm") |
|
393 { |
|
394 push @INC, $path; |
|
395 $found = 1; |
|
396 last; |
|
397 } |
|
398 } |
|
399 |
|
400 if (!$found) |
|
401 { |
|
402 $self->Error("Couldn't find release tools in path"); |
|
403 } |
|
404 |
|
405 # Require core modules |
|
406 require RelData; |
|
407 require IniData; |
|
408 $self->{RELTOOLS_REQUIRED}="required"; |
|
409 } |
|
410 } |
|
411 |
|
412 ########################################### |
|
413 # Handling Commands, Phases and components. |
|
414 ########################################### |
|
415 |
|
416 # void Command(scalar aMessage) |
|
417 # Prints out a command in scanlog format to the log file or stdout |
|
418 sub Command($) |
|
419 { |
|
420 my $self = shift; |
|
421 my ($aCommand) = @_; |
|
422 my $message = "===-------------------------------------------------\n=== Stage=$self->{stageNumber}.$aCommand\n===-------------------------------------------------\n"; my $logfile = $self->{iLOGFILE}; |
|
423 $self->Print($message); |
|
424 } |
|
425 |
|
426 # void PhaseStart(scalar aPhaseName) |
|
427 # If a current phase is active then this is closed, if when doing so a |
|
428 # non-zero error count is returned by PhaseEnd() then Die is called. This |
|
429 # is regarded as a logic error as the stage runner should normally call PhaseEnd() |
|
430 # itself and decide what to do about any errors that occured in that phase. |
|
431 sub PhaseStart($) |
|
432 { |
|
433 my $self = shift; |
|
434 my $phase = shift; |
|
435 if (defined $self->{iPhase}) |
|
436 { |
|
437 my $numErrs = $self->PhaseEnd(); |
|
438 # If there are errors returned by PhaseEnd then Die() |
|
439 if ($numErrs != 0) |
|
440 { |
|
441 $self->Die("Fatal logic error detected, CConfig::PhaseStart() called without PhaseEnd() when phase has $numErrs errors.\n"); |
|
442 } |
|
443 } |
|
444 |
|
445 $self->{stageNumber}++; # For scanlog compatibility |
|
446 |
|
447 |
|
448 $self->Command($phase); |
|
449 $self->{iPhase} = $phase; |
|
450 |
|
451 my $localTime = ctime(); |
|
452 my $message = "=== Stage=$self->{stageNumber}.$self->{iPhase} started $localTime\n"; |
|
453 $message .= "=== Stage=$self->{stageNumber}.$self->{iPhase} == $self->{iPhase}\n"; # For Scanlog compatibility |
|
454 $message .= "+++ HiRes Start " . time() . "\n"; # For Scanlog compatibility |
|
455 $message .= "-- $self->{iPhase}: Miscellaneous\n"; # For Scanlog compatibility |
|
456 $self->Print($message); |
|
457 $self->{iPhaseErrorCount} = 0; |
|
458 } |
|
459 |
|
460 # scalar PhaseEnd(void) |
|
461 # Closes the current phase and returns a count of the number of errors encountered. |
|
462 # This will die if a PhaseStart() has not been declared. |
|
463 sub PhaseEnd() |
|
464 { |
|
465 my $self = shift; |
|
466 my $localTime = ctime(); |
|
467 if (defined $self->{iPhase}) |
|
468 { |
|
469 my $message = "+++ HiRes End " . time() . "\n"; # For Scanlog compatibility |
|
470 $message .= "=== Stage=$self->{stageNumber}.$self->{iPhase} finished $localTime\n"; |
|
471 $self->Print($message); |
|
472 } |
|
473 else |
|
474 { |
|
475 $self->Die("Error: CConfig::PhaseEnd() called without corresponding PhaseStart()\n"); |
|
476 } |
|
477 $self->{iPhase} = undef; |
|
478 return $self->{iPhaseErrorCount}; |
|
479 } |
|
480 |
|
481 # void Component(scalar aComponent) |
|
482 # Prints out a component for this phase in scanlog format to the log file or stdout |
|
483 sub Component($) |
|
484 { |
|
485 my $self = shift; |
|
486 my ($aComponent) = @_; |
|
487 if (!defined $self->{iPhase}) |
|
488 { |
|
489 $self->Die("Logger: Undefined phase for component \"$aComponent\"\n"); |
|
490 } |
|
491 else |
|
492 { |
|
493 my $message = "+++ HiRes End " . time() . "\n-- $aComponent\n+++ HiRes Start " . time(); |
|
494 $self->Print($message); |
|
495 } |
|
496 } |
|
497 |
|
498 ############################### |
|
499 # Handling errors and warnings. |
|
500 ############################### |
|
501 |
|
502 # void Error(scalar aMessage) |
|
503 # Writes an error message to the logfile (if defined) or stdout |
|
504 # and will increment the error count for this phase. |
|
505 sub Error($) |
|
506 { |
|
507 my $self = shift; |
|
508 my ($aMessage) = @_; |
|
509 $self->{iPhaseErrorCount} += 1; |
|
510 my $message = "ERROR: $aMessage"; |
|
511 $self->Print($message); |
|
512 } |
|
513 |
|
514 # void Warning(scalar aMessage) |
|
515 # Writes an warning message to the logfile (if defined) or stdout |
|
516 sub Warning($) |
|
517 { |
|
518 my $self = shift; |
|
519 my ($aMessage) = @_; |
|
520 my $message = "WARNING: $aMessage"; |
|
521 $self->Print($message); |
|
522 } |
|
523 |
|
524 sub DESTROY |
|
525 { |
|
526 my $self = shift; |
|
527 |
|
528 # Avoid "unreferenced scalar" error in Perl 5.6 by not calling |
|
529 # PhaseEnd method for each object in multi-threaded CDelta.pm |
|
530 |
|
531 if ((defined $self->{iPhase}) && ($self->{iPhase} !~ /CDelta/)) { |
|
532 $self->PhaseEnd; |
|
533 } |
|
534 |
|
535 if (defined($self->{iLOGFILE})) |
|
536 { |
|
537 $self->{iLOGFILE}->close(); |
|
538 $self->{iLOGFILE} = undef; |
|
539 } |
|
540 } |
|
541 1; |