releasing/cbrtools/perl/GetEnv.pm
changeset 602 3145852acc89
equal deleted inserted replaced
600:6d08f4a05d93 602:3145852acc89
       
     1 #!perl
       
     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 # 
       
    16 #
       
    17 
       
    18 package GetEnv;
       
    19 
       
    20 use strict;
       
    21 
       
    22 
       
    23 #
       
    24 # Public.
       
    25 #
       
    26 
       
    27 sub GetEnvFromRelData {
       
    28   my $iniData = shift;
       
    29   my $comp = shift;
       
    30   my $ver = shift;
       
    31   my $installSource = shift;
       
    32   my $sourceInstallPath = shift;
       
    33   my $overwriteSource = shift;
       
    34   my $removeSource = shift;
       
    35   my $verbose = shift;
       
    36   my $excludeComponents = shift;
       
    37   my $forceExclusion = shift;
       
    38   
       
    39   
       
    40 
       
    41   my $envDb = EnvDb->Open($iniData, $verbose);
       
    42   $iniData->PathData()->CheckReleaseExists($comp, $ver);
       
    43 
       
    44   print "Gathering environment information...\n";
       
    45   my $relData = RelData->Open($iniData, $comp, $ver, $verbose);
       
    46   my $env = $relData->Environment();
       
    47   GetEnv($iniData, $env, $installSource, $sourceInstallPath, $overwriteSource, $removeSource, $verbose, $excludeComponents, $forceExclusion);
       
    48 }
       
    49 
       
    50 sub GetEnv {
       
    51   my $iniData = shift;
       
    52   my $env = shift;
       
    53   my $installSource = shift;
       
    54   my $sourceInstallPath = shift;
       
    55   my $overwriteSource = shift;
       
    56   my $removeSource = shift;
       
    57   my $verbose = shift;
       
    58   my $excludeComponents = shift;
       
    59   my $forceExclusion = shift;
       
    60 
       
    61   my $envDb = EnvDb->Open($iniData, $verbose);
       
    62   my %compsToInstall;
       
    63   my %cleanComps;
       
    64   my @compsToRemove;
       
    65   
       
    66   
       
    67   # Edit the list of components if $excludeComponents is set
       
    68   if (defined $excludeComponents){
       
    69 	  $env = FilterCompsToExclude($env, $excludeComponents, $verbose, $forceExclusion);
       
    70   }
       
    71   
       
    72 
       
    73   # Check the status of each component in the new environment.
       
    74   my $error = 0;
       
    75   foreach my $thisComp (sort keys %{$env}) {
       
    76     my $thisVer = $env->{$thisComp};
       
    77     $iniData->PathData()->CheckReleaseExists($thisComp, $thisVer);
       
    78 
       
    79     my $installedVer = $envDb->Version($thisComp);
       
    80     if (defined $installedVer) {
       
    81       if ($installedVer eq $thisVer) {
       
    82         # The requested version is already installed, so check its status.
       
    83         (my $status) = $envDb->CheckComp($thisComp);
       
    84         if ($status == EnvDb::STATUS_CLEAN) {
       
    85           # Do nothing.
       
    86           if ($verbose) { print "$thisComp $thisVer is already installed, and is clean\n"; }
       
    87           $cleanComps{$thisComp} = 1;
       
    88         }
       
    89         elsif ($status == EnvDb::STATUS_PENDING_RELEASE && !$overwriteSource) {
       
    90           print "Error: $thisComp is pending release\n";
       
    91           $error = 1;
       
    92         }
       
    93         elsif ($status == EnvDb::STATUS_DIRTY || $status == EnvDb::STATUS_DIRTY_SOURCE || $status == EnvDb::STATUS_PENDING_RELEASE) {
       
    94           if ($verbose) { print "$thisComp $thisVer is already installed, but is dirty\n"; }
       
    95           push (@compsToRemove, $thisComp);
       
    96           $compsToInstall{$thisComp} = $thisVer;
       
    97         }
       
    98         elsif ($status == EnvDb::STATUS_NOT_INSTALLED) {
       
    99           die;
       
   100         }
       
   101       }
       
   102       else {
       
   103         if ($envDb->Status($thisComp) == EnvDb::STATUS_PENDING_RELEASE && !$overwriteSource) {
       
   104           print "Error: $thisComp is pending release\n";
       
   105           $error = 1;
       
   106         }
       
   107         if ($verbose) { print "$thisComp $installedVer currently installed\n"; }
       
   108         push (@compsToRemove, $thisComp);
       
   109         $compsToInstall{$thisComp} = $thisVer;
       
   110       }
       
   111     }
       
   112     else {
       
   113       $compsToInstall{$thisComp} = $thisVer;
       
   114     }
       
   115   }
       
   116 
       
   117   if ($error) {
       
   118     die "\n";
       
   119   }
       
   120 
       
   121   # Add to the remove list components in the current environment that aren't in the new environment.
       
   122   my $currentEnv = $envDb->VersionInfo();
       
   123   foreach my $thisComp (keys %{$currentEnv}) {
       
   124     unless (exists $compsToInstall{$thisComp} or exists $cleanComps{$thisComp}) {
       
   125       (my $status) = $envDb->CheckComp($thisComp);
       
   126       if ($status == EnvDb::STATUS_CLEAN) {
       
   127 	if ($verbose) { print "$thisComp currently installed (clean), but not in new environment - will be removed\n"; }
       
   128 	push (@compsToRemove, $thisComp);
       
   129       }
       
   130       elsif ($status == EnvDb::STATUS_DIRTY || $status == EnvDb::STATUS_DIRTY_SOURCE) {
       
   131 	if ($verbose) { print "$thisComp currently installed (dirty), but not in new environment - will be removed\n"; }
       
   132 	push (@compsToRemove, $thisComp);
       
   133       }
       
   134       elsif ($status == EnvDb::STATUS_PENDING_RELEASE) {
       
   135 	print "Warning: $thisComp is pending release - its binaries cannot be automatically removed.\n";
       
   136 	print "         Continue with GetEnv? [y/n] ";
       
   137 	my $response = <STDIN>;
       
   138 	chomp $response;
       
   139 	if (lc $response eq 'y') {
       
   140 	  # Remove EnvDb entry.
       
   141 	  my $ver = $envDb->Version($thisComp);
       
   142 	  if (defined $ver) {
       
   143 	    $envDb->DeleteSignature($thisComp, $ver);
       
   144 	    $envDb->SetVersion($thisComp, undef);
       
   145 	  }
       
   146 	  else {
       
   147 	    die;
       
   148 	  }
       
   149 	}
       
   150 	else {
       
   151 	  die "GetEnv aborted\n";
       
   152 	}
       
   153       }
       
   154       elsif ($status == EnvDb::STATUS_NOT_INSTALLED) {
       
   155 	die;
       
   156       }
       
   157     }
       
   158   }
       
   159 
       
   160   # Remove old binaries and source.
       
   161   foreach my $thisComp (@compsToRemove) {
       
   162     print "Removing $thisComp...\n";
       
   163     
       
   164     if ($removeSource) {
       
   165       $envDb->DeleteSource($thisComp, 0, 1);
       
   166     }
       
   167     
       
   168     $envDb->RemoveComponent($thisComp);
       
   169   }
       
   170 
       
   171   # Install new binaries (and possibly source).
       
   172   foreach my $thisComp (sort keys %compsToInstall) {
       
   173     my $thisVer = $compsToInstall{$thisComp};
       
   174     print "Installing $thisComp $thisVer...\n";
       
   175     $envDb->InstallComponent($thisComp, $thisVer, $overwriteSource);
       
   176     if ($installSource) {
       
   177       my $installPath = $sourceInstallPath;
       
   178       if (!defined ($installPath)) {
       
   179         $installPath="\\";
       
   180       }
       
   181       $envDb->UnpackSource($thisComp, $thisVer, $installPath, $overwriteSource, 1);
       
   182     }
       
   183   }
       
   184 }
       
   185 
       
   186 
       
   187 sub FilterCompsToExclude {
       
   188 	my $editEnv = shift;
       
   189 	my $excludeComp = lc (shift); 
       
   190 	my $verbose = shift;
       
   191 	my $forceExclusion = shift;
       
   192 	my $editFlag = 0;
       
   193 			
       
   194 	print "Checking components to exclude...\n";
       
   195 	
       
   196 	if(-f $excludeComp) {			# file
       
   197 		open FILE, "$excludeComp" or die "Unable to open exclude file $excludeComp - $!. Requested components for exclusion will not be excluded. ";
       
   198 		
       
   199 		while (<FILE>) {	
       
   200 			if(ExcludeComp($_, $editEnv, $verbose) and ($editFlag == 0)){
       
   201 				$editFlag = 1;
       
   202 			}
       
   203 		}				
       
   204 	}
       
   205 	else{							# single component name
       
   206 		if(ExcludeComp($excludeComp, $editEnv, $verbose)){
       
   207 			$editFlag = 1;
       
   208 		}
       
   209 	}	
       
   210 	
       
   211 	# Make user aware of what they are doing
       
   212 	if(($editFlag) and not ($forceExclusion)){
       
   213 		print "Are you happy to continue installing a Release with excluded components? - y/n\n";
       
   214 		my $input = <STDIN>;
       
   215 		unless($input =~ /^y$/i){
       
   216 			die "Getenv aborted.\n";
       
   217 		}	
       
   218 	}	
       
   219 	print "\n";	
       
   220 	return $editEnv;
       
   221 }
       
   222 
       
   223 
       
   224 sub ExcludeComp{
       
   225 	
       
   226 	my $component = shift;
       
   227 	my $env = shift;
       
   228 	my $verbose = shift;
       
   229 	my $editFlag = 0;
       
   230 
       
   231 	chomp ($component);
       
   232 	$component =~ s/\s+$//;
       
   233 	$component =~ s/^\s+//;	
       
   234 	$component = lc ($component);
       
   235 	
       
   236 	if($component =~ /^$/){					# empty string
       
   237 	}
       
   238 	elsif($component =~ /^[\w\.-]+\*$/){			# wild cards
       
   239 		$component =~ s!([\w\.-]+)\*$!$1!;
       
   240 		foreach my $comp (keys %{$env}){
       
   241 			if($comp =~ /^\Q$component\E/){
       
   242 				$editFlag = ExcludeComp($comp, $env, $verbose);
       
   243 			}
       
   244 		}
       
   245 	}	
       
   246 	elsif($component =~ /\*$/){
       
   247 		print "$component - did not understand line - ignoring.\n";	# do nothing
       
   248 	}			 
       
   249 	elsif($component !~ /\s/){				# possible component name
       
   250 		if (exists $$env{$component}){
       
   251 			print "$component will be excluded from the new environment as requested.\n" if $verbose;				
       
   252 			delete $$env{$component};
       
   253 			$editFlag = 1;
       
   254 		}
       
   255 		else{
       
   256 			print "$component is not in the archive so cannot exclude it from the new environment.\n" if $verbose;			
       
   257 		}
       
   258 	}
       
   259 	else{
       
   260 		print "'$component' contains spaces in its name - this is not a valid component name.\n";
       
   261 	}	
       
   262 	return $editFlag;
       
   263 }
       
   264 
       
   265 1;
       
   266 
       
   267 __END__
       
   268 
       
   269 =head1 NAME
       
   270 
       
   271 GetEnv.pm - Provides an interface for installing and upgrading environments.
       
   272 
       
   273 =head1 INTERFACE
       
   274 
       
   275 =head2 GetEnv
       
   276 
       
   277 Expects to be passed an C<IniData> reference, a reference to a hash containing the required component release versions, a flag indicating if to install source, a source install path (which may be undefined), a flag indicating if to overwrite source, a flag indicating whether there are components to be excluded or not and a verboisty level. Installs the specified component releases by adding, removing and upgrading existing components as required.
       
   278 
       
   279 =head2 GetEnvFromRelData
       
   280 
       
   281 Expects to be passed an C<IniData> reference, a component name, a version, a flag indicating if to install source, a source install path (which may be undefined), a flag indicating if to overwrite source, a flag indicating whether there are components to be excluded or not and a verboisty level. Retreives the version information associated with the specified component release version, and calls C<GetEnv> to install them.
       
   282 
       
   283 
       
   284 =head1 KNOWN BUGS
       
   285 
       
   286 None.
       
   287 
       
   288 =head1 COPYRIGHT
       
   289 
       
   290  Copyright (c) 2003-2009 Nokia Corporation and/or its subsidiary(-ies).
       
   291  All rights reserved.
       
   292  This component and the accompanying materials are made available
       
   293  under the terms of the License "Eclipse Public License v1.0"
       
   294  which accompanies this distribution, and is available
       
   295  at the URL "http://www.eclipse.org/legal/epl-v10.html".
       
   296  
       
   297  Initial Contributors:
       
   298  Nokia Corporation - initial contribution.
       
   299  
       
   300  Contributors:
       
   301  
       
   302  Description:
       
   303  
       
   304 
       
   305 =cut
       
   306 
       
   307 __END__