solenv/bin/modules/installer/setupscript.pm

   1 #
   2 # This file is part of the LibreOffice project.
   3 #
   4 # This Source Code Form is subject to the terms of the Mozilla Public
   5 # License, v. 2.0. If a copy of the MPL was not distributed with this
   6 # file, You can obtain one at http://mozilla.org/MPL/2.0/.
   7 #
   8 # This file incorporates work covered by the following license notice:
   9 #
  10 #   Licensed to the Apache Software Foundation (ASF) under one or more
  11 #   contributor license agreements. See the NOTICE file distributed
  12 #   with this work for additional information regarding copyright
  13 #   ownership. The ASF licenses this file to you under the Apache
  14 #   License, Version 2.0 (the "License"); you may not use this file
  15 #   except in compliance with the License. You may obtain a copy of
  16 #   the License at http://www.apache.org/licenses/LICENSE-2.0 .
  17 #
  18
  19 package installer::setupscript;
  20
  21 use base 'Exporter';
  22
  23 use installer::exiter;
  24 use installer::globals;
  25 use installer::logger qw(globallog);
  26 use installer::remover;
  27 use installer::scriptitems;
  28 use installer::ziplist;
  29
  30 our @EXPORT_OK = qw(
  31     add_installationobject_to_variables
  32     add_lowercase_productname_setupscriptvariable
  33     add_predefined_folder
  34     get_all_items_from_script
  35     get_all_scriptvariables_from_installation_object
  36     prepare_non_advertised_files
  37     replace_all_setupscriptvariables_in_script
  38     replace_preset_properties
  39     resolve_lowercase_productname_setupscriptvariable
  40     set_setupscript_name
  41 );
  42
  43 #######################################################
  44 # Set setup script name, if not defined as parameter
  45 #######################################################
  46
  47 sub set_setupscript_name
  48 {
  49     my ( $allsettingsarrayref, $includepatharrayref ) = @_;
  50
  51     my $scriptnameref = installer::ziplist::getinfofromziplist($allsettingsarrayref, "script");
  52
  53     my $scriptname = $$scriptnameref;
  54
  55     if ( $scriptname eq "" )    # not defined on command line and not in product list
  56     {
  57         installer::exiter::exit_program("ERROR: Setup script not defined on command line (-l) and not in product list!", "set_setupscript_name");
  58     }
  59
  60     if ( $installer::globals::compiler =~ /wnt/ )
  61     {
  62         $scriptname .= ".inf";
  63     }
  64     else
  65     {
  66         $scriptname .= ".ins";
  67     }
  68
  69     # and now the complete path for the setup script is needed
  70     # The log file cannot be used, because this is the language independent section
  71
  72     $scriptnameref = installer::scriptitems::get_sourcepath_from_filename_and_includepath(\$scriptname, $includepatharrayref, 1);
  73
  74     $installer::globals::setupscriptname = $$scriptnameref;
  75
  76     if ( $installer::globals::setupscriptname eq "" )
  77     {
  78         installer::exiter::exit_program("ERROR: Script $scriptname not found!", "set_setupscript_name");
  79     }
  80 }
  81
  82 #####################################################################
  83 # Reading script variables from installation object of script file
  84 #####################################################################
  85
  86 sub get_all_scriptvariables_from_installation_object
  87 {
  88     my ($scriptref) = @_;
  89
  90     my @installobjectvariables;
  91
  92     for ( my $i = 0; $i <= $#{$scriptref}; $i++ )
  93     {
  94         my $line = ${$scriptref}[$i];
  95
  96         if ( $line =~ /^\s*Installation\s+\w+\s*$/ )    # should be the first line
  97         {
  98             my $counter = $i+1;
  99             my $installline = ${$scriptref}[$counter];
 100
 101             while (!($installline =~ /^\s*End\s*$/ ))
 102             {
 103                 if ( $installline =~ /^\s*(\w+)\s+\=\s*(.*?)\s*\;\s*$/ )
 104                 {
 105                     my $key = $1;
 106                     my $value = $2;
 107
 108                     # removing leading and ending " in $value
 109
 110                     if ( $value =~ /^\s*\"(.*)\"\s*$/ )
 111                     {
 112                         $value = $1;
 113                     }
 114
 115                     $key = "\%" . uc($key);  # $key is %PRODUCTNAME
 116
 117                     my $input = $key . " " . $value . "\n";   # $key can only be the first word
 118
 119                     push(@installobjectvariables ,$input);
 120                 }
 121
 122                 $counter++;
 123                 $installline = ${$scriptref}[$counter];
 124             }
 125         }
 126
 127         last;   # not interesting after installation object
 128     }
 129
 130     return \@installobjectvariables;
 131 }
 132
 133 ######################################################################
 134 # Including LCPRODUCTNAME into the array
 135 ######################################################################
 136
 137 sub add_lowercase_productname_setupscriptvariable
 138 {
 139     my ( $variablesref ) = @_;
 140
 141     for ( my $j = 0; $j <= $#{$variablesref}; $j++ )
 142     {
 143         my $variableline = ${$variablesref}[$j];
 144
 145         my ($key, $value);
 146
 147         if ( $variableline =~ /^\s*\%(\w+?)\s+(.*?)\s*$/ )
 148         {
 149             $key = $1;
 150             $value = $2;
 151
 152             if ( $key eq "PRODUCTNAME" )
 153             {
 154                 my $newline = "\%LCPRODUCTNAME " . lc($value) . "\n";
 155                 push(@{$variablesref} ,$newline);
 156                 my $original = $value;
 157                 $value =~ s/\s*//g;
 158                 $newline = "\%ONEWORDPRODUCTNAME " . $value . "\n";
 159                 push(@{$variablesref} ,$newline);
 160                 $newline = "\%LCONEWORDPRODUCTNAME " . lc($value) . "\n";
 161                 push(@{$variablesref} ,$newline);
 162                 $value = $original;
 163                 $value =~ s/\s*$//g;
 164                 $value =~ s/^\s*//g;
 165                 $value =~ s/ /\%20/g;
 166                 $newline = "\%MASKEDPRODUCTNAME " . $value . "\n";
 167                 push(@{$variablesref} ,$newline);
 168                 $value = $original;
 169                 $value =~ s/\s/\_/g;
 170                 $newline = "\%UNIXPRODUCTNAME " . lc($value) . "\n";
 171                 push(@{$variablesref} ,$newline);
 172                 $newline = "\%SYSTEMINTUNIXPACKAGENAME " . lc($value) . "\n";
 173                 push(@{$variablesref} ,$newline);
 174                 $newline = "\%UNIXPACKAGENAME " . lc($value) . "\n";
 175                 push(@{$variablesref} ,$newline);
 176                 $value = $original;
 177                 $value =~ s/\s/\_/g;
 178                 $value =~ s/\.//g;
 179                 $newline = "\%WITHOUTDOTUNIXPRODUCTNAME " . lc($value) . "\n";
 180                 push(@{$variablesref} ,$newline);
 181                 $newline = "\%WITHOUTDOTUNIXPACKAGENAME " . lc($value) . "\n";
 182                 push(@{$variablesref} ,$newline);
 183                 $newline = "\%SOLARISBRANDPACKAGENAME " . lc($value) . "\n";
 184                 push(@{$variablesref} ,$newline);
 185                 $value = $original;
 186             }
 187             elsif  ( $key eq "PRODUCTEXTENSION" )
 188             {
 189                 my $newline = "\%LCPRODUCTEXTENSION " . lc($value) . "\n";
 190                 push(@{$variablesref} ,$newline);
 191             }
 192             elsif  ( $key eq "PRODUCTVERSION" )
 193             {
 194                 $value =~ s/\.//g;
 195                 my $newline = "\%WITHOUTDOTPRODUCTVERSION " . $value . "\n";
 196                 push(@{$variablesref} ,$newline);
 197             }
 198         }
 199     }
 200 }
 201
 202 ######################################################################
 203 # Resolving the new introduced lowercase script variables
 204 ######################################################################
 205
 206 sub resolve_lowercase_productname_setupscriptvariable
 207 {
 208     my ( $variablesref ) = @_;
 209
 210     my %variables = ();
 211
 212     # First step: Collecting variables
 213
 214     for ( my $j = 0; $j <= $#{$variablesref}; $j++ )
 215     {
 216         my $variableline = ${$variablesref}[$j];
 217
 218         my ($key, $value);
 219
 220         if ( $variableline =~ /^\s*\%(\w+?)\s+(.*?)\s*$/ )
 221         {
 222             $key = $1;
 223             $value = $2;
 224             $variables{$key} = $value;
 225         }
 226     }
 227
 228     # Second step: Resolving variables
 229
 230     for ( my $j = 0; $j <= $#{$variablesref}; $j++ )
 231     {
 232         if ( ${$variablesref}[$j] =~ /\$\{(.*?)\}/ )
 233         {
 234             my $key = $1;
 235             ${$variablesref}[$j] =~ s/\$\{\Q$key\E\}/$variables{$key}/g;
 236         }
 237     }
 238
 239 }
 240
 241 ######################################################################
 242 # Replacing all setup script variables inside the setup script file
 243 ######################################################################
 244
 245 sub replace_all_setupscriptvariables_in_script
 246 {
 247     my ( $scriptref, $variablesref ) = @_;
 248
 249     globallog("Replacing variables in setup script (start)");
 250
 251     # make hash of variables to be substituted if they appear in the script
 252     my %subs;
 253     for ( my $j = 0; $j <= $#{$variablesref}; $j++ )
 254     {
 255         my $variableline = ${$variablesref}[$j];
 256
 257         if ( $variableline =~ /^\s*(\%\w+?)\s+(.*?)\s*$/ )
 258         {
 259             $subs{$1}= $2;
 260         }
 261     }
 262
 263     # This is far faster than running a regexp for each line
 264     my $bigstring = '';
 265     for my $line (@{$scriptref}) { $bigstring = $bigstring . $line; }
 266
 267     foreach my $key (sort { length ($b) <=> length ($a) } keys %subs)
 268     {
 269         # Attention: It must be possible to substitute "%PRODUCTNAMEn", "%PRODUCTNAME%PRODUCTVERSIONabc"
 270         my $value = $subs{$key};
 271         $bigstring =~ s/$key/$value/g;
 272     }
 273
 274     my @newlines = split /\n/, $bigstring;
 275     $scriptref = \@newlines;
 276
 277     # now check for any mis-named '%' variables that we have left
 278     my $num = 0;
 279     for my $check (@newlines)
 280     {
 281         $num++;
 282         if ( $check =~ /^.*\%\w+.*$/ )
 283         {
 284             if (( $check =~ /%1/ ) || ( $check =~ /%2/ ) || ( $check =~ /%verify/ )) { next; }
 285             my $infoline = "WARNING: mis-named or un-known '%' variable in setup script at line $num:\n$check\n";
 286             push( @installer::globals::globallogfileinfo, $infoline);
 287         }
 288     }
 289
 290     globallog("Replacing variables in setup script (end)");
 291
 292     return $scriptref;
 293 }
 294
 295 #######################################################################
 296 # Collecting all items of the type "searchitem" from the setup script
 297 #######################################################################
 298
 299 sub get_all_items_from_script
 300 {
 301     my ($scriptref, $searchitem) = @_;
 302
 303     my @allitemarray = ();
 304
 305     my ($itemkey, $itemvalue);
 306
 307     for ( my $i = 0; $i <= $#{$scriptref}; $i++ )
 308     {
 309         my $line = ${$scriptref}[$i];
 310
 311         next unless ($line =~ /^\s*\Q$searchitem\E\s+(\S+)\s*$/);
 312         my $gid = $1;
 313
 314         my %oneitemhash = ();
 315         my $ismultilang = 0;
 316
 317         $oneitemhash{'gid'} = $gid;
 318
 319         while (!( $line =~ /^\s*End\s*$/ ))
 320         {
 321             if ( $i >= $#{$scriptref} ) {
 322                 installer::exiter::exit_program("Invalid setup script file. End of file reached before 'End' line of '$searchitem' section.", "get_all_items_from_script");
 323             }
 324             $line = ${$scriptref}[++$i];
 325
 326             if ( $line =~ /^\s*(.+?)\=\s*(.+?)\;\s*$/ ) # only oneliner!
 327             {
 328                 $itemkey = $1;
 329                 $itemvalue = $2;
 330
 331                 $itemkey =~ s/\s+$//;
 332                 $itemvalue =~ s/\s+$//;
 333
 334                 installer::remover::remove_leading_and_ending_quotationmarks(\$itemvalue);
 335
 336                 $oneitemhash{$itemkey} = $itemvalue;
 337
 338                 $ismultilang ||= $itemkey =~ /^\S+\s+\(\S+\)$/;
 339             }
 340             elsif (($searchitem eq "Module") &&
 341                    ($line =~ /^\s*.+?\s*\=\s*\(/) &&
 342                    (!($line =~ /\)\;\s*$/)))    # more than one line, for instance files at modules!
 343             {
 344                 $line =~ /^\s*(.+?)\s*\=\s*(.+?)\s*$/;  # the first line
 345                 $itemkey = $1;
 346                 $itemvalue = $2;
 347
 348                 # collecting the complete itemvalue
 349                 do
 350                 {
 351                     if ( $i >= $#{$scriptref} ) {
 352                         installer::exiter::exit_program("Invalid setup script file. Premature end of file.", "get_all_items_from_script");
 353                     }
 354                     $line = ${$scriptref}[++$i];
 355                     installer::remover::remove_leading_and_ending_whitespaces(\$line);
 356                     $itemvalue .= $line;
 357                 } while (!($line =~ /\)\;\s*$/));
 358
 359                 # removing ending ";"
 360                 $itemvalue =~ s/\;\s*$//;
 361
 362                 $oneitemhash{$itemkey} = $itemvalue;
 363
 364                 $ismultilang ||= $itemkey =~ /^\S+\s+\(\S+\)$/;
 365             }
 366         }
 367
 368         $oneitemhash{'ismultilingual'} = $ismultilang+0;
 369
 370         push(@allitemarray, \%oneitemhash);
 371     }
 372
 373     return \@allitemarray;
 374 }
 375
 376 ######################################################################
 377 # Collecting all folder at folderitems, that are predefined values
 378 # For example: PREDEFINED_AUTOSTART
 379 ######################################################################
 380
 381 sub add_predefined_folder
 382 {
 383     my ( $folderitemref, $folderref ) = @_;
 384
 385     for my $folderid ( map { $_->{FolderID} } @{$folderitemref} ) {
 386         # FIXME: Anchor to start of line?
 387         next unless ( $folderid =~ /PREDEFINED_/ );
 388         next if grep { $_->{gid} eq $folderid } @{$folderref};
 389
 390         push @{$folderref}, {
 391             ismultilingual => 0,
 392             Name => "",
 393             gid => $folderid,
 394         };
 395     }
 396 }
 397
 398 #####################################################################################
 399 # If folderitems are non-advertised, the component needs to have a registry key
 400 # below HKCU as key path. Therefore it is required, to mark the file belonging
 401 # to a non-advertised shortcut, that a special userreg_xxx registry key can be
 402 # created during packing process.
 403 #####################################################################################
 404
 405 sub prepare_non_advertised_files
 406 {
 407     my ( $folderitemref, $filesref ) = @_;
 408
 409     for ( my $i = 0; $i <= $#{$folderitemref}; $i++ )
 410     {
 411         my $folderitem = ${$folderitemref}[$i];
 412         my $styles = "";
 413         if ( $folderitem->{'Styles'} ) { $styles = $folderitem->{'Styles'}; }
 414
 415         if ( $styles =~ /\bNON_ADVERTISED\b/ )
 416         {
 417             my $fileid = $folderitem->{'FileID'};
 418             if ( $folderitem->{'ComponentIDFile'} ) { $fileid = $folderitem->{'ComponentIDFile'}; }
 419             my $onefile = installer::worker::find_file_by_id($filesref, $fileid);
 420
 421             # Attention: If $onefile with "FileID" is not found, this is not always an error.
 422             # FileID can also contain an executable file, for example msiexec.exe.
 423             if ( $onefile ne "" ) { $onefile->{'needs_user_registry_key'} = 1; }
 424         }
 425     }
 426 }
 427
 428 #####################################################################################
 429 # Adding all variables defined in the installation object into the hash
 430 # of all variables from the zip list file.
 431 # This is needed if variables are defined in the installation object,
 432 # but not in the zip list file.
 433 # If there is a definition in the zip list file and in the installation
 434 # object, the installation object is more important
 435 #####################################################################################
 436
 437 sub add_installationobject_to_variables
 438 {
 439     my ($allvariables, $allscriptvariablesref) = @_;
 440
 441     for ( my $i = 0; $i <= $#{$allscriptvariablesref}; $i++ )
 442     {
 443         my $line = ${$allscriptvariablesref}[$i];
 444
 445         if ( $line =~ /^\s*\%(\w+)\s+(.*?)\s*$/ )
 446         {
 447             my $key = $1;
 448             my $value = $2;
 449
 450             $allvariables->{$key} = $value; # overwrite existing values from zip.lst
 451         }
 452     }
 453 }
 454
 455 #####################################################################################
 456 # Some properties are created automatically. It should be possible to
 457 # overwrite them, with PRESET properties. For example UNIXPRODUCTNAME
 458 # with PRESETUNIXPRODUCTNAME, if this is defined and the automatic process
 459 # does not deliver the desired results.
 460 #####################################################################################
 461
 462 sub replace_preset_properties
 463 {
 464     my ($allvariables) = @_;
 465
 466     # SOLARISBRANDPACKAGENAME
 467     # needs to be replaced by
 468     # PRESETSOLARISBRANDPACKAGENAME
 469
 470     my @presetproperties = ();
 471     push(@presetproperties, "SOLARISBRANDPACKAGENAME");
 472     push(@presetproperties, "SYSTEMINTUNIXPACKAGENAME");
 473
 474
 475     foreach $property ( @presetproperties )
 476     {
 477         my $presetproperty = "PRESET" . $property;
 478         if (( exists($allvariables->{$presetproperty}) ) && ( $allvariables->{$presetproperty} ne "" ))
 479         {
 480             $allvariables->{$property} = $allvariables->{$presetproperty};
 481         }
 482     }
 483 }
 484
 485 1;