|
1 #============================================================================ |
|
2 #Name : getenv.pl |
|
3 #Part of : Helium |
|
4 |
|
5 #Copyright (c) 2009 Nokia Corporation and/or its subsidiary(-ies). |
|
6 #All rights reserved. |
|
7 #This component and the accompanying materials are made available |
|
8 #under the terms of the License "Eclipse Public License v1.0" |
|
9 #which accompanies this distribution, and is available |
|
10 #at the URL "http://www.eclipse.org/legal/epl-v10.html". |
|
11 # |
|
12 #Initial Contributors: |
|
13 #Nokia Corporation - initial contribution. |
|
14 # |
|
15 #Contributors: |
|
16 # |
|
17 #Description: Cleaned version. |
|
18 #============================================================================ |
|
19 |
|
20 use strict; # strict naming rules |
|
21 use Cwd; # figuring out directories |
|
22 use Data::Dumper; # debugging purposes |
|
23 use XML::Simple; # for using xml parser |
|
24 use File::Copy; # for copying files |
|
25 use SOAP::Lite; # SOAP interface for s60build server |
|
26 use Getopt::Long; # parameter handling |
|
27 Getopt::Long::Configure( "bundling_override","ignore_case_always" ); |
|
28 # uncomment to get SOAP debug traces |
|
29 # use SOAP::Lite +trace => 'debug'; |
|
30 |
|
31 # variables for commandline params |
|
32 my( $param_help, # print help |
|
33 $param_server, # manually select server |
|
34 $param_release_path, # where are the releases located in the server |
|
35 $param_debug, # parameter for controlling extra debug prints |
|
36 $param_latest, # just grab the latest build (requires product name) |
|
37 $param_keepgoing, # continue even if dependency is missing |
|
38 $param_print_only, # do nothing but print system calls |
|
39 $param_skipITD, # do not extract internal, testsources and documentation |
|
40 $param_emuenv, # extract only emulator environment |
|
41 $param_start_directly,# starts extracting directly without waiting user acceptance |
|
42 $param_product, # manually insert product name |
|
43 $param_skip_deps, # do not extract dependencies |
|
44 $param_grace, # do not check for grace access |
|
45 $param_no_soap, # dont use soap connection |
|
46 @param_exclude, # exclude list |
|
47 @param_include ); # include list |
|
48 |
|
49 # read commandline parameters |
|
50 my $result = GetOptions('help' => \$param_help, # print help |
|
51 'h' => \$param_help, # print help |
|
52 'latest' => \$param_latest, # just grab the latest build (requires product name) |
|
53 'server=s' => \$param_server, # manually select server |
|
54 'path=s' => \$param_release_path, # extract this release directly |
|
55 'verbose' => \$param_debug, # verbose debug print |
|
56 'k' => \$param_keepgoing, # continue even if there is any problems |
|
57 'p' => \$param_print_only, # do nothing but print system calls |
|
58 'skipitd' => \$param_skipITD, # Deprecated: do not extract internal, testsources and documentation |
|
59 'emu' => \$param_emuenv, # Deprecated: extract only emulator environment |
|
60 'start' => \$param_start_directly, # starts extracting directly without waiting user acceptance |
|
61 'product=s' => \$param_product, # manually insert product name |
|
62 'x=s' => \@param_exclude, # filer list for excluding zips |
|
63 'exclude=s' => \@param_exclude, # filer list for excluding zips |
|
64 'i=s' => \@param_include, # filer list for including zips |
|
65 'include=s' => \@param_include, # filer list for including zips |
|
66 'nodeps' => \$param_skip_deps, # do not extract dependencies |
|
67 'grace' => \$param_grace, # try to DL from GRACE |
|
68 'nosoap' => \$param_no_soap ); # dont try using SOAP for s60builds server |
|
69 |
|
70 # enums for error situations |
|
71 my $warning = 1; |
|
72 my $promptUser = 2; |
|
73 my $dependencyMissing = 3; |
|
74 my $cannotContinue = 4; |
|
75 |
|
76 # common global variables |
|
77 my $metaDataXml; # path to metadata file |
|
78 my $currentReleaseXml; # path to currentRelease.xml if exists |
|
79 my $pathToReleaseFolder; # path to server that has releases |
|
80 my $defaultServiceName; # default name for service (s60rnd) |
|
81 my $pathToUnzip; # path to unzip tool |
|
82 my $tmpDlDir; # path to temp dir where we'll DL packages to |
|
83 my $tmpDir; # path to temp dir where we extract packages from |
|
84 my $returnValue; # holds the error codes coming from 7-zip |
|
85 my $graceServer; # path to local grace server if accessible |
|
86 my $logFile; # log file for troubleshooting |
|
87 my %packageHash; # hash containing zips to extract |
|
88 my @finalZipList; # contains final list of files to unzip |
|
89 my $getEnvVersion; # version of this getenv script |
|
90 my $soapConnection; # holding boolean value wheter we have connection s60builds server |
|
91 my $soapSessionID; # holds the session ID received from SOAP server |
|
92 my $defaultPathToServer; # default value for the server |
|
93 my $soapServiceURL = undef; |
|
94 |
|
95 # list of GRACE samba shares - must match to @graceNameList |
|
96 my @graceList = (); |
|
97 # must match to @graceList |
|
98 my @graceNameList = (); |
|
99 |
|
100 #these 2 lists need to match |
|
101 my @serviceList = (); |
|
102 my @serviceNameList = (); |
|
103 |
|
104 # default values |
|
105 $tmpDir = FixPaths( getcwd )."temp"; |
|
106 $tmpDlDir = FixPaths( getcwd )."DlTemp"; |
|
107 $defaultServiceName = undef; |
|
108 #$logFile = getcwd."/getenv.log"; |
|
109 $pathToReleaseFolder = undef; |
|
110 $defaultPathToServer = undef; |
|
111 $pathToUnzip = "7za"; |
|
112 $getEnvVersion = "2.4.0"; |
|
113 |
|
114 # first open/create log file |
|
115 #open( LOGFILE, ">> $logFile" ) or handleError( "cant create log file: $!", $warning ); |
|
116 eval { |
|
117 open( LOGFILE, ">> getcwd.'/output/logs/getenv.log'" ); |
|
118 }; |
|
119 if ($@) #if exception |
|
120 { |
|
121 open( LOGFILE, ">> getcwd.'/getenv.log'" ) ; |
|
122 } |
|
123 |
|
124 print "S60 RnD environment getter v.$getEnvVersion\n\n"; |
|
125 printLog( "getenv.pl version $getEnvVersion" ); |
|
126 |
|
127 # The actual functionality |
|
128 if( $param_grace ) { |
|
129 # ToDo: find more clever way to figure out access |
|
130 $graceServer = FindGraceServer( ); |
|
131 } |
|
132 else { |
|
133 # print "GRACE access is temporary disabled due to access problems\nEnable GRACE access by running getenv.pl -grace\n"; |
|
134 } |
|
135 ValidateInputs( ); |
|
136 printLog( "Following release we will extract: $metaDataXml" ); |
|
137 PrintFinalWarning( ); |
|
138 DownloadRelease( ); |
|
139 # if we have SOAP connection we should end it |
|
140 if( $soapConnection ) { |
|
141 my $sessionInfo = EndSoapConnection( ); |
|
142 print "\n\n".$sessionInfo->{'Info'}."\n\n" if( $sessionInfo->{'Info'} ); |
|
143 } |
|
144 |
|
145 exit 0; |
|
146 |
|
147 |
|
148 sub ValidateInputs { |
|
149 print_help( ) if ( $param_help ); |
|
150 |
|
151 # try to get version info from s60builds SOAP server |
|
152 my $versionInfoFromServer = GetSoapVersion( ) if( !$param_no_soap ); |
|
153 if( $versionInfoFromServer ) { |
|
154 # we have access to SOAP server |
|
155 printLog( "SOAP: access OK" ); |
|
156 $soapConnection = 1; |
|
157 |
|
158 # lets not start soap if prompt only is defined |
|
159 $soapConnection = 0 if $param_print_only; |
|
160 |
|
161 printLog( "SOAP: latest OK version: ".$versionInfoFromServer->{'LatestOK'}->{'Version'} ); |
|
162 printLog( "SOAP: latest OK date: ".$versionInfoFromServer->{'LatestOK'}->{'Date'} ); |
|
163 printLog( "SOAP: latest version: ".$versionInfoFromServer->{'Latest'}->{'Version'} ); |
|
164 printLog( "SOAP: latest date: ".$versionInfoFromServer->{'Latest'}->{'Date'} ); |
|
165 |
|
166 # compare version nmbrs and prompt user if outdated getenv |
|
167 if( $getEnvVersion < $versionInfoFromServer->{'LatestOK'}->{'Version'} ) { |
|
168 HandleError( "Your getenv is outdated and can not be usedanymore\nPlease get newer from the server.", $cannotContinue ); |
|
169 } |
|
170 } |
|
171 else { |
|
172 printLog( "SOAP: we dont have SOAP access" ); |
|
173 $soapConnection = 0; |
|
174 } |
|
175 |
|
176 if( @param_exclude and @param_include ) { |
|
177 HandleError( "you cant specify include and exclude lists at the same time!", $cannotContinue ); |
|
178 } |
|
179 |
|
180 # checking wheter we are in root of the substituted drive (if -start param is not specified) |
|
181 if( ! $param_start_directly and |
|
182 ! getcwd =~ /[a-zA-Z]:\// and |
|
183 $param_keepgoing ) { |
|
184 HandleError( "You should run getenv only in root of the substituted drive\nYou can use -k as keep going parameter if you think it is ok to proceed", $cannotContinue ); |
|
185 } |
|
186 |
|
187 # ok we are in root. Is the drive empty? |
|
188 my $xmlFile = 0; |
|
189 my $driveEmpty = 1; |
|
190 |
|
191 opendir( ROOT, "/" ) or HandleError( "cant read root dir: $!", $warning ); |
|
192 my @filesFound = readdir( ROOT ); |
|
193 closedir( ROOT ); |
|
194 foreach my $file( @filesFound ) { |
|
195 next if $file =~ /^\.[\.]?$/; |
|
196 next if $file =~ /getenv/; |
|
197 $xmlFile = 1 if $file =~ /.*metadata.*\.xml/; |
|
198 $xmlFile = 1 if $file =~ /currentRelease\.xml/; |
|
199 $driveEmpty = 0; |
|
200 } |
|
201 |
|
202 printLog( "xml files: $xmlFile" ); |
|
203 printLog( "drive empty: $driveEmpty" ); |
|
204 |
|
205 # if drive is not empty and no xmls found ==> print warning (if -start param not specified) |
|
206 if( ! $param_start_directly and ! $xmlFile and ! $driveEmpty ) { |
|
207 HandleError( "The drive you are about to extract environment is not empty!\nHit CTRL-C to break now or <enter> to continue", $promptUser ); |
|
208 } |
|
209 |
|
210 # if there is valid metadata.xml in root, params like path or latest doesn't make any sense |
|
211 if( $xmlFile ) { |
|
212 foreach my $file( @filesFound ) { |
|
213 if( $file =~ /.*metadata(_(\d*))?.xml$/i ) { |
|
214 print "metadata file found!\n"; |
|
215 if( ValidateXmlFile( getcwd.$file ) ) { |
|
216 $metaDataXml = getcwd.$file; |
|
217 last; |
|
218 } |
|
219 } |
|
220 } |
|
221 } |
|
222 |
|
223 if( $metaDataXml ) { |
|
224 if( $param_latest or $param_release_path ) { |
|
225 print "It doesnt make sense to use 'path' or 'latest' parameter while having metadata.xml in root!\n\n"; |
|
226 print_help( ); |
|
227 exit 0; |
|
228 } |
|
229 |
|
230 # we should ask correct grace share if xmlfile !server !start |
|
231 if( !$param_server and ! $param_start_directly ) { |
|
232 print "For your convenience it is recommended to use GRACE samba share close to you.\n"; |
|
233 # prompt user wheter he wants to use GRACE |
|
234 my $networkAccessVerified = 0; |
|
235 while( $networkAccessVerified eq 0 ) { |
|
236 my $wantedServer = FixPaths( $graceList[ ReturnMenuIndex( "Please select share closest to you", @graceNameList ) ] ); |
|
237 |
|
238 if( $wantedServer eq FixPaths( $graceList[0] ) ) { |
|
239 HandleError( "Please notice that access to $graceList[0] will be removed from wk50 onwards. Now would be perfect time to get yourself a GRACE access.", $promptUser ); |
|
240 } |
|
241 |
|
242 printLog( "selected: $wantedServer - accessing.." ); |
|
243 if( opendir( GRACETEST, $wantedServer ) ) { |
|
244 printLog( "connection tested OK" ); |
|
245 $networkAccessVerified = 1; |
|
246 $pathToReleaseFolder = $wantedServer; |
|
247 } |
|
248 else { |
|
249 print "Unable to access $wantedServer\nPlease select another network share.\n"; |
|
250 } |
|
251 } |
|
252 } |
|
253 |
|
254 # in case we have metadata in \ and -start defined, look grace automatically |
|
255 elsif( !$param_server and $param_start_directly ) { |
|
256 $pathToReleaseFolder = FindGraceServer( ); |
|
257 } |
|
258 } |
|
259 |
|
260 # ToDo: if there is not metadata.xml in root check if we have already env. Possibly update? |
|
261 |
|
262 # is 'path' parameter is used, find out (wheter there exists) valid metadata.xml |
|
263 if( $param_release_path ) { |
|
264 if( $param_latest or $param_product ) { |
|
265 print "It doesnt make sense to use 'path' or 'latest' parameter while having metadata.xml in root!\n\n"; |
|
266 print_help( ); |
|
267 exit 0; |
|
268 } |
|
269 $metaDataXml = FixPaths( $param_release_path ); |
|
270 $metaDataXml .= SearchValidXml( $metaDataXml ); |
|
271 printLog( "setting metadata: $metaDataXml" ); |
|
272 } |
|
273 |
|
274 # handle server parameter |
|
275 # simply just verify accessablility and fix path |
|
276 if( $param_server ) { |
|
277 $pathToReleaseFolder = FixPaths( $param_server ); |
|
278 opendir( OPENTEST, $pathToReleaseFolder ) or HandleError( "Unable to access given server path: $pathToReleaseFolder\n$!", $cannotContinue ); |
|
279 closedir( OPENTEST ); |
|
280 } |
|
281 |
|
282 # param_latest is used to just get latest release - requires product |
|
283 if( $param_latest ) { |
|
284 if( $param_product ) { |
|
285 $param_product = FixPaths( $param_product ); |
|
286 |
|
287 # once the network share is unavailable then tries to find grace share |
|
288 $pathToReleaseFolder = FindGraceServer( ); |
|
289 |
|
290 opendir( RELDIR, $pathToReleaseFolder.$defaultServiceName.$param_product ) or die "unable to open $pathToReleaseFolder$defaultServiceName$param_product\n$!"; |
|
291 # scan all xml files to @files_found |
|
292 # salmarko starts |
|
293 my @files_found = grep { /^pf_|^S60_|^dfs_/i } readdir RELDIR; |
|
294 # salmarko ends |
|
295 close RELDIR; |
|
296 |
|
297 if( @files_found ) { |
|
298 foreach( reverse sort ( @files_found ) ) { |
|
299 # we only want to get the last dir name.. |
|
300 s/.*\///i; |
|
301 my $productToDl = $pathToReleaseFolder.$defaultServiceName.$param_product; |
|
302 $productToDl .= FixPaths( $_ ); |
|
303 print "Searching metadata.xml files from $productToDl\n" if $param_debug; |
|
304 |
|
305 $metaDataXml = SearchValidXml( $productToDl ) ; |
|
306 if( $metaDataXml ) { |
|
307 $metaDataXml = $productToDl.$metaDataXml; |
|
308 printLog( "selected xml: $metaDataXml" ); |
|
309 last; |
|
310 } |
|
311 } |
|
312 } |
|
313 else { |
|
314 HandleError( "cannot find releases from $pathToReleaseFolder$defaultServiceName$param_product", $cannotContinue ); |
|
315 } |
|
316 } |
|
317 else { |
|
318 die "If you specify -latest parameter you have to define -product also!\n"; |
|
319 } |
|
320 } |
|
321 |
|
322 # use wizard to find out what to DL |
|
323 if( ! $metaDataXml ) { |
|
324 printLog( "Not enought valid inputs provided - running wizard..." ); |
|
325 RunWizard( ); |
|
326 } |
|
327 |
|
328 # check wheter metadata and currentRelease adds up |
|
329 if( -e FixPaths( getcwd )."currentRelease.xml") { |
|
330 printLog( "CurrenRelease.xml exists. Checking wheter update is possible" ); |
|
331 |
|
332 # compare service, product and release with xml files |
|
333 my $CurrentRelXmlParser = new XML::Simple( ); |
|
334 my $currentReleaseData = $CurrentRelXmlParser->XMLin( FixPaths( getcwd )."currentRelease.xml" ); |
|
335 |
|
336 my $xmlParser = new XML::Simple( ); |
|
337 my $xmlData = $xmlParser->XMLin( $metaDataXml ); |
|
338 |
|
339 # salmarko starts |
|
340 my $currentRelease = ''; |
|
341 my $newRelease = ''; |
|
342 |
|
343 if ( !defined $xmlData->{releaseDetails}->{dependsOf}->{service}->{name} ) { # no dependencies, lets compare current to new |
|
344 # compare services |
|
345 if( $currentReleaseData->{releaseDetails}->{releaseID}->{service}->{name} ne |
|
346 $xmlData->{releaseDetails}->{releaseID}->{service}->{name} ) { |
|
347 HandleError( "Can not extract ".$xmlData->{releaseDetails}->{releaseID}->{service}->{name} . |
|
348 " release on top of ".$currentReleaseData->{releaseDetails}->{releaseID}->{service}->{name}, $cannotContinue ); |
|
349 } |
|
350 # compare products |
|
351 if( $currentReleaseData->{releaseDetails}->{releaseID}->{product}->{name} ne |
|
352 $xmlData->{releaseDetails}->{releaseID}->{product}->{name} ) { |
|
353 HandleError( "Can not extract ".$xmlData->{releaseDetails}->{releaseID}->{product}->{name} . |
|
354 " release on top of ".$currentReleaseData->{releaseDetails}->{releaseID}->{product}->{name}, $cannotContinue ); |
|
355 } |
|
356 printLog( "service and product matches.. checking release" ); |
|
357 |
|
358 $currentRelease = $currentReleaseData->{releaseDetails}->{releaseID}->{release}->{name}; |
|
359 $newRelease = $xmlData->{releaseDetails}->{releaseID}->{release}->{name}; |
|
360 } |
|
361 else{ |
|
362 # compare services |
|
363 if( $currentReleaseData->{releaseDetails}->{releaseID}->{service}->{name} ne |
|
364 $xmlData->{releaseDetails}->{dependsOf}->{service}->{name} ) { |
|
365 HandleError( "Can not extract ".$xmlData->{releaseDetails}->{dependsOf}->{service}->{name} . |
|
366 " release on top of ".$currentReleaseData->{releaseDetails}->{releaseID}->{service}->{name}, $cannotContinue ); |
|
367 } |
|
368 # compare products |
|
369 if( $currentReleaseData->{releaseDetails}->{releaseID}->{product}->{name} ne |
|
370 $xmlData->{releaseDetails}->{dependsOf}->{product}->{name} ) { |
|
371 HandleError( "Can not extract ".$xmlData->{releaseDetails}->{dependsOf}->{product}->{name} . |
|
372 " release on top of ".$currentReleaseData->{releaseDetails}->{releaseID}->{product}->{name}, $cannotContinue ); |
|
373 } |
|
374 printLog( "service and product matches.. checking release" ); |
|
375 |
|
376 # compare releases |
|
377 $currentRelease = $currentReleaseData->{releaseDetails}->{releaseID}->{release}->{name}; |
|
378 $newRelease = $xmlData->{releaseDetails}->{dependsOf}->{release}->{name}; |
|
379 |
|
380 if ( $currentRelease =~ m/^(S60_\d_\d+_\d{6})/i or $currentRelease =~ m/^(pf_\d{4}_\d{6})/ ) { |
|
381 $currentRelease = $1; |
|
382 } |
|
383 else { |
|
384 HandleError( "Current release info unknown or missing: $currentRelease", $cannotContinue ); |
|
385 } |
|
386 |
|
387 if ( $newRelease =~ m/^(S60_\d_\d+_\d{6})/i or $newRelease =~ m/^(pf_\d{4}_\d{6})/ ) { |
|
388 $newRelease = $1; |
|
389 } |
|
390 else { |
|
391 HandleError( "New release info unknown or missing: $newRelease", $cannotContinue ); |
|
392 } |
|
393 } |
|
394 |
|
395 printLog( "current release: $currentRelease" ); |
|
396 printLog( "release to extract: $newRelease" ); |
|
397 # salmarko ends |
|
398 |
|
399 if( $currentRelease ne $newRelease ) { |
|
400 HandleError( "Can not extract $newRelease release on top of $currentRelease", $cannotContinue ); |
|
401 } |
|
402 printLog( "release matches - update possible" ); |
|
403 |
|
404 $currentRelease = FixPaths( getcwd )."currentRelease.xml"; |
|
405 } |
|
406 } |
|
407 |
|
408 |
|
409 # Make sure paths are as perl likes 'em |
|
410 # change '\' ==> '/' and make sure last char is / |
|
411 sub FixPaths { |
|
412 my $tmpParam = shift; |
|
413 $tmpParam =~ s/\\/\//g; |
|
414 |
|
415 if( substr( $tmpParam, -1 ) eq "/" ) { |
|
416 return $tmpParam; |
|
417 } |
|
418 else { |
|
419 return $tmpParam."/"; |
|
420 } |
|
421 } |
|
422 |
|
423 # Make sure paths are as windows likes 'em |
|
424 # change '/' ==> '\\' and make sure last char is \\ |
|
425 sub UnFixPaths { |
|
426 my $tmpParam = shift; |
|
427 $tmpParam =~ s/\//\\/g; |
|
428 |
|
429 if( substr( $tmpParam, -1 ) eq "\\" ) { |
|
430 return $tmpParam; |
|
431 } |
|
432 else { |
|
433 return $tmpParam."\\"; |
|
434 } |
|
435 } |
|
436 |
|
437 # smarter handling of logging |
|
438 sub printLog { |
|
439 foreach my $trace ( @_ ) { |
|
440 if( $param_debug ) { |
|
441 # we should print traces for STDOUT as well |
|
442 my ($sec,$min,$hr) = localtime(); |
|
443 printf( "%02d:%02d:%02d: ", $hr, $min, $sec ); |
|
444 print $trace."\n"; |
|
445 } |
|
446 |
|
447 # we should print traces for log file |
|
448 my ($sec,$min,$hr) = localtime(); |
|
449 printf LOGFILE ( "%02d:%02d:%02d: ", $hr, $min, $sec ); |
|
450 print LOGFILE $trace."\n"; |
|
451 } |
|
452 } |
|
453 |
|
454 sub HandleError { |
|
455 my( $errorString, $errorType ) = @_; |
|
456 printLog( "HandleError: $errorString, type: $errorType" ); |
|
457 |
|
458 if( $errorType eq $warning ) { |
|
459 print "\nWARNING: $errorString\n"; |
|
460 } |
|
461 if( $errorType eq $promptUser ) { |
|
462 print "\nWARNING: $errorString\n\n"; |
|
463 print "Press <enter> to continue..\n" if( ! $param_start_directly ); |
|
464 my $selection = <STDIN> if( ! $param_start_directly ); |
|
465 } |
|
466 elsif( $errorType eq $dependencyMissing ) { |
|
467 if( $param_keepgoing ) { |
|
468 print "\nERROR: Required dependency missing: $errorString\n\n"; |
|
469 } |
|
470 else { |
|
471 die "ERROR: all the needed dependencies doesn't exist!\n$errorString\nIf you think it is ok to ignore this error you can use -k as keep-going parameter\nYou should report this to administrator of the server\n\ngetenv will now exit\n\n"; |
|
472 } |
|
473 } |
|
474 elsif( $errorType eq $cannotContinue ) { |
|
475 if( $param_keepgoing ) { |
|
476 print "\nWARNING: $errorString\n\n"; |
|
477 } |
|
478 else { |
|
479 die "\nERROR:\n============\n$errorString\ngetenv will now exit\nIf you think it is ok to ignore this error you can use -k as keep going parameter\n\n"; |
|
480 } |
|
481 } |
|
482 } |
|
483 |
|
484 # checks wheter the xml file seems sane (has service, product and name set) |
|
485 sub ValidateXmlFile { |
|
486 my $xmlFile = shift( @_ ); |
|
487 printLog( "Validating $xmlFile" ); |
|
488 |
|
489 # open the xml file and check wheter it is something we want |
|
490 my $dependencyXmlParser = new XML::Simple( ); |
|
491 my $dependencyData = $dependencyXmlParser->XMLin( $xmlFile ); |
|
492 |
|
493 # if releaseDetails->releaseID->service&product&release are found consider this as valid file |
|
494 if( $dependencyData->{releaseDetails}->{releaseID}->{service}->{name} and |
|
495 $dependencyData->{releaseDetails}->{releaseID}->{product}->{name} and |
|
496 $dependencyData->{releaseDetails}->{releaseID}->{release}->{name} ) { |
|
497 # return xml file with path |
|
498 printLog( "xml file OK" ); |
|
499 return 1; |
|
500 } |
|
501 else { |
|
502 printLog( "xml file doesn't seem to be sane!" ); |
|
503 return 0; |
|
504 } |
|
505 } |
|
506 |
|
507 sub print_help { |
|
508 print " |
|
509 usage |
|
510 ===== |
|
511 getenv.pl [params] |
|
512 getenv.pl use no parameters to run small wizard |
|
513 getenv.pl -h(elp) print help |
|
514 getenv.pl -k keep going even when errors occurs |
|
515 getenv.pl -p do nothing, but print system calls |
|
516 getenv.pl -emu DEPRECATED - prefer filtering: get only emulator environment |
|
517 getenv.pl -start starts extracting without user confirmation (nice for scripts) |
|
518 getenv.pl -nodeps do not download dependencies for the release |
|
519 getenv.pl -nosoap dont try to use SOAP connection for s60builds server |
|
520 getenv.pl -skipitd DEPRECATED - prefer filtering: skips useless doc, internal, tsrc zips |
|
521 getenv.pl -verbose print debug traces |
|
522 getenv.pl -Include include only some types of packages (emu, src, tsrc) |
|
523 getenv.pl -eXclude exclude some types of packages (emu, src, tsrc) |
|
524 |
|
525 examples |
|
526 ======== |
|
527 get latest PRODUCT release: |
|
528 getenv.pl -latest -product PRODUCT |
|
529 get s60 release from server \\\\SERVER\\LOCATION: |
|
530 getenv.pl -server \\\\SERVER\\LOCATION |
|
531 get s60 release located in \\\\SERVER\\LOCATION\\BUILDS\\PRODUCT\\RELEASE: |
|
532 getenv.pl -path \\\\SERVER\\LOCATION\\BUILDS\\PRODUCT\\RELEASE |
|
533 get s60 release pointed with -path and print verbose messages: |
|
534 getenv.pl -path \\\\SERVER\\LOCATION\\BUILDS\\PRODUCT\\RELEASE -verbose |
|
535 |
|
536 Filtering |
|
537 ========= |
|
538 You can include or exclude certain types of packages to unzip. |
|
539 For example you can unzip only emulator binaries with -include emu (or -i emu) |
|
540 Or if you don't want test sources and documents use -exclude tsrc (or -x tsrc) |
|
541 Possible filters are emu, src, tsrc and we can put plenty more into metadata.xml if needed |
|
542 To get latest PRODUCT emulator environment use |
|
543 getenv.pl -latest -product PRODUCT -i emu |
|
544 To get only custom build without winscw binaries use |
|
545 getenv.pl -path \\\\SERVER\\LOCATION\\BUILDS\\PRODUCT\\RELEASE -x emu |
|
546 "; |
|
547 exit 0; |
|
548 } |
|
549 |
|
550 |
|
551 |
|
552 |
|
553 |
|
554 # returns file name of correct xml file in given directory |
|
555 sub SearchValidXml { |
|
556 my $searchDir = shift @_; |
|
557 printLog( "finding valid xml files from: $searchDir" ); |
|
558 |
|
559 # validate xml files from selected directory |
|
560 opendir( XMLDIR, $searchDir ) or die "can't open $searchDir: $!"; |
|
561 # scan all xml files to @xmlFiles |
|
562 my @xmlFiles = grep /\.xml$/, readdir XMLDIR; |
|
563 close XMLDIR; |
|
564 # print Dumper( @xmlFiles ); |
|
565 |
|
566 # sort files in ascenting order (so latest comes first: _001 |
|
567 @xmlFiles = sort {$b cmp $a} (@xmlFiles); |
|
568 |
|
569 foreach my $xmlCandidate ( @xmlFiles ) { |
|
570 printLog( "xmlfile: $xmlCandidate" ); |
|
571 # open the xml file and check wheter it is something we want |
|
572 my $xmlParser = new XML::Simple( ); |
|
573 my $releaseData = $xmlParser->XMLin( $searchDir."/".$xmlCandidate ); |
|
574 |
|
575 # if releaseDetails->releaseID->service&product&release are found consider this as valid file |
|
576 if( $releaseData->{releaseDetails}->{releaseID}->{service}->{name} and |
|
577 $releaseData->{releaseDetails}->{releaseID}->{product}->{name} and |
|
578 $releaseData->{releaseDetails}->{releaseID}->{release}->{name} ) { |
|
579 # return xml file with path |
|
580 return $xmlCandidate; |
|
581 } |
|
582 } |
|
583 |
|
584 # in case we came until here the xml file is not found |
|
585 HandleError( "Valid release_metadata.xml file was not found from $searchDir", $cannotContinue ); |
|
586 } |
|
587 |
|
588 sub RunWizard { |
|
589 print "Server is heavily loaded and therefore also download times might be drawn out.\nFor your convenience it is recommended to use samba share close to you.\n"; |
|
590 # salmarko starts |
|
591 if( !$param_server ) { |
|
592 # salmarko ends |
|
593 # prompt user wheter he wants to use GRACE |
|
594 my $wantedServer; |
|
595 my $networkAccessVerified = 0; |
|
596 while( $networkAccessVerified eq 0 ) { |
|
597 $wantedServer = FixPaths( $graceList[ ReturnMenuIndex( "Please select share closest to you", @graceNameList ) ] ); |
|
598 |
|
599 if( $wantedServer eq FixPaths( $graceList[0] ) ) { |
|
600 HandleError( "Please notice that access to $graceList[0] will be removed from wk50 onwards. Now would be perfect time to get yourself GRACE access.", $promptUser ); |
|
601 } |
|
602 |
|
603 printLog( "selected: $wantedServer - accessing.." ); |
|
604 if( opendir( GRACETEST, $wantedServer ) ) { |
|
605 printLog( "connection tested OK" ); |
|
606 $networkAccessVerified = 1; |
|
607 $pathToReleaseFolder = $wantedServer; |
|
608 } |
|
609 else { |
|
610 print "Unable to access $wantedServer\nPlease select another network share.\n"; |
|
611 } |
|
612 } |
|
613 my $wantedService = $serviceList[ ReturnMenuIndex( "Please select GRACE Service.", @serviceNameList)]; |
|
614 printLog( "selected: $wantedServer.$wantedService - accessing.." ); |
|
615 local *GRACETEST2; |
|
616 if( opendir( GRACETEST2, $wantedServer.$wantedService ) ) { |
|
617 printLog( "serviceconnection tested OK" ); |
|
618 $defaultServiceName = $wantedService |
|
619 } |
|
620 else { |
|
621 print "Unable to access $wantedServer.$wantedService\nPlease select another network share or service.\n"; |
|
622 } |
|
623 } |
|
624 |
|
625 # find & select correct product from the server |
|
626 my @productFiles = FindAvailableProducts( ); |
|
627 if( ! @productFiles ) { |
|
628 HandleError( "Server seem to be empty!\nPlease check the server path: $pathToReleaseFolder$defaultServiceName\n$!", $cannotContinue ); |
|
629 } |
|
630 my $product = PrintSelectMenu( "Products found from server", @productFiles ); |
|
631 $product = FixPaths( $product ); |
|
632 printLog( "selected product: $product" ); |
|
633 |
|
634 # find & select correct release from above selected path |
|
635 my @releaseFiles = FindAvailableReleases( $product ); |
|
636 if( ! @releaseFiles ) { |
|
637 HandleError( "Cant find any releases from: $pathToReleaseFolder$defaultServiceName.$product\n$!", $cannotContinue ); |
|
638 } |
|
639 my $release = PrintSelectMenu( "Releases found from server", @releaseFiles ); |
|
640 $release = FixPaths( $release ); |
|
641 printLog( "selected release: $release" ); |
|
642 |
|
643 # select correct xml file from selected release |
|
644 $metaDataXml = SearchValidXml( $pathToReleaseFolder.$defaultServiceName.$product.$release ); |
|
645 $metaDataXml = $pathToReleaseFolder.$defaultServiceName.$product.$release.$metaDataXml; |
|
646 printLog( "selected metadata: $metaDataXml" ); |
|
647 } |
|
648 |
|
649 # check what products is there under servers release path |
|
650 sub FindAvailableProducts { |
|
651 opendir( DIR, $pathToReleaseFolder.$defaultServiceName ) |
|
652 or HandleError( "Can't open directory: $pathToReleaseFolder$defaultServiceName\n$!", $cannotContinue ); |
|
653 #change to match only for directories |
|
654 # my @productFiles = grep { /s(eries_)?60_\d_\d/i } readdir (DIR); |
|
655 # salmarko starts |
|
656 my @productFiles = grep /^pf_|^S60_|^DFS/i, readdir (DIR); |
|
657 # salmarko ends |
|
658 printLog( @productFiles ); |
|
659 closedir( DIR ); |
|
660 |
|
661 # return found releases sorted |
|
662 return sort( @productFiles ); |
|
663 } |
|
664 |
|
665 # print selection menus |
|
666 sub PrintSelectMenu { |
|
667 my( $topic, @inputArray ) = @_; |
|
668 |
|
669 # print topic line |
|
670 print "\n\n$topic:\n"; |
|
671 for( my $i = length( $topic ); $i>=0; $i-- ) { |
|
672 print "="; |
|
673 } |
|
674 print "\n"; |
|
675 |
|
676 # print actual selections |
|
677 my $counter = 0; |
|
678 foreach my $line( @inputArray ) { |
|
679 $counter ++; |
|
680 print "$counter:\t$line\n"; |
|
681 } |
|
682 |
|
683 print "\n\nx:\texit\n"; |
|
684 print "\nselection: "; |
|
685 my $selection = <STDIN>; |
|
686 chop( $selection ); |
|
687 |
|
688 exit 1 if( $selection eq 'x' ); |
|
689 |
|
690 # check user input |
|
691 while( ! $selection =~ /\d*/ and |
|
692 $selection > $counter ) |
|
693 { |
|
694 if( $selection =~ /\d*/ ) { |
|
695 print "Invalid selection. Please check value from the list above\n"; |
|
696 } |
|
697 else { |
|
698 print "Please insert numerical value from the list\n"; |
|
699 } |
|
700 print "\nselection: "; |
|
701 $selection = <STDIN>; |
|
702 chop( $selection ); |
|
703 |
|
704 exit 1 if( $selection eq 'x' ); |
|
705 } |
|
706 |
|
707 # return array index |
|
708 $selection--; |
|
709 return( $inputArray[$selection] ); |
|
710 } |
|
711 |
|
712 # print selection menus |
|
713 sub ReturnMenuIndex { |
|
714 my( $topic, @inputArray ) = @_; |
|
715 |
|
716 # print topic line |
|
717 print "\n\n$topic:\n"; |
|
718 for( my $i = length( $topic ); $i>=0; $i-- ) { |
|
719 print "="; |
|
720 } |
|
721 print "\n"; |
|
722 |
|
723 # print actual selections |
|
724 my $counter = 0; |
|
725 foreach my $line( @inputArray ) { |
|
726 $counter ++; |
|
727 print "$counter:\t$line\n"; |
|
728 } |
|
729 |
|
730 print "\n\nx:\texit\n"; |
|
731 print "\nselection: "; |
|
732 my $selection = <STDIN>; |
|
733 chop( $selection ); |
|
734 |
|
735 exit 1 if( $selection eq 'x' ); |
|
736 |
|
737 # check user input |
|
738 while( ! $selection =~ /\d*/ and |
|
739 $selection > $counter ) |
|
740 { |
|
741 if( $selection =~ /\d*/ ) { |
|
742 print "Invalid selection. Please check value from the list above\n"; |
|
743 } |
|
744 else { |
|
745 print "Please insert numerical value from the list\n"; |
|
746 } |
|
747 print "\nselection: "; |
|
748 $selection = <STDIN>; |
|
749 chop( $selection ); |
|
750 |
|
751 exit 1 if( $selection eq 'x' ); |
|
752 } |
|
753 |
|
754 # return array index |
|
755 $selection--; |
|
756 return $selection; |
|
757 } |
|
758 |
|
759 # check what releases are there under selected product |
|
760 sub FindAvailableReleases { |
|
761 my $selectedProduct = shift( @_ ); |
|
762 printLog( "searching available releases from $selectedProduct" ); |
|
763 # print $serverPath.$selectedProduct."\n"; |
|
764 opendir( DIR, $pathToReleaseFolder.$defaultServiceName .$selectedProduct ) or die "Can't open dir: $!\n"; |
|
765 # my @releaseFiles = grep { /S60_\d_\d.*/ } readdir (DIR); |
|
766 # salmarko starts |
|
767 my @releaseFiles = grep /^pf_|^S60/i, readdir (DIR); |
|
768 # salmarko ends |
|
769 # print Dumper( @releaseFiles ); |
|
770 closedir (DIR); |
|
771 #TODO: maybe we should also check wheter xml files exists in release |
|
772 return sort {$b cmp $a} ( @releaseFiles ); |
|
773 } |
|
774 |
|
775 # maybe we should print warning only |
|
776 sub PrintFinalWarning { |
|
777 if( ! $param_start_directly ) { |
|
778 # we'll print warnings only if extracting on top of something else (aka not empty dir) |
|
779 # print "About to start extracting\n$metaDataXml"; |
|
780 # print "\nHit ctrl-C now to abort, otherwise press enter to continue\n\n"; |
|
781 # my $selection = <STDIN>; |
|
782 print scalar(localtime). ": start fetching environment\n"; |
|
783 } |
|
784 } |
|
785 |
|
786 # handles controlled downloading of the environment pointed by $metaDataXml |
|
787 sub DownloadRelease { |
|
788 # open wanted metadata.xml file |
|
789 my $xmlParser = new XML::Simple( ); |
|
790 my $data = $xmlParser->XMLin( $metaDataXml ); |
|
791 |
|
792 # parse download directory based on given arguments and xml file to $releaseLocationInServer |
|
793 my $releaseLocationInServer; |
|
794 if( ! $param_release_path ) { |
|
795 $releaseLocationInServer = ParseDownloadDir( $data ); |
|
796 } |
|
797 else { |
|
798 $releaseLocationInServer = $param_release_path; |
|
799 } |
|
800 |
|
801 # read files from the xml to %packageHash |
|
802 GeneratePackageHash( $data, $releaseLocationInServer ); |
|
803 printLog( "package hash generated" ); |
|
804 |
|
805 # insert needed files to @finalZipList |
|
806 SortFilesToFinalLists( ); |
|
807 printLog( "files sorted to final zip list" ); |
|
808 |
|
809 # check if there is dependencies we need to extract as well |
|
810 if( ! $param_skip_deps and |
|
811 $data->{releaseDetails}->{dependsOf}->{service} ) { |
|
812 # read from xml where can we get dependeny |
|
813 my $dependsOfService = $data->{releaseDetails}->{dependsOf}->{service}->{name}; |
|
814 my $dependsOfProduct = $data->{releaseDetails}->{dependsOf}->{product}->{name}; |
|
815 my $dependsOfRelease = $data->{releaseDetails}->{dependsOf}->{release}->{name}; |
|
816 |
|
817 printLog( "First dl: $dependsOfService $dependsOfProduct $dependsOfRelease" ); |
|
818 |
|
819 # add dependency files to finalLists |
|
820 AddDependencies( $dependsOfService, $dependsOfProduct, $dependsOfRelease ); |
|
821 } |
|
822 |
|
823 # we should check wheter there already exists old build (currentRelease.xml) and reduct the files |
|
824 if( -e FixPaths( getcwd )."currentRelease.xml" ) { |
|
825 # reduct old DL'd files (currentrelease.xml and it's dependencies) |
|
826 # passing param '1' as for printing |
|
827 RemoveThisXmlFromFinalList( FixPaths( getcwd )."currentRelease.xml", 1 ); |
|
828 } |
|
829 if( VerifyFinalZipList( ) or $param_keepgoing ) { |
|
830 # start SOAP session |
|
831 if( $soapConnection ) { |
|
832 my $soapSessionInfo = StartSoapSession( ); |
|
833 printLog( "SOAP: note ".$soapSessionInfo->{'HelloNote'} ); |
|
834 printLog( "SOAP: sessionid ".$soapSessionInfo->{'SessionID'} ); |
|
835 |
|
836 print "\n".$soapSessionInfo->{'HelloNote'}."\n\n" if( $soapSessionInfo->{'HelloNote'} ); |
|
837 $soapSessionID = $soapSessionInfo->{'SessionID'}; |
|
838 printLog( "SOAP: soapSessionID set: $soapSessionID" ); |
|
839 } |
|
840 |
|
841 # extract the environment |
|
842 GetEnv( ); |
|
843 } |
|
844 } |
|
845 |
|
846 # return download directory from the metadata.xml |
|
847 sub ParseDownloadDir { |
|
848 my $data = shift( @_ ); |
|
849 my $releaseLocationInServer; |
|
850 |
|
851 # parse dl directory into $releaseDirectory |
|
852 $releaseLocationInServer = $data->{releaseDetails}->{releaseID}->{service}->{name} . "/"; |
|
853 $releaseLocationInServer .= $data->{releaseDetails}->{releaseID}->{product}->{name} ."/"; |
|
854 $releaseLocationInServer .= $data->{releaseDetails}->{releaseID}->{release}->{name} ."/"; |
|
855 local *DEPTEST; |
|
856 |
|
857 # check if we can find this release from GRACE |
|
858 if( $graceServer ) { |
|
859 if( -e $graceServer.$releaseLocationInServer."grace.txt" ) { |
|
860 printLog( "dl dir: $graceServer$releaseLocationInServer" ); |
|
861 return $graceServer.$releaseLocationInServer; |
|
862 } |
|
863 else { |
|
864 printLog( "dl dir: $pathToReleaseFolder$releaseLocationInServer" ); |
|
865 return $pathToReleaseFolder.$releaseLocationInServer; |
|
866 } |
|
867 } |
|
868 else { |
|
869 # while call to remove dependency xmls is recursive, we dont know actual DL path |
|
870 |
|
871 if( opendir( DEPTEST, $pathToReleaseFolder.$releaseLocationInServer ) ) { |
|
872 return $pathToReleaseFolder.$releaseLocationInServer; |
|
873 } |
|
874 else { |
|
875 return $defaultPathToServer.$releaseLocationInServer; |
|
876 } |
|
877 } |
|
878 } |
|
879 |
|
880 # generates %packageHash that contains data about needed files |
|
881 # param: xml data handle |
|
882 sub GeneratePackageHash { |
|
883 my( $xmlDataHandle, $releaseInServer ) = @_; |
|
884 my $finalState = 0; |
|
885 printLog( "parse filenames to extract to packageHah" ); |
|
886 |
|
887 # generate new hash of zips to DL for %packageHash |
|
888 # foreach my $key( sort { $xmlDataHandle{a}->{'state'} <=> $xmlDataHandle{b}->{'state'} } %{$xmlDataHandle->{releaseFiles}->{'package'} } ){ |
|
889 foreach my $key( keys(%{$xmlDataHandle->{releaseFiles}->{package} } ) ) { |
|
890 printLog( "adding $key to packageHash" ); |
|
891 ${packageHash}{$key}{path} = FixPaths( $releaseInServer ); |
|
892 ${packageHash}{$key}{type} = $xmlDataHandle->{releaseFiles}->{package}->{$key}->{'type'}; |
|
893 ${packageHash}{$key}{state} = $xmlDataHandle->{releaseFiles}->{package}->{$key}->{'state'}; |
|
894 ${packageHash}{$key}{extract} = $xmlDataHandle->{releaseFiles}->{package}->{$key}->{'extract'}; |
|
895 ${packageHash}{$key}{default} = $xmlDataHandle->{releaseFiles}->{package}->{$key}->{'default'}; |
|
896 |
|
897 # added 31.7.2007 : check filters -attribute |
|
898 if ($xmlDataHandle->{releaseFiles}->{package}->{$key}->{'filters'}){ |
|
899 ${packageHash}{$key}{s60filter} = $xmlDataHandle->{releaseFiles}->{package}->{$key}->{'filters'}; |
|
900 } |
|
901 elsif ($xmlDataHandle->{releaseFiles}->{package}->{$key}->{'s60filter'}) {; |
|
902 ${packageHash}{$key}{s60filter} = $xmlDataHandle->{releaseFiles}->{package}->{$key}->{'s60filter'}; |
|
903 } |
|
904 |
|
905 # find out what is the latest state |
|
906 if( $finalState < $xmlDataHandle->{releaseFiles}->{package}->{$key}->{'state'} ) { |
|
907 $finalState = $xmlDataHandle->{releaseFiles}->{package}->{$key}->{'state'}; |
|
908 } |
|
909 } |
|
910 |
|
911 # we should check wheter this xml has servicepacks |
|
912 my $spName = $xmlDataHandle->{servicePacks}->{servicePack}->{name}; |
|
913 # always increase final state |
|
914 $finalState ++; |
|
915 if( $spName ) { |
|
916 printLog( "spname: $spName" ); |
|
917 $finalState ++; |
|
918 my $spFileName = $xmlDataHandle->{servicePacks}->{servicePack}->{file}->{name}; |
|
919 # if we get spFileName we should extract SP zip |
|
920 if( $spFileName ) { |
|
921 printLog( "spFileName: $spFileName" ); |
|
922 ${packageHash}{$spFileName}{path} = FixPaths( $releaseInServer ); |
|
923 ${packageHash}{$spFileName}{type} = "zip"; |
|
924 ${packageHash}{$spFileName}{state} = $finalState; |
|
925 ${packageHash}{$spFileName}{extract} = "single"; |
|
926 ${packageHash}{$spFileName}{default} = "true"; |
|
927 $finalState ++; |
|
928 } |
|
929 # if there is servicePack->instructions we should read specianInstructions file |
|
930 my $specialInstructions = $xmlDataHandle->{servicePacks}->{servicePack}->{instructions}; |
|
931 if( $specialInstructions ) { |
|
932 printLog( "read special instructions" ); |
|
933 } |
|
934 } |
|
935 # this is needed due to SymSEE's obsolete xml library |
|
936 # in case there is > 1 SP's in one XML file |
|
937 else { |
|
938 foreach( keys(%{$xmlDataHandle->{servicePacks}->{servicePack} } ) ) { |
|
939 # foreach my $tmparray( $xmlDataHandle->{servicePacks}->{servicePack} ) { |
|
940 printLog( "spname: $_" ); |
|
941 my $spFileName = $xmlDataHandle->{servicePacks}->{servicePack}->{$_}->{file}->{name}; |
|
942 printLog( "spFileName: $spFileName" ); |
|
943 ${packageHash}{$spFileName}{path} = FixPaths( $releaseInServer ); |
|
944 ${packageHash}{$spFileName}{type} = "zip"; |
|
945 ${packageHash}{$spFileName}{state} = $finalState; |
|
946 ${packageHash}{$spFileName}{extract} = "single"; |
|
947 ${packageHash}{$spFileName}{default} = "true"; |
|
948 $finalState ++; |
|
949 } |
|
950 } |
|
951 } |
|
952 |
|
953 # inserts files on beginning of @finalZipList so they are readable in correct order when extracting (dependencies first) |
|
954 sub SortFilesToFinalLists { |
|
955 foreach my $zips( sort { $packageHash{$b}->{'state'} <=> $packageHash{$a}->{'state'} } keys %packageHash ) { |
|
956 if( $packageHash{$zips}->{'default'} eq 'true' ) { |
|
957 my $tmpHash = $packageHash{$zips}; |
|
958 $tmpHash->{'filename'} = $zips; |
|
959 unshift @finalZipList, $tmpHash; |
|
960 } |
|
961 } |
|
962 %packageHash = 0; |
|
963 } |
|
964 |
|
965 sub AddDependencies { |
|
966 # parameters contains info which release needs to be DL'd first |
|
967 my( $dependsOfService, $dependsOfProduct, $dependsOfRelease ) = @_; |
|
968 my $dependsOf = $dependsOfService ."/". $dependsOfProduct ."/". $dependsOfRelease ."/"; |
|
969 |
|
970 # if we are here, dependecies really exists.. |
|
971 # print "the package has dependency: $dependsOf\n"; |
|
972 # print "so calling self with $serverPath and $dependsOf\n"; |
|
973 |
|
974 # first we'll have to find correct xml file |
|
975 my $xmlPath; |
|
976 # if we are DL'ing from custom path ==> first check relative path |
|
977 if( $param_release_path ) { |
|
978 # best guess is $param_release_path\..\..\..\$dependsOf even though it is not very common situation |
|
979 my $dependencyPath = FixPaths( $param_release_path ) . "../../../" . FixPaths( $dependsOf ); |
|
980 if( -e $dependencyPath."release_metadata.xml" ) { |
|
981 printLog( $dependencyPath ."release_metadata.xml exists - setting dependencyPath accordingly" ); |
|
982 $xmlPath = $dependencyPath; |
|
983 } |
|
984 # in case it is not in relative path we should try finding it from release server |
|
985 elsif( -e $pathToReleaseFolder.$dependsOf."release_metadata.xml" ) { |
|
986 printLog( $dependencyPath ."release_metadata.xml not not exist - setting dependencyPath accordingly" ); |
|
987 $xmlPath = $pathToReleaseFolder.$dependsOf; |
|
988 } |
|
989 } |
|
990 # param_release_path not defined |
|
991 else { |
|
992 $xmlPath = $pathToReleaseFolder.$dependsOf; |
|
993 } |
|
994 printLog( "xmlpath: $xmlPath" ); |
|
995 |
|
996 if (!-e $xmlPath && $param_keepgoing) {return;} |
|
997 |
|
998 my $dependecyXml = SearchValidXml( $xmlPath ); |
|
999 printLog( "xml candidate: $dependecyXml" ); |
|
1000 # open the xml file and check wheter it is the one we want |
|
1001 my $dependencyXmlParser = new XML::Simple( ); |
|
1002 my $dependencyData = $dependencyXmlParser->XMLin( $xmlPath.$dependecyXml ); |
|
1003 |
|
1004 # read releaseDetails from xml candidate |
|
1005 my $tmpServiceName = $dependencyData->{releaseDetails}->{releaseID}->{service}->{name}; |
|
1006 my $tmpProductName = $dependencyData->{releaseDetails}->{releaseID}->{product}->{name}; |
|
1007 my $tmpReleaseName = $dependencyData->{releaseDetails}->{releaseID}->{release}->{name}; |
|
1008 |
|
1009 |
|
1010 printLog( "tmpServiceName: $tmpServiceName tmpProductName: $tmpProductName tmpReleaseName: $tmpReleaseName" ); |
|
1011 printLog( "dependsOfService: $dependsOfService dependsOfProduct: $dependsOfProduct dependsOfRelease: $dependsOfRelease" ); |
|
1012 |
|
1013 # compare xml candidate's data to dependency data |
|
1014 if( $tmpServiceName eq $dependsOfService and |
|
1015 $tmpProductName eq $dependsOfProduct and |
|
1016 $tmpReleaseName eq $dependsOfRelease ) { |
|
1017 printLog( "MATCH!" ); |
|
1018 |
|
1019 my $dependencyLocationInServer; |
|
1020 |
|
1021 if(! $param_release_path ) { |
|
1022 $dependencyLocationInServer = ParseDownloadDir( $dependencyData ); |
|
1023 } |
|
1024 else { |
|
1025 $dependencyLocationInServer = $xmlPath; |
|
1026 } |
|
1027 printLog( "So calling downloadRelease with serverpath: $dependencyLocationInServer, metadatafile: $dependsOf$dependecyXml" ); |
|
1028 |
|
1029 # read files from dependency xml to %packageHash |
|
1030 GeneratePackageHash( $dependencyData, $dependencyLocationInServer ); |
|
1031 printLog( "dependency package hash generated" ); |
|
1032 |
|
1033 # insert needed files to @finalZipList |
|
1034 SortFilesToFinalLists( ); |
|
1035 printLog( "dependency files sorted to final zip list" ); |
|
1036 |
|
1037 # check if there is still dependencies we need to extract |
|
1038 if( $dependencyData->{releaseDetails}->{dependsOf}->{service} ) { |
|
1039 # read from xml where can we get dependeny |
|
1040 my $dependsOfService = $dependencyData->{releaseDetails}->{dependsOf}->{service}->{name}; |
|
1041 my $dependsOfProduct = $dependencyData->{releaseDetails}->{dependsOf}->{product}->{name}; |
|
1042 my $dependsOfRelease = $dependencyData->{releaseDetails}->{dependsOf}->{release}->{name}; |
|
1043 |
|
1044 printLog( "First dl: $dependsOfService $dependsOfProduct $dependsOfRelease" ); |
|
1045 |
|
1046 # add dependency files to finalLists |
|
1047 AddDependencies( $dependsOfService, $dependsOfProduct, $dependsOfRelease ); |
|
1048 } |
|
1049 } |
|
1050 else { |
|
1051 HandleError( "Dependency release $xmlPath.$dependecyXml doesnt seem to match with actual downloadable", $cannotContinue ); |
|
1052 } |
|
1053 } |
|
1054 |
|
1055 sub RemoveThisXmlFromFinalList { |
|
1056 my( $xmlFileName, $printRemoving ) = @_; |
|
1057 |
|
1058 printLog( "Removing contents of $xmlFileName from finalziplist" ); |
|
1059 |
|
1060 my $currentReleaseXmlParser = new XML::Simple( ); |
|
1061 my $currentReleaseXmlHandle = $currentReleaseXmlParser->XMLin( $xmlFileName ); |
|
1062 if( $printRemoving ) { |
|
1063 print $currentReleaseXmlHandle->{releaseDetails}->{releaseID}->{release}->{name}; |
|
1064 print " exists already => extracting only delta\n\n"; |
|
1065 } |
|
1066 |
|
1067 # generate packageHash for old release |
|
1068 my $location = ParseDownloadDir( $currentReleaseXmlHandle ); |
|
1069 GeneratePackageHash( $currentReleaseXmlHandle, $location ); |
|
1070 |
|
1071 # remove files from @finalZipList |
|
1072 ReductFilesFromFinalLists( ); |
|
1073 |
|
1074 # remove already DL'd dependency zips |
|
1075 if( $currentReleaseXmlHandle->{releaseDetails}->{dependsOf}->{service} ) { |
|
1076 printLog( "already DL'd dependency needs to be removed as well:" ); |
|
1077 |
|
1078 my $xmlToRemove; |
|
1079 |
|
1080 # parse $dependsOf from xml |
|
1081 my $dependsOfServiceToRemove = FixPaths( $currentReleaseXmlHandle->{releaseDetails}->{dependsOf}->{service}->{name} ); |
|
1082 my $dependsOfProductToRemove = FixPaths( $currentReleaseXmlHandle->{releaseDetails}->{dependsOf}->{product}->{name} ); |
|
1083 my $dependsOfReleaseToRemove = FixPaths( $currentReleaseXmlHandle->{releaseDetails}->{dependsOf}->{release}->{name} ); |
|
1084 |
|
1085 my $dependsOf = $dependsOfServiceToRemove.$dependsOfProductToRemove.$dependsOfReleaseToRemove; |
|
1086 local *TMPTEST; |
|
1087 |
|
1088 # find out where the release came from |
|
1089 if( $param_release_path ) { |
|
1090 # best guess is $param_release_path\..\..\..\$dependsOf even though it is not very common situation |
|
1091 my $dependencyPath = FixPaths( $param_release_path ) . "../../../" . FixPaths( $dependsOf ); |
|
1092 if( -e $dependencyPath."release_metadata.xml" ) { |
|
1093 printLog( $dependencyPath ."release_metadata.xml exists - setting pathTo ReleaseFolder accordingly" ); |
|
1094 $xmlToRemove = $dependencyPath; |
|
1095 } |
|
1096 # in case it is not in relative path we should try finding it from release server |
|
1097 elsif( -e $pathToReleaseFolder.$dependsOf."release_metadata.xml" ) { |
|
1098 printLog( $dependencyPath ."release_metadata.xml not not exist - setting pathToReleaseFolder accordingly" ); |
|
1099 $xmlToRemove = $pathToReleaseFolder.$dependsOf; |
|
1100 } |
|
1101 } |
|
1102 elsif( opendir( TMPTEST, $pathToReleaseFolder.$dependsOf ) ) { |
|
1103 $xmlToRemove = $pathToReleaseFolder.$dependsOf; |
|
1104 } |
|
1105 else { |
|
1106 $xmlToRemove = $defaultPathToServer.$dependsOf; |
|
1107 } |
|
1108 |
|
1109 #my $xmlToRemove = $pathToReleaseFolder; |
|
1110 |
|
1111 $xmlToRemove .= SearchValidXml( $xmlToRemove ); |
|
1112 printLog( "following xml needs to be removed also: $xmlToRemove" ); |
|
1113 RemoveThisXmlFromFinalList( $xmlToRemove ); |
|
1114 } |
|
1115 } |
|
1116 |
|
1117 sub ReductFilesFromFinalLists { |
|
1118 printLog( "reducting files from finalziplist" ); |
|
1119 foreach my $zips( sort { $packageHash{$b}->{'state'} <=> $packageHash{$a}->{'state'} } keys %packageHash ) { |
|
1120 printLog( "matching $zips" ); |
|
1121 if( $packageHash{$zips}->{'default'} eq 'true' ) { |
|
1122 my $tmpHash = $packageHash{$zips}; |
|
1123 # $tmpHash->{'filename'} = $zips; |
|
1124 # unshift @finalZipList, $tmpHash; |
|
1125 |
|
1126 # if $tmpHash->{'filename'} eq can be found from finalziplist -> pop |
|
1127 foreach my $finalZip( @finalZipList ) { |
|
1128 # path contains ../../../ so wont match ==> |
|
1129 # if( $finalZip->{filename} eq $zips and |
|
1130 # $finalZip->{path} eq %packageHash->{$zips}->{'path'} ) { |
|
1131 if( $finalZip->{filename} eq $zips ) { |
|
1132 printLog( "removing $finalZip->{path} $finalZip->{filename} from dl list" ); |
|
1133 $finalZip->{default} = "false"; |
|
1134 } |
|
1135 } |
|
1136 } |
|
1137 } |
|
1138 %packageHash = 0; |
|
1139 } |
|
1140 |
|
1141 # verifying that files in @finalZipList really exists |
|
1142 sub VerifyFinalZipList { |
|
1143 print "Verifying all the zips exists... "; |
|
1144 |
|
1145 my $counter = 0; |
|
1146 |
|
1147 foreach my $file( @finalZipList ) { |
|
1148 my $tmpFileName = $file->{path}.$file->{filename}; |
|
1149 printLog( "Checking $tmpFileName.." ); |
|
1150 opendir( VERIFYDIR, $file->{path} ) or HandleError( $file->{path}, $dependencyMissing ); |
|
1151 # scan all xml files to @xmlFiles |
|
1152 my @matchingFiles = grep /$file->{filename}/i, readdir VERIFYDIR; |
|
1153 |
|
1154 if( ! @matchingFiles ) { |
|
1155 HandleError( $file->{path}.$file->{filename}, $dependencyMissing ); |
|
1156 |
|
1157 # if we are here there is missing file but keep_going defined |
|
1158 $file->{default} = "false"; |
|
1159 } |
|
1160 closedir VERIFYDIR; |
|
1161 |
|
1162 $counter++; |
|
1163 } |
|
1164 |
|
1165 print "done\n"; |
|
1166 } |
|
1167 |
|
1168 |
|
1169 sub GetEnv { |
|
1170 # first thing is to copy 7zip |
|
1171 if( ! $param_print_only ) { |
|
1172 `7za --help`; |
|
1173 HandleError( "couldnt copy 7zip! make sure you have it in your system path!", $warning ) if ($? != 0); |
|
1174 mkdir $tmpDir; |
|
1175 mkdir $tmpDlDir; |
|
1176 } |
|
1177 |
|
1178 printLog( "final zip list:" ); |
|
1179 printLog( Dumper( @finalZipList ) ); |
|
1180 |
|
1181 # symsee 3.3.0 contains obsolete archive::zip, so we'll have to use system calls |
|
1182 foreach my $file( @finalZipList ) { |
|
1183 $returnValue = 0; |
|
1184 |
|
1185 # skip not mandatory files |
|
1186 next if( $file->{default} eq "false" ); |
|
1187 |
|
1188 # DEPRECATED parameters just for compatibility |
|
1189 # Filter out some not wanted zip files |
|
1190 # skip internal, testsources, docs |
|
1191 if( $param_skipITD ) { |
|
1192 print "skipitd is deprecated and unmaintained parameter that will be removed in the future!\nInstead you should use \"getenv -x tsrc\""; |
|
1193 |
|
1194 printLog( "param skipITD used, checking wheter we have to skip: $file->{filename}" ); |
|
1195 # skip if zip filename matches _internal.zip, _tsrc.zip, _doc.zip |
|
1196 next if $file->{filename} =~ /internal.zip/; |
|
1197 next if $file->{filename} =~ /tsrc.zip/; |
|
1198 next if $file->{filename} =~ /doc.zip/; |
|
1199 } |
|
1200 |
|
1201 # DEPRECATED parameters just for compatibility |
|
1202 # get only files needed for emulator and service packs |
|
1203 if( $param_emuenv ) { |
|
1204 print "emu is deprecated and unmaintained parameter that will be removed in the future!\nInstead you should use \"getenv -i emu\""; |
|
1205 my $skip = 1; |
|
1206 |
|
1207 printLog( "param emu used, checking wheter we have to skip: $file->{filename}" ); |
|
1208 if( $file->{filename} =~ /winscw.zip/ or |
|
1209 $file->{filename} =~ /epoc32.zip/ or |
|
1210 $file->{filename} =~ /epoc32_tools.zip/ or |
|
1211 $file->{state} == 10 ) { |
|
1212 $skip = 0; |
|
1213 } |
|
1214 next if $skip; |
|
1215 } |
|
1216 |
|
1217 my $skipByFilter = 0; |
|
1218 # exclude files that has s60filter matching with exclude array |
|
1219 if( @param_exclude ) { |
|
1220 foreach my $exclude( @param_exclude ) { |
|
1221 if( $exclude eq $file->{s60filter} ) { |
|
1222 $skipByFilter = 1; |
|
1223 last; |
|
1224 } |
|
1225 } |
|
1226 } |
|
1227 # include only files that has s60filter matching with include array |
|
1228 elsif( @param_include ) { |
|
1229 $skipByFilter = 1; |
|
1230 foreach my $include( @param_include ) { |
|
1231 if( $include eq $file->{s60filter} ) { |
|
1232 $skipByFilter = 0; |
|
1233 last; |
|
1234 } |
|
1235 } |
|
1236 } |
|
1237 next if $skipByFilter; |
|
1238 |
|
1239 # let's do some forking |
|
1240 # parent process unzips from tmpdir and child DL's new package from network |
|
1241 |
|
1242 # fork new process |
|
1243 my $pid = myFork(); |
|
1244 if( $pid ) { |
|
1245 # parent process copies/unzips packages to tmpDlDir |
|
1246 printLog( "parent: extract packages to $tmpDlDir" ); |
|
1247 printLog( "parent: Processing: $file->{filename}... " ); |
|
1248 print "Processing: $file->{filename}... "; |
|
1249 |
|
1250 if( $file->{extract} eq 'single' ) { |
|
1251 # copy single zipped packages to $tmpDlDir |
|
1252 printLog( "parent: single zipped - copy to $tmpDlDir" ); |
|
1253 if( ! $param_print_only ) { |
|
1254 copy( $file->{path} . $file->{filename}, $tmpDlDir ) or |
|
1255 HandleError( "cant copy file $file->{path}$file->{filename} to $tmpDlDir", $cannotContinue); |
|
1256 } |
|
1257 } |
|
1258 elsif( $file->{extract} eq 'double' ) { |
|
1259 # unzip double zipped zips to $tmpDlDir |
|
1260 # there shouldnt be much of these anymore |
|
1261 printLog( "parent: double zipped - unzip to $tmpDlDir" ); |
|
1262 my $extrCmd = "7za x -y \""; |
|
1263 $extrCmd .= $file->{path} . $file->{filename}; |
|
1264 $extrCmd .= "\" -o" . $tmpDlDir; |
|
1265 $extrCmd .= " > NUL"; |
|
1266 print "system: $extrCmd\n" if( $param_print_only ); |
|
1267 printLog( "parent: system: $extrCmd" );; |
|
1268 system( $extrCmd ) if( !$param_print_only ); |
|
1269 if( $? ) { |
|
1270 printLog( "Problem processing $file->{path} $file->{filename}: $?" );; |
|
1271 $returnValue = $?; |
|
1272 HandleZipError( $file->{path} . $file->{filename}, $? ); |
|
1273 } |
|
1274 } |
|
1275 elsif( $file->{extract} eq 'save' ) { |
|
1276 # copy non-zipped files directly to environment ( getcwd ) |
|
1277 print "pure copy\n" if( $param_print_only ); |
|
1278 printLog( "parent: pure copy from: ".$file->{path}.$file->{filename}." to: ".getcwd.$file->{filename} ); |
|
1279 copy( $file->{path}.$file->{filename}, getcwd.$file->{filename} ) if( ! $param_print_only ); |
|
1280 } |
|
1281 else { |
|
1282 HandleError( "unregocnised filetype: $file", $warning ); |
|
1283 } |
|
1284 |
|
1285 printLog( "parent: package in $tmpDlDir available.. waiting for child" ); |
|
1286 waitpid($pid, 0); |
|
1287 printLog( "parent: finished" ); |
|
1288 } |
|
1289 elsif( $pid == 0 ) { |
|
1290 # TODO: we should test wheter there is zips in $tmpDir |
|
1291 printLog( "child: extract zips from $tmpDir to ".getcwd ); |
|
1292 |
|
1293 # extract from temp to extractDir |
|
1294 UnzipFromTempToEnv( ); |
|
1295 |
|
1296 printLog( "child: finished" ); |
|
1297 exit( 0 ); |
|
1298 } |
|
1299 else { |
|
1300 # fork failed |
|
1301 die "Cannot fork: $!\n"; |
|
1302 } |
|
1303 |
|
1304 # this is after forking |
|
1305 # move files from tmpDlDir => tmpDir |
|
1306 my $somethingToCopy = 0; |
|
1307 opendir( DLTEMP, $tmpDlDir ) or HandleError( "cant read $tmpDlDir dir: $!", $warning ); |
|
1308 my @filesFound = readdir( DLTEMP ); |
|
1309 closedir( DLTEMP ); |
|
1310 foreach my $file( @filesFound ) { |
|
1311 next if $file =~ /^\.[\.]?$/; |
|
1312 $somethingToCopy = 1; |
|
1313 } |
|
1314 |
|
1315 if( $somethingToCopy ) { |
|
1316 printLog( "move everything from $tmpDlDir to $tmpDir > NUL" ); |
|
1317 my $moveCmd = "move $tmpDlDir\\*.* $tmpDir > NUL"; |
|
1318 printLog( "running moveCmd: $moveCmd" ); |
|
1319 system( $moveCmd ) if( !$param_print_only ); |
|
1320 # move( "$tmpDlDir/*.*", "$tmpDir" ) or die( "move failed: $!" ); |
|
1321 } |
|
1322 |
|
1323 if( $returnValue == 0 ) { |
|
1324 print "done\n"; |
|
1325 printLog( "done" ); |
|
1326 } |
|
1327 else { |
|
1328 print "done, but errors occured!\n"; |
|
1329 printLog( "done, but errors occured" ); |
|
1330 } |
|
1331 } |
|
1332 |
|
1333 # current forking mechanism is leaving last package(s) to $tmpDir |
|
1334 UnzipFromTempToEnv( ); |
|
1335 |
|
1336 if( -e FixPaths( getcwd )."currentRelease.xml" ) { |
|
1337 unlink( FixPaths( getcwd )."currentRelease.xml" ) if( ! $param_print_only ); |
|
1338 } |
|
1339 # copy the xml into $extractDir\buildData from $serverPath.$serviceName.$metaDataFile |
|
1340 copy( $metaDataXml, FixPaths( getcwd )."currentRelease.xml" ) if( ! $param_print_only ); |
|
1341 |
|
1342 # cover trails |
|
1343 unlink( "/7za.exe" ) if( ! $param_print_only ); |
|
1344 if( ! $param_print_only ) { |
|
1345 printLog( "removing temp dir... " ); |
|
1346 rmdir $tmpDir or HandleError( "Couldnt remove temp dir: $!", $warning ); |
|
1347 rmdir $tmpDlDir or HandleError( "Couldnt remove temp dir: $!", $warning ); |
|
1348 print scalar(localtime) . ": done fetching environment\n"; |
|
1349 printLog( "done" ); |
|
1350 } |
|
1351 } |
|
1352 |
|
1353 sub UnzipFromTempToEnv { |
|
1354 # extract from temp to extractDir |
|
1355 printLog( "child: unzip from temp" ); |
|
1356 my $finalUnzipCmd = "7za x -y \"".UnFixPaths( $tmpDir )."\\*.zip\" -o\"".UnFixPaths( getcwd )."\""; |
|
1357 $finalUnzipCmd .= " > NUL"; |
|
1358 print "system: $finalUnzipCmd\n" if( $param_print_only ); |
|
1359 printLog( "child: system: $finalUnzipCmd" ); |
|
1360 system( $finalUnzipCmd ) if( !$param_print_only ); |
|
1361 # if( $? ) { |
|
1362 # $returnValue = $?; |
|
1363 # HandleZipError( $file->{path} . $file->{filename}, $? ); |
|
1364 # } |
|
1365 |
|
1366 # empty temp dir |
|
1367 printLog( "child: empty temp dir" ); |
|
1368 $tmpDir =~ s/\//\\/g; |
|
1369 printLog( "child: unlink: $tmpDir" ); |
|
1370 |
|
1371 # dont handle errors - temp might be empty as well! |
|
1372 opendir( TEMPDIR, $tmpDir ); |
|
1373 my @zipFiles = grep /zip/, readdir TEMPDIR; |
|
1374 foreach my $myfile( @zipFiles ) { |
|
1375 if( ! $param_print_only ) { |
|
1376 printLog( "child: unlink: $myfile" ); |
|
1377 unlink( $tmpDir."/".$myfile ); |
|
1378 } |
|
1379 } |
|
1380 closedir TEMPDIR; |
|
1381 } |
|
1382 |
|
1383 # handles return values coming from 7zip |
|
1384 # 0 No error |
|
1385 # 1 Warning (Non fatal error(s)). For example, some files were locked by other application during compressing. So they were not compressed. |
|
1386 # 2 Fatal error |
|
1387 # 7 Command line error |
|
1388 # 8 Not enough memory for operation |
|
1389 # 255 User stopped the process |
|
1390 sub HandleZipError { |
|
1391 my( $filename, $errorCode ) = @_; |
|
1392 |
|
1393 if( $errorCode == 1 ) { |
|
1394 # warning |
|
1395 printLog( "7zip reported warning during unzipping of $filename" ); |
|
1396 print "Warning while unzipping $filename!\nSome files might be locked be other processes. It is possible that all the files werent extracted!\n"; |
|
1397 } |
|
1398 elsif( $errorCode == 2 ) { |
|
1399 # fatal error |
|
1400 printLog( "possibly corrupted archive: $filename" ); |
|
1401 print "Fatal error occured while extracting $filename!!\nPlease check you have enough disk space on ".getcwd."\n"; |
|
1402 print "Otherwise you should report this problem for the build team. Please include ".getcwd."\\getenv.log to the mail."; |
|
1403 } |
|
1404 elsif( $errorCode == 7 ) { |
|
1405 # commandline error |
|
1406 printLog( "there is command line error while unzipping $filename" ); |
|
1407 print "7-zip is reporting command line error when unzipping $filename."; |
|
1408 print "You should report this problem for the build team. Please include ".getcwd."\\getenv.log to the mail."; |
|
1409 } |
|
1410 elsif( $errorCode == 8 ) { |
|
1411 # not enough memory |
|
1412 printLog( "7zip reports not enough memory. Possibly disk full" ); |
|
1413 print "Not enough memory to extract $filename!!\nPlease check you have enough disk space on ".getcwd.". Otherwise please try again\n"; |
|
1414 } |
|
1415 elsif( $errorCode == 255 ) { |
|
1416 # user aborted |
|
1417 printLog( "User aborted extraction!!" ); |
|
1418 print "User aborted extraction!\n$filename is not extracted completely and therefore your environment might not work as expected!"; |
|
1419 } |
|
1420 else { |
|
1421 # unspecified error |
|
1422 printLog( "unspecified error: $errorCode while extracing: $filename\nPlease check you have enough free disk space" ); |
|
1423 } |
|
1424 } |
|
1425 |
|
1426 # return path to accessible GRACE samba share |
|
1427 sub FindGraceServer { |
|
1428 # added 27.2.2007 : skip seeking if server has given from commandline |
|
1429 # salmarko starts |
|
1430 if (defined $param_server) {return FixPaths( $param_server );} |
|
1431 # salmarko ends |
|
1432 |
|
1433 print "\nseeking possible grace accesses. This might take a while.. "; |
|
1434 |
|
1435 my @graceAccessArray; |
|
1436 foreach my $address( @graceList ) { |
|
1437 printLog( "accessing $address..." ); |
|
1438 if( opendir( GRACETEST, $address ) ) { |
|
1439 push @graceAccessArray, $address; |
|
1440 printLog( " success\n" ); |
|
1441 close GRACETEST; |
|
1442 } |
|
1443 else { |
|
1444 printLog( " fail" ); |
|
1445 } |
|
1446 } |
|
1447 |
|
1448 if( @graceAccessArray ) { |
|
1449 print "done\nSelected GRACE server: ", $graceAccessArray[0]; |
|
1450 if( scalar( @graceAccessArray ) > 1 ) { |
|
1451 |
|
1452 # if start is defined && >1 grace shares available, we'll have to just guess correct share |
|
1453 if( $param_start_directly ) { |
|
1454 print( "More than one grace shares accessible\n" ); |
|
1455 print Dumper( @graceAccessArray ); |
|
1456 print "\nBecause -start parameter is provided we cant prompt user to select correct, lets pick first one from the list\n"; |
|
1457 print "You should use -server parameter to define the server\n"; |
|
1458 printLog( "-start defined and >1 grace shares accessible" ); |
|
1459 printLog( @graceAccessArray ); |
|
1460 printLog( "selecting first one: $graceAccessArray[0]" ); |
|
1461 return FixPaths( $graceAccessArray[0] ); |
|
1462 } |
|
1463 else { |
|
1464 # salmarko starts |
|
1465 return FixPaths( PrintSelectMenu( "Select reasonable GRACE share", @graceAccessArray ) ); |
|
1466 # salmarko ends |
|
1467 } |
|
1468 } |
|
1469 else { |
|
1470 # salmarko starts |
|
1471 return FixPaths( $graceAccessArray[0] ); |
|
1472 # salmarko ends |
|
1473 } |
|
1474 } |
|
1475 print "none found\n"; |
|
1476 return 0; |
|
1477 } |
|
1478 |
|
1479 # return name of the release from metadata.xml |
|
1480 sub ReturnReleaseName { |
|
1481 my $data = shift( @_ ); |
|
1482 |
|
1483 my $tempXmlParser = new XML::Simple( ); |
|
1484 my $tempXmlHandle = $tempXmlParser->XMLin( $data ); |
|
1485 |
|
1486 # parse dl directory into $releaseDirectory |
|
1487 return $tempXmlHandle->{releaseDetails}->{releaseID}->{release}->{name}; |
|
1488 } |
|
1489 |
|
1490 # retrurn name of the product from metadata.xml |
|
1491 sub ReturnProductName { |
|
1492 my $data = shift( @_ ); |
|
1493 |
|
1494 my $tempXmlParser = new XML::Simple( ); |
|
1495 my $tempXmlHandle = $tempXmlParser->XMLin( $data ); |
|
1496 |
|
1497 # parse dl directory into $releaseDirectory |
|
1498 return $tempXmlHandle->{releaseDetails}->{releaseID}->{product}->{name}; |
|
1499 } |
|
1500 |
|
1501 sub GetSoapVersion { |
|
1502 printLog( "Trying to access SOAP server" ); |
|
1503 |
|
1504 my $soapVersion = eval { SOAP::Lite |
|
1505 ->uri('GetEnv') |
|
1506 ->on_action(sub{ sprintf('%s/%s', @_ )}) |
|
1507 ->proxy($soapServiceURL) |
|
1508 ->GetVersionInfo( ) |
|
1509 ->result } ; |
|
1510 |
|
1511 print Dumper( $soapVersion ) if( $param_debug ); |
|
1512 |
|
1513 return $soapVersion; |
|
1514 } |
|
1515 |
|
1516 sub StartSoapSession { |
|
1517 printLog( "fetching session start info from SOAP" ); |
|
1518 my $netPath = FixPaths( $pathToReleaseFolder ); |
|
1519 $netPath .= FixPaths( $defaultServiceName ); |
|
1520 $netPath .= FixPaths( ReturnProductName( $metaDataXml ) ); |
|
1521 $netPath .= FixPaths( ReturnReleaseName( $metaDataXml ) ); |
|
1522 # $netPath .= $metaDataXml; |
|
1523 printLog( "about to fetch: $netPath" ); |
|
1524 |
|
1525 return SOAP::Lite |
|
1526 ->uri('GetEnv') |
|
1527 ->on_action(sub{ sprintf('%s/%s', @_ )}) |
|
1528 ->proxy($soapServiceURL) |
|
1529 ->StartGetEnv( SOAP::Data->name( BuildName=> ReturnReleaseName( $metaDataXml ) ) |
|
1530 ->type('string') |
|
1531 ->uri('GetEnv'), |
|
1532 SOAP::Data->name( NetworkPath=> $netPath ) |
|
1533 ->type('string') |
|
1534 ->uri('GetEnv'), |
|
1535 SOAP::Data->name( UserName=> $ENV{'USERNAME'} ) |
|
1536 ->type('string') |
|
1537 ->uri('GetEnv'), |
|
1538 SOAP::Data->name( MachineName=> $ENV{'COMPUTERNAME'} ) |
|
1539 ->type('string') |
|
1540 ->uri('GetEnv') ) |
|
1541 ->result; |
|
1542 } |
|
1543 |
|
1544 sub EndSoapConnection { |
|
1545 printLog( "SOAP: Finishing SOAP session: $soapSessionID" ); |
|
1546 printLog( "SOAP: release downloaded: $metaDataXml" ); |
|
1547 |
|
1548 return SOAP::Lite |
|
1549 ->uri('GetEnv') |
|
1550 ->on_action(sub{ sprintf('%s/%s', @_ )}) |
|
1551 ->proxy($soapServiceURL) |
|
1552 ->DoneGetEnv( SOAP::Data->name( ID=> $soapSessionID ) |
|
1553 ->type('string') |
|
1554 ->uri('GetEnv')) |
|
1555 ->result; |
|
1556 |
|
1557 } |
|
1558 |
|
1559 |
|
1560 sub FindTempDir { |
|
1561 # it'll speed up extraction if we put temp dir to separate disk |
|
1562 |
|
1563 } |
|
1564 |
|
1565 # finds first param from second param(comma separated list) |
|
1566 sub FindFromList { |
|
1567 my( $itemToFind, $list ) = @_; |
|
1568 my @itemList = split( /,/, $list ); |
|
1569 foreach( @itemList ) { |
|
1570 return 1 if( $_ eq $itemToFind ); |
|
1571 } |
|
1572 |
|
1573 return 0; |
|
1574 } |
|
1575 |
|
1576 sub myFork() |
|
1577 { |
|
1578 sleep(1); #let buffers flush |
|
1579 my $pid = fork(); |
|
1580 if(!defined($pid)) |
|
1581 { |
|
1582 die "fork error\n"; |
|
1583 } |
|
1584 return $pid; |
|
1585 } |
|
1586 |