1 #!perl

     2 # Copyright (c) 2000-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 use strict;

    19 use FindBin;

    20 use lib "$FindBin::Bin";

    21 use Getopt::Long;

    22 use IniData;

    23 use EnvDb;

    24 use CommandController;

    25 

    26 

    27 #

    28 # Globals.

    29 #

    30 

    31 my $verbose = 0;

    32 my $overwriteSource = 0;

    33 my $iniData = IniData->New();

    34 my $commandController = CommandController->New($iniData, 'GetRel');

    35 my $envDb;

    36 my $installSource;

    37 my $sourceInstallPath = undef;

    38 

    39 

    40 #

    41 # Main.

    42 #

    43 

    44 ProcessCommandLine();

    45 

    46 

    47 #

    48 # Subs.

    49 #

    50 

    51 sub ProcessCommandLine {

    52   Getopt::Long::Configure ("bundling");

    53   my $help;

    54   my $stdin;

    55   GetOptions('h' => \$help, 's' => \$installSource, 'o' => \$overwriteSource, 'v+' => \$verbose, 'p' => \$stdin, 'i=s' => \$sourceInstallPath);

    56 

    57   if ($help) {

    58     Usage(0);

    59   }

    60 

    61   if ($sourceInstallPath and not $installSource) {

    62     print "Error: Invalid options - cannot specify install path (using -i) without installing source (using -s)\n";

    63     Usage(1);

    64   }

    65 

    66   $envDb = EnvDb->Open($iniData, $verbose);

    67  

    68   if ($#ARGV == -1 and $stdin) {

    69     my @failedGets;

    70     my @lines;

    71     my $line;

    72     while (defined ($line = <STDIN>)) {

    73       # Remove line feed, white space and comments.

    74       chomp $line;

    75       $line =~ s/^\s*//;

    76       $line =~ s/\s$//;

    77       $line =~ s/#.*//;

    78       if ($line eq '') {

    79         # Nothing left.

    80         next;

    81       }

    82       push @lines, $line;

    83     }

    84 

    85     # We do this as a separate loop to work around a weird defect in Perl 5.8.0

    86     # where <STDIN> only reads the first line if a system() call happens

    87     # in between (which would be done by InstallComponent)

    88     # This defect is #21717 and is due to be fixed in 5.8.1

    89     my $lineNum = 0;

    90     foreach $line (@lines) {

    91       $lineNum++;

    92       eval {

    93         my @words = split (/\s+/, $line);

    94         unless ($#words == 1) {

    95           die "Error: Invalid number of arguments at line $lineNum from STDIN\n";

    96         }

    97         InstallComponent(@words);

    98       };

    99       if ($@) {

   100         print $@;

   101         push (@failedGets, $line);

   102       }

   103     }

   104 

   105     if ($#failedGets >= 0) {

   106       print "\nThere was an error getting the following release(s):\n\n";

   107       foreach (@failedGets) {

   108         print;

   109       }

   110     }

   111   }

   112   elsif ($#ARGV == 0) {

   113     my $comp = shift @ARGV;

   114     my $ver = $envDb->Version($comp);

   115     unless (defined $ver) {

   116       die "Error: Couldn't find version of $comp - not currently installed\n";

   117     }

   118     InstallComponent($comp, $ver);

   119   }

   120   elsif ($#ARGV == 1) {

   121     InstallComponent(@ARGV);

   122   }

   123   else {

   124     print "Error: Invalid number of arguments\n";

   125     Usage(1);

   126   }

   127 }

   128 

   129 sub Usage {

   130   my $exitCode = shift;

   131 

   132   Utils::PrintDeathMessage($exitCode, "\nUsage: getrel [options] <component> [<version>]

   133 

   134 options:

   135 

   136 -h  help

   137 -s  install source code also

   138 -o  overwrite any existing source

   139 -v  verbose output (-vv very verbose)

   140 -p  read a piped list of components from STDIN\n");

   141 }

   142 

   143 sub InstallComponent {

   144   my $comp = shift;

   145   my $ver = shift;

   146 

   147   $comp = lc($comp);

   148 

   149   $iniData->PathData()->CheckReleaseExists($comp, $ver);

   150 

   151   my $relData = RelData->Open($iniData, $comp, $ver, $verbose);

   152 

   153   #change the version string to that stored in the reldata file (version nums are case dependent)

   154   my $env = $relData->Environment();

   155   $ver = $env->{$comp};

   156 

   157   my $noinstall = 0;

   158   my $installedVer = $envDb->Version($comp);

   159   if (defined $installedVer and lc($installedVer) eq lc($ver)) {

   160     (my $status) = $envDb->CheckComp($comp, 0);

   161     if ($status == EnvDb::STATUS_CLEAN) {

   162       print "$comp $ver already installed and clean\n";

   163       $noinstall = 1;

   164     }

   165   }

   166 

   167   unless ($noinstall) {

   168     # Remove old binaries if present.

   169     if (defined $installedVer and $envDb->Status($comp) != EnvDb::STATUS_PENDING_RELEASE) {

   170       if (lc($installedVer) eq lc($ver)) {

   171         print "Re-installing $comp $ver...\n";

   172       }

   173       else {

   174         print "Switching $comp from $installedVer to $ver...\n";

   175       }

   176       $envDb->RemoveComponent($comp);

   177     }

   178     else {

   179       print "Installing $comp $ver...\n";

   180     }

   181     $envDb->InstallComponent($comp, $ver, $overwriteSource);

   182   }

   183 

   184   if ($installSource) {

   185     my $installPath = $sourceInstallPath;

   186     if (!defined ($installPath)) {

   187       $installPath="\\";

   188     }

   189     $envDb->UnpackSource($comp, $ver, $installPath, $overwriteSource, 1);

   190   }

   191 }

   192 

   193 

   194 __END__

   195 

   196 =head1 NAME

   197 

   198 GetRel - Installs the binaries of a component release into the current environment.

   199 

   200 =head1 SYNOPSIS

   201 

   202   getrel [options] <component> [<version>]

   203 

   204 options:

   205 

   206   -h  help

   207   -s  install source code also

   208   -o  overwrite any existing source

   209   -v  verbose output (-vv very verbose)

   210   -p  read a piped list of components from STDIN

   211 

   212 =head1 DESCRIPTION

   213 

   214 Before installing new binaries, any existing binaries are removed. If no version is specifed, the current version will be re-installed (if it is dirty). Multiple releases may be installed by specifying the C<-p> switch and piping in text via C<STDIN> that contains lines in a <component> <version> format. Releases that fail to install are listed at the end.

   215 

   216 Source code may optionally be installed also. If specified, this will be installed into the root of the current drive. Any existing files will be overwritten with -o.

   217 

   218 As well as overwriting existing source code, C<-o> will overwrite any binaries which are left on the drive. There will only be leftover binaries in exceptional circumstances; normally C<getrel> will remove old versions of components before trying to install new ones.

   219 

   220 =head1 KNOWN BUGS

   221 

   222 None.

   223 

   224 =head1 COPYRIGHT

   225 

   226  Copyright (c) 2000-2009 Nokia Corporation and/or its subsidiary(-ies).

   227  All rights reserved.

   228  This component and the accompanying materials are made available

   229  under the terms of the License "Eclipse Public License v1.0"

   230  which accompanies this distribution, and is available

   231  at the URL "http://www.eclipse.org/legal/epl-v10.html".

   232  

   233  Initial Contributors:

   234  Nokia Corporation - initial contribution.

   235  

   236  Contributors:

   237  

   238  Description:

   239  

   240 

   241 =cut