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