19780544fSAndrew Rist#************************************************************** 29780544fSAndrew Rist# 39780544fSAndrew Rist# Licensed to the Apache Software Foundation (ASF) under one 49780544fSAndrew Rist# or more contributor license agreements. See the NOTICE file 59780544fSAndrew Rist# distributed with this work for additional information 69780544fSAndrew Rist# regarding copyright ownership. The ASF licenses this file 79780544fSAndrew Rist# to you under the Apache License, Version 2.0 (the 89780544fSAndrew Rist# "License"); you may not use this file except in compliance 99780544fSAndrew Rist# with the License. You may obtain a copy of the License at 109780544fSAndrew Rist# 119780544fSAndrew Rist# http://www.apache.org/licenses/LICENSE-2.0 129780544fSAndrew Rist# 139780544fSAndrew Rist# Unless required by applicable law or agreed to in writing, 149780544fSAndrew Rist# software distributed under the License is distributed on an 159780544fSAndrew Rist# "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY 169780544fSAndrew Rist# KIND, either express or implied. See the License for the 179780544fSAndrew Rist# specific language governing permissions and limitations 189780544fSAndrew Rist# under the License. 199780544fSAndrew Rist# 209780544fSAndrew Rist#************************************************************** 219780544fSAndrew Rist 229780544fSAndrew Rist 23cdf0e10cSrcweir 24cdf0e10cSrcweirpackage installer::windows::file; 25cdf0e10cSrcweir 26cdf0e10cSrcweiruse Digest::MD5; 27cdf0e10cSrcweiruse installer::existence; 28cdf0e10cSrcweiruse installer::exiter; 29cdf0e10cSrcweiruse installer::files; 30cdf0e10cSrcweiruse installer::globals; 31cdf0e10cSrcweiruse installer::logger; 32cdf0e10cSrcweiruse installer::pathanalyzer; 33cdf0e10cSrcweiruse installer::worker; 34cdf0e10cSrcweiruse installer::windows::font; 35cdf0e10cSrcweiruse installer::windows::idtglobal; 3619d58b3aSEike Rathkeuse installer::windows::msiglobal; 37cdf0e10cSrcweiruse installer::windows::language; 38*9f91b7e3SAndre Fischeruse installer::patch::InstallationSet; 39*9f91b7e3SAndre Fischeruse installer::patch::FileSequenceList; 40*9f91b7e3SAndre Fischeruse File::Basename; 41*9f91b7e3SAndre Fischeruse File::Spec; 42*9f91b7e3SAndre Fischeruse strict; 43cdf0e10cSrcweir 44cdf0e10cSrcweir########################################################################## 45cdf0e10cSrcweir# Assigning one cabinet file to each file. This is requrired, 46cdf0e10cSrcweir# if cabinet files shall be equivalent to packages. 47cdf0e10cSrcweir########################################################################## 48cdf0e10cSrcweir 49cdf0e10cSrcweirsub assign_cab_to_files 50cdf0e10cSrcweir{ 51cdf0e10cSrcweir my ( $filesref ) = @_; 52cdf0e10cSrcweir 53cdf0e10cSrcweir my $infoline = ""; 54cdf0e10cSrcweir 551ba1fd99SAndre Fischer foreach my $file (@$filesref) 56cdf0e10cSrcweir { 571ba1fd99SAndre Fischer if ( ! exists($file->{'modules'}) ) 581ba1fd99SAndre Fischer { 591ba1fd99SAndre Fischer installer::exiter::exit_program( 601ba1fd99SAndre Fischer sprintf("ERROR: No module assignment found for %s", $file->{'gid'}), 611ba1fd99SAndre Fischer "assign_cab_to_files"); 621ba1fd99SAndre Fischer } 631ba1fd99SAndre Fischer my $module = $file->{'modules'}; 64cdf0e10cSrcweir # If modules contains a list of modules, only taking the first one. 65cdf0e10cSrcweir if ( $module =~ /^\s*(.*?)\,/ ) { $module = $1; } 66cdf0e10cSrcweir 671ba1fd99SAndre Fischer if ( ! exists($installer::globals::allcabinetassigns{$module}) ) 681ba1fd99SAndre Fischer { 691ba1fd99SAndre Fischer installer::exiter::exit_program( 701ba1fd99SAndre Fischer sprintf("ERROR: No cabinet file assigned to module \"%s\" %s", 711ba1fd99SAndre Fischer $module, 721ba1fd99SAndre Fischer $file->{'gid'}), 731ba1fd99SAndre Fischer "assign_cab_to_files"); 741ba1fd99SAndre Fischer } 751ba1fd99SAndre Fischer $file->{'assignedcabinetfile'} = $installer::globals::allcabinetassigns{$module}; 76cdf0e10cSrcweir 77cdf0e10cSrcweir # Counting the files in each cabinet file 781ba1fd99SAndre Fischer if ( ! exists($installer::globals::cabfilecounter{$file->{'assignedcabinetfile'}}) ) 79cdf0e10cSrcweir { 801ba1fd99SAndre Fischer $installer::globals::cabfilecounter{$file->{'assignedcabinetfile'}} = 1; 81cdf0e10cSrcweir } 82cdf0e10cSrcweir else 83cdf0e10cSrcweir { 841ba1fd99SAndre Fischer $installer::globals::cabfilecounter{$file->{'assignedcabinetfile'}}++; 85cdf0e10cSrcweir } 86cdf0e10cSrcweir } 87cdf0e10cSrcweir 88cdf0e10cSrcweir # assigning startsequencenumbers for each cab file 891ba1fd99SAndre Fischer 901ba1fd99SAndre Fischer my %count = (); 91cdf0e10cSrcweir my $offset = 1; 921ba1fd99SAndre Fischer foreach my $cabfile ( sort keys %installer::globals::cabfilecounter ) 93cdf0e10cSrcweir { 94cdf0e10cSrcweir my $filecount = $installer::globals::cabfilecounter{$cabfile}; 951ba1fd99SAndre Fischer $count{$cabfile} = $filecount; 96cdf0e10cSrcweir $installer::globals::cabfilecounter{$cabfile} = $offset; 97cdf0e10cSrcweir $offset = $offset + $filecount; 98cdf0e10cSrcweir 99cdf0e10cSrcweir $installer::globals::lastsequence{$cabfile} = $offset - 1; 100cdf0e10cSrcweir } 101cdf0e10cSrcweir 1021ba1fd99SAndre Fischer # logging the number of files in each cabinet file 103cdf0e10cSrcweir 104b274bc22SAndre Fischer $installer::logger::Lang->print("\n"); 1051ba1fd99SAndre Fischer $installer::logger::Lang->print("Cabinet files:\n"); 1061ba1fd99SAndre Fischer foreach my $cabfile (sort keys %installer::globals::cabfilecounter) 107cdf0e10cSrcweir { 1081ba1fd99SAndre Fischer $installer::logger::Lang->printf( 1091ba1fd99SAndre Fischer "%-30s : %4s files, from %4d to %4d\n", 1101ba1fd99SAndre Fischer $cabfile, 1111ba1fd99SAndre Fischer $count{$cabfile}, 1121ba1fd99SAndre Fischer $installer::globals::cabfilecounter{$cabfile}, 1131ba1fd99SAndre Fischer $installer::globals::lastsequence{$cabfile}); 114cdf0e10cSrcweir } 115cdf0e10cSrcweir} 116cdf0e10cSrcweir 117cdf0e10cSrcweir########################################################################## 118cdf0e10cSrcweir# Assigning sequencenumbers to files. This is requrired, 119cdf0e10cSrcweir# if cabinet files shall be equivalent to packages. 120cdf0e10cSrcweir########################################################################## 121cdf0e10cSrcweir 122cdf0e10cSrcweirsub assign_sequencenumbers_to_files 123cdf0e10cSrcweir{ 124cdf0e10cSrcweir my ( $filesref ) = @_; 125cdf0e10cSrcweir 126cdf0e10cSrcweir my %directaccess = (); 127cdf0e10cSrcweir my %allassigns = (); 1281ba1fd99SAndre Fischer 129cdf0e10cSrcweir for ( my $i = 0; $i <= $#{$filesref}; $i++ ) 130cdf0e10cSrcweir { 131cdf0e10cSrcweir my $onefile = ${$filesref}[$i]; 132cdf0e10cSrcweir 133cdf0e10cSrcweir # Keeping order in cabinet files 134cdf0e10cSrcweir # -> collecting all files in one cabinet file 135cdf0e10cSrcweir # -> sorting files and assigning numbers 136cdf0e10cSrcweir 137cdf0e10cSrcweir # Saving counter $i for direct access into files array 138cdf0e10cSrcweir # "destination" of the file is a unique identifier ('Name' is not unique!) 139cdf0e10cSrcweir if ( exists($directaccess{$onefile->{'destination'}}) ) { installer::exiter::exit_program("ERROR: 'destination' at file not unique: $onefile->{'destination'}", "assign_sequencenumbers_to_files"); } 140cdf0e10cSrcweir $directaccess{$onefile->{'destination'}} = $i; 141cdf0e10cSrcweir 142cdf0e10cSrcweir my $cabfilename = $onefile->{'assignedcabinetfile'}; 143cdf0e10cSrcweir # collecting files in cabinet files 144cdf0e10cSrcweir if ( ! exists($allassigns{$cabfilename}) ) 145cdf0e10cSrcweir { 146cdf0e10cSrcweir my %onecabfile = (); 147cdf0e10cSrcweir $onecabfile{$onefile->{'destination'}} = 1; 148cdf0e10cSrcweir $allassigns{$cabfilename} = \%onecabfile; 149cdf0e10cSrcweir } 150cdf0e10cSrcweir else 151cdf0e10cSrcweir { 152cdf0e10cSrcweir $allassigns{$cabfilename}->{$onefile->{'destination'}} = 1; 153cdf0e10cSrcweir } 154cdf0e10cSrcweir } 155cdf0e10cSrcweir 156cdf0e10cSrcweir # Sorting each hash and assigning numbers 157cdf0e10cSrcweir # The destination of the file determines the sort order, not the filename! 158cdf0e10cSrcweir my $cabfile; 159cdf0e10cSrcweir foreach $cabfile ( sort keys %allassigns ) 160cdf0e10cSrcweir { 161cdf0e10cSrcweir my $counter = $installer::globals::cabfilecounter{$cabfile}; 162cdf0e10cSrcweir my $dest; 163cdf0e10cSrcweir foreach $dest ( sort keys %{$allassigns{$cabfile}} ) # <- sorting the destination! 164cdf0e10cSrcweir { 165cdf0e10cSrcweir my $directaccessnumber = $directaccess{$dest}; 1661ba1fd99SAndre Fischer ${$filesref}[$directaccessnumber]->{'assignedsequencenumber'} = $counter; 167cdf0e10cSrcweir $counter++; 168cdf0e10cSrcweir } 169cdf0e10cSrcweir } 170cdf0e10cSrcweir} 171cdf0e10cSrcweir 172cdf0e10cSrcweir######################################################### 173cdf0e10cSrcweir# Create a shorter version of a long component name, 174cdf0e10cSrcweir# because maximum length in msi database is 72. 175cdf0e10cSrcweir# Attention: In multi msi installation sets, the short 176cdf0e10cSrcweir# names have to be unique over all packages, because 177cdf0e10cSrcweir# this string is used to create the globally unique id 178cdf0e10cSrcweir# -> no resetting of 179cdf0e10cSrcweir# %installer::globals::allshortcomponents 180cdf0e10cSrcweir# after a package was created. 18119d58b3aSEike Rathke# Using no counter because of reproducibility. 182cdf0e10cSrcweir######################################################### 183cdf0e10cSrcweir 184cdf0e10cSrcweirsub generate_new_short_componentname 185cdf0e10cSrcweir{ 186cdf0e10cSrcweir my ($componentname) = @_; 187cdf0e10cSrcweir 188cdf0e10cSrcweir my $startversion = substr($componentname, 0, 60); # taking only the first 60 characters 18919d58b3aSEike Rathke my $subid = installer::windows::msiglobal::calculate_id($componentname, 9); # taking only the first 9 digits 19019d58b3aSEike Rathke my $shortcomponentname = $startversion . "_" . $subid; 191cdf0e10cSrcweir 19219d58b3aSEike Rathke if ( exists($installer::globals::allshortcomponents{$shortcomponentname}) ) { installer::exiter::exit_program("Failed to create unique component name: \"$shortcomponentname\"", "generate_new_short_componentname"); } 193cdf0e10cSrcweir 194cdf0e10cSrcweir $installer::globals::allshortcomponents{$shortcomponentname} = 1; 195cdf0e10cSrcweir 196cdf0e10cSrcweir return $shortcomponentname; 197cdf0e10cSrcweir} 198cdf0e10cSrcweir 199cdf0e10cSrcweir############################################### 200cdf0e10cSrcweir# Generating the component name from a file 201cdf0e10cSrcweir############################################### 202cdf0e10cSrcweir 203cdf0e10cSrcweirsub get_file_component_name 204cdf0e10cSrcweir{ 205cdf0e10cSrcweir my ($fileref, $filesref) = @_; 206cdf0e10cSrcweir 207cdf0e10cSrcweir my $componentname = ""; 208cdf0e10cSrcweir 209cdf0e10cSrcweir # Special handling for files with ASSIGNCOMPOMENT 210cdf0e10cSrcweir 211cdf0e10cSrcweir my $styles = ""; 212cdf0e10cSrcweir if ( $fileref->{'Styles'} ) { $styles = $fileref->{'Styles'}; } 213cdf0e10cSrcweir if ( $styles =~ /\bASSIGNCOMPOMENT\b/ ) 214cdf0e10cSrcweir { 215cdf0e10cSrcweir $componentname = get_component_from_assigned_file($fileref->{'AssignComponent'}, $filesref); 216cdf0e10cSrcweir } 217cdf0e10cSrcweir else 218cdf0e10cSrcweir { 219cdf0e10cSrcweir # In this function exists the rule to create components from files 220cdf0e10cSrcweir # Rule: 221cdf0e10cSrcweir # Two files get the same componentid, if: 222cdf0e10cSrcweir # both have the same destination directory. 223cdf0e10cSrcweir # both have the same "gid" -> both were packed in the same zip file 224cdf0e10cSrcweir # All other files are included into different components! 225cdf0e10cSrcweir 226cdf0e10cSrcweir # my $componentname = $fileref->{'gid'} . "_" . $fileref->{'Dir'}; 227cdf0e10cSrcweir 228cdf0e10cSrcweir # $fileref->{'Dir'} is not sufficient! All files in a zip file have the same $fileref->{'Dir'}, 229cdf0e10cSrcweir # but can be in different subdirectories. 230cdf0e10cSrcweir # Solution: destination=share\Scripts\beanshell\Capitalise\capitalise.bsh 231cdf0e10cSrcweir # in which the filename (capitalise.bsh) has to be removed and all backslashes (slashes) are 232cdf0e10cSrcweir # converted into underline. 233cdf0e10cSrcweir 234cdf0e10cSrcweir my $destination = $fileref->{'destination'}; 235cdf0e10cSrcweir installer::pathanalyzer::get_path_from_fullqualifiedname(\$destination); 236cdf0e10cSrcweir $destination =~ s/\s//g; 237cdf0e10cSrcweir $destination =~ s/\\/\_/g; 238cdf0e10cSrcweir $destination =~ s/\//\_/g; 239cdf0e10cSrcweir $destination =~ s/\_\s*$//g; # removing ending underline 240cdf0e10cSrcweir 241cdf0e10cSrcweir $componentname = $fileref->{'gid'} . "__" . $destination; 242cdf0e10cSrcweir 243cdf0e10cSrcweir # Files with different languages, need to be packed into different components. 244cdf0e10cSrcweir # Then the installation of the language specific component is determined by a language condition. 245cdf0e10cSrcweir 246cdf0e10cSrcweir if ( $fileref->{'ismultilingual'} ) 247cdf0e10cSrcweir { 248cdf0e10cSrcweir my $officelanguage = $fileref->{'specificlanguage'}; 249cdf0e10cSrcweir $componentname = $componentname . "_" . $officelanguage; 250cdf0e10cSrcweir } 251cdf0e10cSrcweir 252cdf0e10cSrcweir $componentname = lc($componentname); # componentnames always lowercase 253cdf0e10cSrcweir 254cdf0e10cSrcweir $componentname =~ s/\-/\_/g; # converting "-" to "_" 255cdf0e10cSrcweir $componentname =~ s/\./\_/g; # converting "-" to "_" 256cdf0e10cSrcweir 257cdf0e10cSrcweir # Attention: Maximum length for the componentname is 72 258cdf0e10cSrcweir # %installer::globals::allcomponents_in_this_database : resetted for each database 259cdf0e10cSrcweir # %installer::globals::allcomponents : not resetted for each database 260cdf0e10cSrcweir # Component strings must be unique for the complete product, because they are used for 261cdf0e10cSrcweir # the creation of the globally unique identifier. 262cdf0e10cSrcweir 263cdf0e10cSrcweir my $fullname = $componentname; # This can be longer than 72 264cdf0e10cSrcweir 265cdf0e10cSrcweir if (( exists($installer::globals::allcomponents{$fullname}) ) && ( ! exists($installer::globals::allcomponents_in_this_database{$fullname}) )) 266cdf0e10cSrcweir { 267cdf0e10cSrcweir # This is not allowed: One component cannot be installed with different packages. 268cdf0e10cSrcweir installer::exiter::exit_program("ERROR: Component \"$fullname\" is already included into another package. This is not allowed.", "get_file_component_name"); 269cdf0e10cSrcweir } 270cdf0e10cSrcweir 271cdf0e10cSrcweir if ( exists($installer::globals::allcomponents{$fullname}) ) 272cdf0e10cSrcweir { 273cdf0e10cSrcweir $componentname = $installer::globals::allcomponents{$fullname}; 274cdf0e10cSrcweir } 275cdf0e10cSrcweir else 276cdf0e10cSrcweir { 27719d58b3aSEike Rathke if ( length($componentname) > 70 ) 278cdf0e10cSrcweir { 279cdf0e10cSrcweir $componentname = generate_new_short_componentname($componentname); # This has to be unique for the complete product, not only one package 280cdf0e10cSrcweir } 281cdf0e10cSrcweir 282cdf0e10cSrcweir $installer::globals::allcomponents{$fullname} = $componentname; 283cdf0e10cSrcweir $installer::globals::allcomponents_in_this_database{$fullname} = 1; 284cdf0e10cSrcweir } 285cdf0e10cSrcweir 286cdf0e10cSrcweir # $componentname =~ s/gid_file_/g_f_/g; 287cdf0e10cSrcweir # $componentname =~ s/_extra_/_e_/g; 288cdf0e10cSrcweir # $componentname =~ s/_config_/_c_/g; 289cdf0e10cSrcweir # $componentname =~ s/_org_openoffice_/_o_o_/g; 290cdf0e10cSrcweir # $componentname =~ s/_program_/_p_/g; 291cdf0e10cSrcweir # $componentname =~ s/_typedetection_/_td_/g; 292cdf0e10cSrcweir # $componentname =~ s/_linguistic_/_l_/g; 293cdf0e10cSrcweir # $componentname =~ s/_module_/_m_/g; 294cdf0e10cSrcweir # $componentname =~ s/_optional_/_opt_/g; 295cdf0e10cSrcweir # $componentname =~ s/_packages/_pack/g; 296cdf0e10cSrcweir # $componentname =~ s/_menubar/_mb/g; 297cdf0e10cSrcweir # $componentname =~ s/_common_/_cm_/g; 298cdf0e10cSrcweir # $componentname =~ s/_export_/_exp_/g; 299cdf0e10cSrcweir # $componentname =~ s/_table_/_tb_/g; 300cdf0e10cSrcweir # $componentname =~ s/_sofficecfg_/_sc_/g; 301cdf0e10cSrcweir # $componentname =~ s/_soffice_cfg_/_sc_/g; 302cdf0e10cSrcweir # $componentname =~ s/_startmodulecommands_/_smc_/g; 303cdf0e10cSrcweir # $componentname =~ s/_drawimpresscommands_/_dic_/g; 304cdf0e10cSrcweir # $componentname =~ s/_basiccommands_/_bac_/g; 305cdf0e10cSrcweir # $componentname =~ s/_basicidecommands_/_baic_/g; 306cdf0e10cSrcweir # $componentname =~ s/_genericcommands_/_genc_/g; 307cdf0e10cSrcweir # $componentname =~ s/_bibliographycommands_/_bibc_/g; 308cdf0e10cSrcweir # $componentname =~ s/_gentiumbookbasicbolditalic_/_gbbbi_/g; 309cdf0e10cSrcweir # $componentname =~ s/_share_/_s_/g; 310cdf0e10cSrcweir # $componentname =~ s/_extension_/_ext_/g; 311cdf0e10cSrcweir # $componentname =~ s/_extensions_/_exs_/g; 312cdf0e10cSrcweir # $componentname =~ s/_modules_/_ms_/g; 313cdf0e10cSrcweir # $componentname =~ s/_uiconfig_zip_/_ucz_/g; 314cdf0e10cSrcweir # $componentname =~ s/_productivity_/_pr_/g; 315cdf0e10cSrcweir # $componentname =~ s/_wizard_/_wz_/g; 316cdf0e10cSrcweir # $componentname =~ s/_import_/_im_/g; 317cdf0e10cSrcweir # $componentname =~ s/_javascript_/_js_/g; 318cdf0e10cSrcweir # $componentname =~ s/_template_/_tpl_/g; 319cdf0e10cSrcweir # $componentname =~ s/_tplwizletter_/_twl_/g; 320cdf0e10cSrcweir # $componentname =~ s/_beanshell_/_bs_/g; 321cdf0e10cSrcweir # $componentname =~ s/_presentation_/_bs_/g; 322cdf0e10cSrcweir # $componentname =~ s/_columns_/_cls_/g; 323cdf0e10cSrcweir # $componentname =~ s/_python_/_py_/g; 324cdf0e10cSrcweir 325cdf0e10cSrcweir # $componentname =~ s/_tools/_ts/g; 326cdf0e10cSrcweir # $componentname =~ s/_transitions/_trs/g; 327cdf0e10cSrcweir # $componentname =~ s/_scriptbinding/_scrb/g; 328cdf0e10cSrcweir # $componentname =~ s/_spreadsheet/_ssh/g; 329cdf0e10cSrcweir # $componentname =~ s/_publisher/_pub/g; 330cdf0e10cSrcweir # $componentname =~ s/_presenter/_pre/g; 331cdf0e10cSrcweir # $componentname =~ s/_registry/_reg/g; 332cdf0e10cSrcweir 333cdf0e10cSrcweir # $componentname =~ s/screen/sc/g; 334cdf0e10cSrcweir # $componentname =~ s/wordml/wm/g; 335cdf0e10cSrcweir # $componentname =~ s/openoffice/oo/g; 336cdf0e10cSrcweir } 337cdf0e10cSrcweir 338cdf0e10cSrcweir return $componentname; 339cdf0e10cSrcweir} 340cdf0e10cSrcweir 341cdf0e10cSrcweir#################################################################### 342cdf0e10cSrcweir# Returning the component name for a defined file gid. 343cdf0e10cSrcweir# This is necessary for files with flag ASSIGNCOMPOMENT 344cdf0e10cSrcweir#################################################################### 345cdf0e10cSrcweir 346cdf0e10cSrcweirsub get_component_from_assigned_file 347cdf0e10cSrcweir{ 348cdf0e10cSrcweir my ($gid, $filesref) = @_; 349cdf0e10cSrcweir 350cdf0e10cSrcweir my $onefile = installer::existence::get_specified_file($filesref, $gid); 351cdf0e10cSrcweir my $componentname = ""; 352cdf0e10cSrcweir if ( $onefile->{'componentname'} ) { $componentname = $onefile->{'componentname'}; } 353cdf0e10cSrcweir else { installer::exiter::exit_program("ERROR: No component defined for file: $gid", "get_component_from_assigned_file"); } 354cdf0e10cSrcweir 355cdf0e10cSrcweir return $componentname; 356cdf0e10cSrcweir} 357cdf0e10cSrcweir 358cdf0e10cSrcweir#################################################################### 359cdf0e10cSrcweir# Generating the special filename for the database file File.idt 360cdf0e10cSrcweir# Sample: CONTEXTS, CONTEXTS1 361cdf0e10cSrcweir# This name has to be unique. 362cdf0e10cSrcweir# In most cases this is simply the filename. 363cdf0e10cSrcweir#################################################################### 364cdf0e10cSrcweir 365*9f91b7e3SAndre Fischersub generate_unique_filename_for_filetable ($) 366cdf0e10cSrcweir{ 367*9f91b7e3SAndre Fischer my ($oldname) = @_; 368cdf0e10cSrcweir 369cdf0e10cSrcweir # This new filename has to be saved into $fileref, because this is needed to find the source. 370cdf0e10cSrcweir # The filename sbasic.idx/OFFSETS is changed to OFFSETS, but OFFSETS is not unique. 371cdf0e10cSrcweir # In this procedure names like OFFSETS5 are produced. And exactly this string has to be added to 372cdf0e10cSrcweir # the array of all files. 373cdf0e10cSrcweir 374*9f91b7e3SAndre Fischer my $uniquefilename = $oldname; 375*9f91b7e3SAndre Fischer if ( ! defined $uniquefilename || $uniquefilename eq "") 376*9f91b7e3SAndre Fischer { 377*9f91b7e3SAndre Fischer installer::logger::PrintError("file name does not exist or is empty, can not create unique name for it."); 378*9f91b7e3SAndre Fischer die; 379*9f91b7e3SAndre Fischer return; 380*9f91b7e3SAndre Fischer } 381cdf0e10cSrcweir 3821ba1fd99SAndre Fischer # making /registry/schema/org/openoffice/VCL.xcs to VCL.xcs 3831ba1fd99SAndre Fischer installer::pathanalyzer::make_absolute_filename_to_relative_filename(\$uniquefilename); 384cdf0e10cSrcweir 385cdf0e10cSrcweir $uniquefilename =~ s/\-/\_/g; # no "-" allowed 386cdf0e10cSrcweir $uniquefilename =~ s/\@/\_/g; # no "@" allowed 387cdf0e10cSrcweir $uniquefilename =~ s/\$/\_/g; # no "$" allowed 388cdf0e10cSrcweir $uniquefilename =~ s/^\s*\./\_/g; # no "." at the beginning allowed allowed 389cdf0e10cSrcweir $uniquefilename =~ s/^\s*\d/\_d/g; # no number at the beginning allowed allowed (even file "0.gif", replacing to "_d.gif") 390cdf0e10cSrcweir $uniquefilename =~ s/org_openoffice_/ooo_/g; # shorten the unique file name 391cdf0e10cSrcweir 392cdf0e10cSrcweir my $lcuniquefilename = lc($uniquefilename); # only lowercase names 393cdf0e10cSrcweir 394cdf0e10cSrcweir my $newname = 0; 395cdf0e10cSrcweir 3961ba1fd99SAndre Fischer if ( ! exists($installer::globals::alllcuniquefilenames{$lcuniquefilename})) 397cdf0e10cSrcweir { 398cdf0e10cSrcweir $installer::globals::alluniquefilenames{$uniquefilename} = 1; 399cdf0e10cSrcweir $installer::globals::alllcuniquefilenames{$lcuniquefilename} = 1; 400cdf0e10cSrcweir $newname = 1; 401cdf0e10cSrcweir } 402cdf0e10cSrcweir 403cdf0e10cSrcweir if ( ! $newname ) 404cdf0e10cSrcweir { 405cdf0e10cSrcweir # adding a number until the name is really unique: OFFSETS, OFFSETS1, OFFSETS2, ... 406cdf0e10cSrcweir # But attention: Making "abc.xcu" to "abc1.xcu" 407cdf0e10cSrcweir 408cdf0e10cSrcweir my $uniquefilenamebase = $uniquefilename; 409cdf0e10cSrcweir 410*9f91b7e3SAndre Fischer my $counter = 0; 411cdf0e10cSrcweir do 412cdf0e10cSrcweir { 413cdf0e10cSrcweir $counter++; 414cdf0e10cSrcweir 415cdf0e10cSrcweir if ( $uniquefilenamebase =~ /\./ ) 416cdf0e10cSrcweir { 417cdf0e10cSrcweir $uniquefilename = $uniquefilenamebase; 418cdf0e10cSrcweir $uniquefilename =~ s/\./$counter\./; 419cdf0e10cSrcweir } 420cdf0e10cSrcweir else 421cdf0e10cSrcweir { 422cdf0e10cSrcweir $uniquefilename = $uniquefilenamebase . $counter; 423cdf0e10cSrcweir } 424cdf0e10cSrcweir 425cdf0e10cSrcweir $newname = 0; 426cdf0e10cSrcweir $lcuniquefilename = lc($uniquefilename); # only lowercase names 427cdf0e10cSrcweir 4281ba1fd99SAndre Fischer if ( ! exists($installer::globals::alllcuniquefilenames{$lcuniquefilename})) 429cdf0e10cSrcweir { 430cdf0e10cSrcweir $installer::globals::alluniquefilenames{$uniquefilename} = 1; 431cdf0e10cSrcweir $installer::globals::alllcuniquefilenames{$lcuniquefilename} = 1; 432cdf0e10cSrcweir $newname = 1; 433cdf0e10cSrcweir } 434cdf0e10cSrcweir } 435cdf0e10cSrcweir until ( $newname ) 436cdf0e10cSrcweir } 437cdf0e10cSrcweir 438cdf0e10cSrcweir return $uniquefilename; 439cdf0e10cSrcweir} 440cdf0e10cSrcweir 441cdf0e10cSrcweir#################################################################### 442cdf0e10cSrcweir# Generating the special file column for the database file File.idt 443cdf0e10cSrcweir# Sample: NAMETR~1.TAB|.nametranslation.table 444cdf0e10cSrcweir# The first part has to be 8.3 conform. 445cdf0e10cSrcweir#################################################################### 446cdf0e10cSrcweir 447dca4887fSAndre Fischersub generate_filename_for_filetable ($$) 448cdf0e10cSrcweir{ 449dca4887fSAndre Fischer my ($fileref, $shortnamesref) = @_; 450cdf0e10cSrcweir 451cdf0e10cSrcweir my $returnstring = ""; 452cdf0e10cSrcweir 453cdf0e10cSrcweir my $filename = $fileref->{'Name'}; 4541ba1fd99SAndre Fischer 4551ba1fd99SAndre Fischer # making /registry/schema/org/openoffice/VCL.xcs to VCL.xcs 4561ba1fd99SAndre Fischer installer::pathanalyzer::make_absolute_filename_to_relative_filename(\$filename); 457cdf0e10cSrcweir 4581ba1fd99SAndre Fischer my $shortstring = installer::windows::idtglobal::make_eight_three_conform_with_hash($filename, "file", $shortnamesref); 459cdf0e10cSrcweir 4601ba1fd99SAndre Fischer if ( $shortstring eq $filename ) 4611ba1fd99SAndre Fischer { 4621ba1fd99SAndre Fischer # nothing changed 4631ba1fd99SAndre Fischer $returnstring = $filename; 4641ba1fd99SAndre Fischer } 465cdf0e10cSrcweir else 4661ba1fd99SAndre Fischer { 4671ba1fd99SAndre Fischer $returnstring = $shortstring . "\|" . $filename; 4681ba1fd99SAndre Fischer } 469cdf0e10cSrcweir 470cdf0e10cSrcweir return $returnstring; 471cdf0e10cSrcweir} 472cdf0e10cSrcweir 473cdf0e10cSrcweir######################################### 474cdf0e10cSrcweir# Returning the filesize of a file 475cdf0e10cSrcweir######################################### 476cdf0e10cSrcweir 477cdf0e10cSrcweirsub get_filesize 478cdf0e10cSrcweir{ 479cdf0e10cSrcweir my ($fileref) = @_; 480cdf0e10cSrcweir 481cdf0e10cSrcweir my $file = $fileref->{'sourcepath'}; 482cdf0e10cSrcweir 483cdf0e10cSrcweir my $filesize; 484cdf0e10cSrcweir 485cdf0e10cSrcweir if ( -f $file ) # test of existence. For instance services.rdb does not always exist 486cdf0e10cSrcweir { 487cdf0e10cSrcweir $filesize = ( -s $file ); # file size can be "0" 488cdf0e10cSrcweir } 489cdf0e10cSrcweir else 490cdf0e10cSrcweir { 491cdf0e10cSrcweir $filesize = -1; 492cdf0e10cSrcweir } 493cdf0e10cSrcweir 494cdf0e10cSrcweir return $filesize; 495cdf0e10cSrcweir} 496cdf0e10cSrcweir 497cdf0e10cSrcweir############################################# 498cdf0e10cSrcweir# Returning the file version, if required 499cdf0e10cSrcweir# Sample: "8.0.1.8976"; 500cdf0e10cSrcweir############################################# 501cdf0e10cSrcweir 502cdf0e10cSrcweirsub get_fileversion 503cdf0e10cSrcweir{ 504*9f91b7e3SAndre Fischer my ($onefile, $allvariables) = @_; 505cdf0e10cSrcweir 506cdf0e10cSrcweir my $fileversion = ""; 507cdf0e10cSrcweir 508cdf0e10cSrcweir if ( $allvariables->{'USE_FILEVERSION'} ) 509cdf0e10cSrcweir { 5101ba1fd99SAndre Fischer if ( ! $allvariables->{'LIBRARYVERSION'} ) 5111ba1fd99SAndre Fischer { 5121ba1fd99SAndre Fischer installer::exiter::exit_program("ERROR: USE_FILEVERSION is set, but not LIBRARYVERSION", "get_fileversion"); 5131ba1fd99SAndre Fischer } 514cdf0e10cSrcweir my $libraryversion = $allvariables->{'LIBRARYVERSION'}; 515cdf0e10cSrcweir if ( $libraryversion =~ /^\s*(\d+)\.(\d+)\.(\d+)\s*$/ ) 516cdf0e10cSrcweir { 517cdf0e10cSrcweir my $major = $1; 518cdf0e10cSrcweir my $minor = $2; 519cdf0e10cSrcweir my $micro = $3; 520cdf0e10cSrcweir my $concat = 100 * $minor + $micro; 521cdf0e10cSrcweir $libraryversion = $major . "\." . $concat; 522cdf0e10cSrcweir } 523cdf0e10cSrcweir my $vendornumber = 0; 5241ba1fd99SAndre Fischer if ( $allvariables->{'VENDORPATCHVERSION'} ) 5251ba1fd99SAndre Fischer { 5261ba1fd99SAndre Fischer $vendornumber = $allvariables->{'VENDORPATCHVERSION'}; 5271ba1fd99SAndre Fischer } 528cdf0e10cSrcweir $fileversion = $libraryversion . "\." . $installer::globals::buildid . "\." . $vendornumber; 5291ba1fd99SAndre Fischer if ( $onefile->{'FileVersion'} ) 5301ba1fd99SAndre Fischer { 5311ba1fd99SAndre Fischer # overriding FileVersion in scp 5321ba1fd99SAndre Fischer $fileversion = $onefile->{'FileVersion'}; 5331ba1fd99SAndre Fischer } 534cdf0e10cSrcweir } 535cdf0e10cSrcweir 5361ba1fd99SAndre Fischer if ( $installer::globals::prepare_winpatch ) 5371ba1fd99SAndre Fischer { 5381ba1fd99SAndre Fischer # Windows patches do not allow this version # -> who says so? 5391ba1fd99SAndre Fischer $fileversion = ""; 5401ba1fd99SAndre Fischer } 541cdf0e10cSrcweir 542cdf0e10cSrcweir return $fileversion; 543cdf0e10cSrcweir} 544cdf0e10cSrcweir 545*9f91b7e3SAndre Fischer 546*9f91b7e3SAndre Fischer 547*9f91b7e3SAndre Fischer 548*9f91b7e3SAndre Fischersub retrieve_sequence_and_uniquename ($$) 549*9f91b7e3SAndre Fischer{ 550*9f91b7e3SAndre Fischer my ($file_list, $source_data) = @_; 551*9f91b7e3SAndre Fischer 552*9f91b7e3SAndre Fischer my @added_files = (); 553*9f91b7e3SAndre Fischer 554*9f91b7e3SAndre Fischer # Read the sequence numbers of the previous version. 555*9f91b7e3SAndre Fischer if ($installer::globals::is_release) 556*9f91b7e3SAndre Fischer { 557*9f91b7e3SAndre Fischer foreach my $file (@$file_list) 558*9f91b7e3SAndre Fischer { 559*9f91b7e3SAndre Fischer # Use the source path of the file as key to retrieve sequence number and unique name. 560*9f91b7e3SAndre Fischer # The source path is the part of the 'destination' without the first part. 561*9f91b7e3SAndre Fischer # There is a special case when 'Dir' is PREDEFINED_OSSHELLNEWDIR. 562*9f91b7e3SAndre Fischer my $source_path; 563*9f91b7e3SAndre Fischer if (defined $file->{'Dir'} && $file->{'Dir'} eq "PREDEFINED_OSSHELLNEWDIR") 564*9f91b7e3SAndre Fischer { 565*9f91b7e3SAndre Fischer $source_path = $installer::globals::templatefoldername 566*9f91b7e3SAndre Fischer . $installer::globals::separator 567*9f91b7e3SAndre Fischer . $file->{'Name'}; 568*9f91b7e3SAndre Fischer } 569*9f91b7e3SAndre Fischer else 570*9f91b7e3SAndre Fischer { 571*9f91b7e3SAndre Fischer $source_path = $file->{'destination'}; 572*9f91b7e3SAndre Fischer $source_path =~ s/^[^\/]+\///; 573*9f91b7e3SAndre Fischer } 574*9f91b7e3SAndre Fischer my ($sequence, $uniquename) = $source_data->get_sequence_and_unique_name($source_path); 575*9f91b7e3SAndre Fischer if (defined $sequence && defined $uniquename) 576*9f91b7e3SAndre Fischer { 577*9f91b7e3SAndre Fischer $file->{'sequencenumber'} = $sequence; 578*9f91b7e3SAndre Fischer $file->{'uniquename'} = $uniquename; 579*9f91b7e3SAndre Fischer } 580*9f91b7e3SAndre Fischer else 581*9f91b7e3SAndre Fischer { 582*9f91b7e3SAndre Fischer # No data found in the source release. File has been added. 583*9f91b7e3SAndre Fischer push @added_files, $file; 584*9f91b7e3SAndre Fischer } 585*9f91b7e3SAndre Fischer } 586*9f91b7e3SAndre Fischer } 587*9f91b7e3SAndre Fischer 588*9f91b7e3SAndre Fischer return @added_files; 589*9f91b7e3SAndre Fischer} 590*9f91b7e3SAndre Fischer 591*9f91b7e3SAndre Fischer 592*9f91b7e3SAndre Fischer 593*9f91b7e3SAndre Fischer 594*9f91b7e3SAndre Fischer=head2 assign_mssing_sequence_numbers ($file_list) 595*9f91b7e3SAndre Fischer 596*9f91b7e3SAndre Fischer Assign sequence numbers where still missing. 597*9f91b7e3SAndre Fischer 598*9f91b7e3SAndre Fischer When we are preparing a patch then all files that have no sequence numbers 599*9f91b7e3SAndre Fischer at this point are new. Otherwise no file has a sequence number yet. 600*9f91b7e3SAndre Fischer 601*9f91b7e3SAndre Fischer=cut 602*9f91b7e3SAndre Fischersub assign_missing_sequence_numbers ($) 603*9f91b7e3SAndre Fischer{ 604*9f91b7e3SAndre Fischer my ($file_list) = @_; 605*9f91b7e3SAndre Fischer 606*9f91b7e3SAndre Fischer # First, set up a hash on the sequence numbers that are already in use. 607*9f91b7e3SAndre Fischer my %used_sequence_numbers = (); 608*9f91b7e3SAndre Fischer foreach my $file (@$file_list) 609*9f91b7e3SAndre Fischer { 610*9f91b7e3SAndre Fischer next unless defined $file->{'sequencenumber'}; 611*9f91b7e3SAndre Fischer $used_sequence_numbers{$file->{'sequencenumber'}} = 1; 612*9f91b7e3SAndre Fischer } 613*9f91b7e3SAndre Fischer 614*9f91b7e3SAndre Fischer # Assign sequence numbers. Try consecutive numbers, starting at 1. 615*9f91b7e3SAndre Fischer my $current_sequence_number = 1; 616*9f91b7e3SAndre Fischer foreach my $file (@$file_list) 617*9f91b7e3SAndre Fischer { 618*9f91b7e3SAndre Fischer # Skip over all files that already have sequence numbers. 619*9f91b7e3SAndre Fischer next if defined $file->{'sequencenumber'}; 620*9f91b7e3SAndre Fischer 621*9f91b7e3SAndre Fischer # Find the next available number. 622*9f91b7e3SAndre Fischer while (defined $used_sequence_numbers{$current_sequence_number}) 623*9f91b7e3SAndre Fischer { 624*9f91b7e3SAndre Fischer ++$current_sequence_number; 625*9f91b7e3SAndre Fischer } 626*9f91b7e3SAndre Fischer 627*9f91b7e3SAndre Fischer # Use the number and mark it as used. 628*9f91b7e3SAndre Fischer $file->{'sequencenumber'} = $current_sequence_number; 629*9f91b7e3SAndre Fischer $used_sequence_numbers{$current_sequence_number} = 1; 630*9f91b7e3SAndre Fischer } 631*9f91b7e3SAndre Fischer} 632*9f91b7e3SAndre Fischer 633*9f91b7e3SAndre Fischer 634*9f91b7e3SAndre Fischer 635*9f91b7e3SAndre Fischer 636*9f91b7e3SAndre Fischersub create_items_for_missing_files ($$$) 637*9f91b7e3SAndre Fischer{ 638*9f91b7e3SAndre Fischer my ($missing_items, $msi, $directory_list) = @_; 639*9f91b7e3SAndre Fischer 640*9f91b7e3SAndre Fischer # For creation of the FeatureComponent table (in a later step) we 641*9f91b7e3SAndre Fischer # have to provide references from the file to component and 642*9f91b7e3SAndre Fischer # modules (ie features). Note that Each file belongs to exactly 643*9f91b7e3SAndre Fischer # one component but one component can belong to multiple features. 644*9f91b7e3SAndre Fischer my $component_to_features_map = create_feature_component_map($msi); 645*9f91b7e3SAndre Fischer 646*9f91b7e3SAndre Fischer my @new_files = (); 647*9f91b7e3SAndre Fischer foreach my $row (@$missing_items) 648*9f91b7e3SAndre Fischer { 649*9f91b7e3SAndre Fischer $installer::logger::Info->printf("creating new file item for '%s'\n", $row->GetValue('File')); 650*9f91b7e3SAndre Fischer my $file_item = create_script_item_for_deleted_file($row, $msi, $component_to_features_map); 651*9f91b7e3SAndre Fischer push @new_files, $file_item; 652*9f91b7e3SAndre Fischer } 653*9f91b7e3SAndre Fischer 654*9f91b7e3SAndre Fischer return @new_files; 655*9f91b7e3SAndre Fischer} 656*9f91b7e3SAndre Fischer 657*9f91b7e3SAndre Fischer 658*9f91b7e3SAndre Fischer 659*9f91b7e3SAndre Fischer 660*9f91b7e3SAndre Fischersub create_script_item_for_deleted_file ($$$) 661*9f91b7e3SAndre Fischer{ 662*9f91b7e3SAndre Fischer my ($file_row, $msi, $component_to_features_map) = @_; 663*9f91b7e3SAndre Fischer 664*9f91b7e3SAndre Fischer my $uniquename = $file_row->GetValue('File'); 665*9f91b7e3SAndre Fischer 666*9f91b7e3SAndre Fischer my $file_map = $msi->GetFileMap(); 667*9f91b7e3SAndre Fischer 668*9f91b7e3SAndre Fischer my $directory_item = $file_map->{$uniquename}->{'directory'}; 669*9f91b7e3SAndre Fischer my $source_path = $directory_item->{'full_source_long_name'}; 670*9f91b7e3SAndre Fischer my $target_path = $directory_item->{'full_target_long_name'}; 671*9f91b7e3SAndre Fischer my $full_source_name = File::Spec->catfile( 672*9f91b7e3SAndre Fischer installer::patch::InstallationSet::GetUnpackedCabPath( 673*9f91b7e3SAndre Fischer $msi->{'version'}, 674*9f91b7e3SAndre Fischer $msi->{'is_current_version'}, 675*9f91b7e3SAndre Fischer $msi->{'language'}, 676*9f91b7e3SAndre Fischer $msi->{'package_format'}, 677*9f91b7e3SAndre Fischer $msi->{'product_name'}), 678*9f91b7e3SAndre Fischer $source_path, 679*9f91b7e3SAndre Fischer $uniquename); 680*9f91b7e3SAndre Fischer my ($long_name, undef) = installer::patch::Msi::SplitLongShortName($file_row->GetValue("FileName")); 681*9f91b7e3SAndre Fischer my $target_name = File::Spec->catfile($target_path, $long_name); 682*9f91b7e3SAndre Fischer if ( ! -f $full_source_name) 683*9f91b7e3SAndre Fischer { 684*9f91b7e3SAndre Fischer installer::logger::PrintError("can not find file '%s' in previous version (tried '%s')\n", 685*9f91b7e3SAndre Fischer $uniquename, 686*9f91b7e3SAndre Fischer $full_source_name); 687*9f91b7e3SAndre Fischer return undef; 688*9f91b7e3SAndre Fischer } 689*9f91b7e3SAndre Fischer my $cygwin_full_source_name = qx(cygpath -w '$full_source_name'); 690*9f91b7e3SAndre Fischer my $component_name = $file_row->GetValue('Component_'); 691*9f91b7e3SAndre Fischer my $module_names = join(",", @{$component_to_features_map->{$component_name}}); 692*9f91b7e3SAndre Fischer my $sequence_number = $file_row->GetValue('Sequence'); 693*9f91b7e3SAndre Fischer 694*9f91b7e3SAndre Fischer return { 695*9f91b7e3SAndre Fischer 'uniquename' => $uniquename, 696*9f91b7e3SAndre Fischer 'destination' => $target_name, 697*9f91b7e3SAndre Fischer 'componentname' => $component_name, 698*9f91b7e3SAndre Fischer 'modules' => $module_names, 699*9f91b7e3SAndre Fischer 'UnixRights' => 444, 700*9f91b7e3SAndre Fischer 'Name' => $long_name, 701*9f91b7e3SAndre Fischer 'sourcepath' => $full_source_name, 702*9f91b7e3SAndre Fischer 'cyg_sourcepath' => $cygwin_full_source_name, 703*9f91b7e3SAndre Fischer 'sequencenumber' => $sequence_number 704*9f91b7e3SAndre Fischer }; 705*9f91b7e3SAndre Fischer} 706*9f91b7e3SAndre Fischer 707*9f91b7e3SAndre Fischer 708*9f91b7e3SAndre Fischer 709*9f91b7e3SAndre Fischer 710*9f91b7e3SAndre Fischer=head2 create_feature_component_maps($msi) 711*9f91b7e3SAndre Fischer 712*9f91b7e3SAndre Fischer Return a hash map that maps from component names to arrays of 713*9f91b7e3SAndre Fischer feature names. In most cases the array of features contains only 714*9f91b7e3SAndre Fischer one element. But there can be cases where the number is greater. 715*9f91b7e3SAndre Fischer 716*9f91b7e3SAndre Fischer=cut 717*9f91b7e3SAndre Fischersub create_feature_component_map ($) 718*9f91b7e3SAndre Fischer{ 719*9f91b7e3SAndre Fischer my ($msi) = @_; 720*9f91b7e3SAndre Fischer 721*9f91b7e3SAndre Fischer my $component_to_features_map = {}; 722*9f91b7e3SAndre Fischer my $feature_component_table = $msi->GetTable("FeatureComponents"); 723*9f91b7e3SAndre Fischer my $feature_column_index = $feature_component_table->GetColumnIndex("Feature_"); 724*9f91b7e3SAndre Fischer my $component_column_index = $feature_component_table->GetColumnIndex("Component_"); 725*9f91b7e3SAndre Fischer foreach my $row (@{$feature_component_table->GetAllRows()}) 726*9f91b7e3SAndre Fischer { 727*9f91b7e3SAndre Fischer my $feature = $row->GetValue($feature_column_index); 728*9f91b7e3SAndre Fischer my $component = $row->GetValue($component_column_index); 729*9f91b7e3SAndre Fischer if ( ! defined $component_to_features_map->{$component}) 730*9f91b7e3SAndre Fischer { 731*9f91b7e3SAndre Fischer $component_to_features_map->{$component} = [$feature]; 732*9f91b7e3SAndre Fischer } 733*9f91b7e3SAndre Fischer else 734*9f91b7e3SAndre Fischer { 735*9f91b7e3SAndre Fischer push @{$component_to_features_map->{$component}}, $feature; 736*9f91b7e3SAndre Fischer } 737*9f91b7e3SAndre Fischer } 738*9f91b7e3SAndre Fischer 739*9f91b7e3SAndre Fischer return $component_to_features_map; 740*9f91b7e3SAndre Fischer} 741*9f91b7e3SAndre Fischer 742*9f91b7e3SAndre Fischer 743cdf0e10cSrcweir############################################# 744cdf0e10cSrcweir# Returning the Windows language of a file 745cdf0e10cSrcweir############################################# 746cdf0e10cSrcweir 747cdf0e10cSrcweirsub get_language_for_file 748cdf0e10cSrcweir{ 749cdf0e10cSrcweir my ($fileref) = @_; 750cdf0e10cSrcweir 751cdf0e10cSrcweir my $language = ""; 752cdf0e10cSrcweir 753cdf0e10cSrcweir if ( $fileref->{'specificlanguage'} ) { $language = $fileref->{'specificlanguage'}; } 754cdf0e10cSrcweir 755cdf0e10cSrcweir if ( $language eq "" ) 756cdf0e10cSrcweir { 757cdf0e10cSrcweir $language = 0; # language independent 758cdf0e10cSrcweir # If this is not a font, the return value should be "0" (Check ICE 60) 759cdf0e10cSrcweir my $styles = ""; 760cdf0e10cSrcweir if ( $fileref->{'Styles'} ) { $styles = $fileref->{'Styles'}; } 761cdf0e10cSrcweir if ( $styles =~ /\bFONT\b/ ) { $language = ""; } 762cdf0e10cSrcweir } 763cdf0e10cSrcweir else 764cdf0e10cSrcweir { 765cdf0e10cSrcweir $language = installer::windows::language::get_windows_language($language); 766cdf0e10cSrcweir } 767cdf0e10cSrcweir 768cdf0e10cSrcweir return $language; 769cdf0e10cSrcweir} 770cdf0e10cSrcweir 771cdf0e10cSrcweir#################################################################### 772cdf0e10cSrcweir# Creating a new KeyPath for components in TemplatesFolder. 773cdf0e10cSrcweir#################################################################### 774cdf0e10cSrcweir 775cdf0e10cSrcweirsub generate_registry_keypath 776cdf0e10cSrcweir{ 777cdf0e10cSrcweir my ($onefile) = @_; 778cdf0e10cSrcweir 779cdf0e10cSrcweir my $keypath = $onefile->{'Name'}; 780cdf0e10cSrcweir $keypath =~ s/\.//g; 781cdf0e10cSrcweir $keypath = lc($keypath); 782cdf0e10cSrcweir $keypath = "userreg_" . $keypath; 783cdf0e10cSrcweir 784cdf0e10cSrcweir return $keypath; 785cdf0e10cSrcweir} 786cdf0e10cSrcweir 787*9f91b7e3SAndre Fischer 788cdf0e10cSrcweir################################################################### 789cdf0e10cSrcweir# Collecting further conditions for the component table. 790cdf0e10cSrcweir# This is used by multilayer products, to enable installation 791cdf0e10cSrcweir# of separate layers. 792cdf0e10cSrcweir################################################################### 793cdf0e10cSrcweir 794cdf0e10cSrcweirsub get_tree_condition_for_component 795cdf0e10cSrcweir{ 796cdf0e10cSrcweir my ($onefile, $componentname) = @_; 797cdf0e10cSrcweir 798cdf0e10cSrcweir if ( $onefile->{'destination'} ) 799cdf0e10cSrcweir { 800cdf0e10cSrcweir my $dest = $onefile->{'destination'}; 801cdf0e10cSrcweir 802cdf0e10cSrcweir # Comparing the destination path with 803cdf0e10cSrcweir # $installer::globals::hostnametreestyles{$hostname} = $treestyle; 804cdf0e10cSrcweir # (-> hostname is the key, the style the value!) 805cdf0e10cSrcweir 806cdf0e10cSrcweir foreach my $hostname ( keys %installer::globals::hostnametreestyles ) 807cdf0e10cSrcweir { 808cdf0e10cSrcweir if (( $dest eq $hostname ) || ( $dest =~ /^\s*\Q$hostname\E\\/ )) 809cdf0e10cSrcweir { 810cdf0e10cSrcweir # the value is the style 811cdf0e10cSrcweir my $style = $installer::globals::hostnametreestyles{$hostname}; 812cdf0e10cSrcweir # the condition is saved in %installer::globals::treestyles 813cdf0e10cSrcweir my $condition = $installer::globals::treestyles{$style}; 814cdf0e10cSrcweir # Saving condition to be added in table Property 815cdf0e10cSrcweir $installer::globals::usedtreeconditions{$condition} = 1; 816cdf0e10cSrcweir $condition = $condition . "=1"; 817cdf0e10cSrcweir # saving this condition 818cdf0e10cSrcweir $installer::globals::treeconditions{$componentname} = $condition; 819cdf0e10cSrcweir 820cdf0e10cSrcweir # saving also at the file, for usage in fileinfo 821cdf0e10cSrcweir $onefile->{'layer'} = $installer::globals::treelayername{$style}; 822cdf0e10cSrcweir } 823cdf0e10cSrcweir } 824cdf0e10cSrcweir } 825cdf0e10cSrcweir} 826cdf0e10cSrcweir 827cdf0e10cSrcweir############################################ 828cdf0e10cSrcweir# Collecting all short names, that are 829cdf0e10cSrcweir# already used by the old database 830cdf0e10cSrcweir############################################ 831cdf0e10cSrcweir 832cdf0e10cSrcweirsub collect_shortnames_from_old_database 833cdf0e10cSrcweir{ 834cdf0e10cSrcweir my ($uniquefilenamehashref, $shortnameshashref) = @_; 835cdf0e10cSrcweir 836cdf0e10cSrcweir foreach my $key ( keys %{$uniquefilenamehashref} ) 837cdf0e10cSrcweir { 838cdf0e10cSrcweir my $value = $uniquefilenamehashref->{$key}; # syntax of $value: ($uniquename;$shortname) 839cdf0e10cSrcweir 840cdf0e10cSrcweir if ( $value =~ /^\s*(.*?)\;\s*(.*?)\s*$/ ) 841cdf0e10cSrcweir { 842cdf0e10cSrcweir my $shortstring = $2; 843cdf0e10cSrcweir $shortnameshashref->{$shortstring} = 1; # adding the shortname to the array of all shortnames 844cdf0e10cSrcweir } 845cdf0e10cSrcweir } 846cdf0e10cSrcweir} 847cdf0e10cSrcweir 848cdf0e10cSrcweir 849*9f91b7e3SAndre Fischersub process_language_conditions ($) 850cdf0e10cSrcweir{ 851*9f91b7e3SAndre Fischer my ($onefile) = @_; 852*9f91b7e3SAndre Fischer 853*9f91b7e3SAndre Fischer # Collecting all languages specific conditions 854*9f91b7e3SAndre Fischer if ( $onefile->{'ismultilingual'} ) 855*9f91b7e3SAndre Fischer { 856*9f91b7e3SAndre Fischer if ( $onefile->{'ComponentCondition'} ) 857*9f91b7e3SAndre Fischer { 858*9f91b7e3SAndre Fischer installer::exiter::exit_program( 859*9f91b7e3SAndre Fischer "ERROR: Cannot set language condition. There is already another component condition for file $onefile->{'gid'}: \"$onefile->{'ComponentCondition'}\" !", "create_files_table"); 860*9f91b7e3SAndre Fischer } 861cdf0e10cSrcweir 862*9f91b7e3SAndre Fischer if ( $onefile->{'specificlanguage'} eq "" ) 863*9f91b7e3SAndre Fischer { 864*9f91b7e3SAndre Fischer installer::exiter::exit_program( 865*9f91b7e3SAndre Fischer "ERROR: There is no specific language for file at language module: $onefile->{'gid'} !", "create_files_table"); 866*9f91b7e3SAndre Fischer } 867*9f91b7e3SAndre Fischer my $locallanguage = $onefile->{'specificlanguage'}; 868*9f91b7e3SAndre Fischer my $property = "IS" . $onefile->{'windows_language'}; 869*9f91b7e3SAndre Fischer my $value = 1; 870*9f91b7e3SAndre Fischer my $condition = $property . "=" . $value; 871*9f91b7e3SAndre Fischer 872*9f91b7e3SAndre Fischer $onefile->{'ComponentCondition'} = $condition; 873*9f91b7e3SAndre Fischer 874*9f91b7e3SAndre Fischer if ( exists($installer::globals::componentcondition{$onefile->{'componentname'}})) 875*9f91b7e3SAndre Fischer { 876*9f91b7e3SAndre Fischer if ( $installer::globals::componentcondition{$onefile->{'componentname'}} ne $condition ) 877*9f91b7e3SAndre Fischer { 878*9f91b7e3SAndre Fischer installer::exiter::exit_program( 879*9f91b7e3SAndre Fischer sprintf( 880*9f91b7e3SAndre Fischer "ERROR: There is already another component condition for file %s: \"%s\" and \"%s\" !", 881*9f91b7e3SAndre Fischer $onefile->{'gid'}, 882*9f91b7e3SAndre Fischer $installer::globals::componentcondition{$onefile->{'componentname'}}, 883*9f91b7e3SAndre Fischer $condition), 884*9f91b7e3SAndre Fischer "create_files_table"); 885*9f91b7e3SAndre Fischer } 886*9f91b7e3SAndre Fischer } 887*9f91b7e3SAndre Fischer else 888*9f91b7e3SAndre Fischer { 889*9f91b7e3SAndre Fischer $installer::globals::componentcondition{$onefile->{'componentname'}} = $condition; 890*9f91b7e3SAndre Fischer } 891cdf0e10cSrcweir 892*9f91b7e3SAndre Fischer # collecting all properties for table Property 893*9f91b7e3SAndre Fischer if ( ! exists($installer::globals::languageproperties{$property}) ) 894*9f91b7e3SAndre Fischer { 895*9f91b7e3SAndre Fischer $installer::globals::languageproperties{$property} = $value; 896*9f91b7e3SAndre Fischer } 897*9f91b7e3SAndre Fischer } 898*9f91b7e3SAndre Fischer} 899cdf0e10cSrcweir 900cdf0e10cSrcweir 901cdf0e10cSrcweir 902cdf0e10cSrcweir 903*9f91b7e3SAndre Fischersub has_style ($$) 904*9f91b7e3SAndre Fischer{ 905*9f91b7e3SAndre Fischer my ($style_list_string, $style_name) = @_; 906cdf0e10cSrcweir 907*9f91b7e3SAndre Fischer return 0 unless defined $style_list_string; 908*9f91b7e3SAndre Fischer return $style_list_string =~ /\b$style_name\b/ ? 1 : 0; 909*9f91b7e3SAndre Fischer} 910cdf0e10cSrcweir 911cdf0e10cSrcweir 912cdf0e10cSrcweir 913cdf0e10cSrcweir 914*9f91b7e3SAndre Fischersub prepare_file_table_creation ($$$) 915*9f91b7e3SAndre Fischer{ 916*9f91b7e3SAndre Fischer my ($file_list, $directory_list, $allvariables) = @_; 917*9f91b7e3SAndre Fischer 918*9f91b7e3SAndre Fischer if ( $^O =~ /cygwin/i ) 919*9f91b7e3SAndre Fischer { 920*9f91b7e3SAndre Fischer installer::worker::generate_cygwin_pathes($file_list); 921*9f91b7e3SAndre Fischer } 922cdf0e10cSrcweir 923*9f91b7e3SAndre Fischer # Reset the fields 'sequencenumber' and 'uniquename'. They should not yet exist but better be sure. 924*9f91b7e3SAndre Fischer foreach my $file (@$file_list) 925*9f91b7e3SAndre Fischer { 926*9f91b7e3SAndre Fischer delete $file->{'sequencenumber'}; 927*9f91b7e3SAndre Fischer delete $file->{'uniquename'}; 928*9f91b7e3SAndre Fischer } 929cdf0e10cSrcweir 930*9f91b7e3SAndre Fischer # Create FileSequenceList object for the old sequence data. 931*9f91b7e3SAndre Fischer if (defined $installer::globals::source_msi) 932*9f91b7e3SAndre Fischer { 933*9f91b7e3SAndre Fischer my $previous_sequence_data = new installer::patch::FileSequenceList(); 934*9f91b7e3SAndre Fischer $previous_sequence_data->SetFromMsi($installer::globals::source_msi); 935*9f91b7e3SAndre Fischer my @added_files = retrieve_sequence_and_uniquename($file_list, $previous_sequence_data); 936*9f91b7e3SAndre Fischer 937*9f91b7e3SAndre Fischer # Extract just the unique names. 938*9f91b7e3SAndre Fischer my %target_unique_names = map {$_->{'uniquename'} => 1} @$file_list; 939*9f91b7e3SAndre Fischer my @removed_items = $previous_sequence_data->get_removed_files(\%target_unique_names); 940*9f91b7e3SAndre Fischer 941*9f91b7e3SAndre Fischer $installer::logger::Lang->printf( 942*9f91b7e3SAndre Fischer "there are %d files that have been removed from source and %d files added\n", 943*9f91b7e3SAndre Fischer scalar @removed_items, 944*9f91b7e3SAndre Fischer scalar @added_files); 945*9f91b7e3SAndre Fischer 946*9f91b7e3SAndre Fischer my $file_map = $installer::globals::source_msi->GetFileMap(); 947*9f91b7e3SAndre Fischer my $index = 0; 948*9f91b7e3SAndre Fischer foreach my $removed_row (@removed_items) 949*9f91b7e3SAndre Fischer { 950*9f91b7e3SAndre Fischer $installer::logger::Lang->printf(" removed file %d: %s\n", 951*9f91b7e3SAndre Fischer ++$index, 952*9f91b7e3SAndre Fischer $removed_row->GetValue('File')); 953*9f91b7e3SAndre Fischer my $directory = $file_map->{$removed_row->GetValue('File')}->{'directory'}; 954*9f91b7e3SAndre Fischer while (my ($key,$value) = each %$directory) 955*9f91b7e3SAndre Fischer { 956*9f91b7e3SAndre Fischer $installer::logger::Lang->printf(" %16s -> %s\n", $key, $value); 957*9f91b7e3SAndre Fischer } 958*9f91b7e3SAndre Fischer } 959*9f91b7e3SAndre Fischer $index = 0; 960*9f91b7e3SAndre Fischer foreach my $added_file (@added_files) 961*9f91b7e3SAndre Fischer { 962*9f91b7e3SAndre Fischer $installer::logger::Lang->printf(" added file %d: %s\n", 963*9f91b7e3SAndre Fischer ++$index, 964*9f91b7e3SAndre Fischer $added_file->{'uniquename'}); 965*9f91b7e3SAndre Fischer installer::scriptitems::print_script_item($added_file); 966*9f91b7e3SAndre Fischer } 967*9f91b7e3SAndre Fischer my @new_files = create_items_for_missing_files( 968*9f91b7e3SAndre Fischer \@removed_items, 969*9f91b7e3SAndre Fischer $installer::globals::source_msi, 970*9f91b7e3SAndre Fischer $directory_list); 971*9f91b7e3SAndre Fischer push @$file_list, @new_files; 972*9f91b7e3SAndre Fischer } 973*9f91b7e3SAndre Fischer assign_missing_sequence_numbers($file_list); 974cdf0e10cSrcweir 975*9f91b7e3SAndre Fischer foreach my $file (@$file_list) 976*9f91b7e3SAndre Fischer { 977*9f91b7e3SAndre Fischer if ( ! defined $file->{'componentname'}) 978*9f91b7e3SAndre Fischer { 979*9f91b7e3SAndre Fischer $file->{'componentname'} = get_file_component_name($file, $file_list); 980*9f91b7e3SAndre Fischer } 981*9f91b7e3SAndre Fischer if ( ! defined $file->{'uniquename'}) 982*9f91b7e3SAndre Fischer { 983*9f91b7e3SAndre Fischer $file->{'uniquename'} = generate_unique_filename_for_filetable($file->{'Name'}); 984*9f91b7e3SAndre Fischer } 985cdf0e10cSrcweir 986cdf0e10cSrcweir # Collecting all component conditions 987*9f91b7e3SAndre Fischer if ( $file->{'ComponentCondition'} ) 988cdf0e10cSrcweir { 989*9f91b7e3SAndre Fischer if ( ! exists($installer::globals::componentcondition{$file->{'componentname'}})) 990cdf0e10cSrcweir { 991*9f91b7e3SAndre Fischer $installer::globals::componentcondition{$file->{'componentname'}} 992*9f91b7e3SAndre Fischer = $file->{'ComponentCondition'}; 993cdf0e10cSrcweir } 994cdf0e10cSrcweir } 995cdf0e10cSrcweir # Collecting also all tree conditions for multilayer products 996*9f91b7e3SAndre Fischer get_tree_condition_for_component($file, $file->{'componentname'}); 997cdf0e10cSrcweir 998cdf0e10cSrcweir # Collecting all component names, that have flag VERSION_INDEPENDENT_COMP_ID 999cdf0e10cSrcweir # This should be all components with constant API, for example URE 1000*9f91b7e3SAndre Fischer if (has_style($file->{'Styles'}, "VERSION_INDEPENDENT_COMP_ID")) 1001cdf0e10cSrcweir { 1002*9f91b7e3SAndre Fischer $installer::globals::base_independent_components{$file->{'componentname'}} = 1; 1003cdf0e10cSrcweir } 1004cdf0e10cSrcweir 1005*9f91b7e3SAndre Fischer # Special handling for files in PREDEFINED_OSSHELLNEWDIR. These components 1006*9f91b7e3SAndre Fischer # need as KeyPath a RegistryItem in HKCU 1007*9f91b7e3SAndre Fischer if ($file->{'needs_user_registry_key'} 1008*9f91b7e3SAndre Fischer || (defined $file->{'Dir'} && $file->{'Dir'} =~ /\bPREDEFINED_OSSHELLNEWDIR\b/)) 1009*9f91b7e3SAndre Fischer { 1010*9f91b7e3SAndre Fischer my $keypath = generate_registry_keypath($file); 1011*9f91b7e3SAndre Fischer $file->{'userregkeypath'} = $keypath; 1012*9f91b7e3SAndre Fischer push(@installer::globals::userregistrycollector, $file); 1013*9f91b7e3SAndre Fischer $installer::globals::addeduserregitrykeys = 1; 1014*9f91b7e3SAndre Fischer } 1015cdf0e10cSrcweir 1016*9f91b7e3SAndre Fischer $file->{'windows_language'} = get_language_for_file($file); 1017cdf0e10cSrcweir 1018*9f91b7e3SAndre Fischer process_language_conditions($file); 1019*9f91b7e3SAndre Fischer } 1020cdf0e10cSrcweir 1021*9f91b7e3SAndre Fischer # The filenames must be collected because of uniqueness 1022*9f91b7e3SAndre Fischer # 01-44-~1.DAT, 01-44-~2.DAT, ... 1023*9f91b7e3SAndre Fischer my %shortnames = (); 1024*9f91b7e3SAndre Fischer foreach my $file (@$file_list) 1025*9f91b7e3SAndre Fischer { 1026*9f91b7e3SAndre Fischer $file->{'short_name'} = generate_filename_for_filetable($file, \%shortnames); 1027*9f91b7e3SAndre Fischer } 1028*9f91b7e3SAndre Fischer} 1029cdf0e10cSrcweir 1030cdf0e10cSrcweir 1031cdf0e10cSrcweir 1032cdf0e10cSrcweir 1033*9f91b7e3SAndre Fischersub create_file_table_data ($$) 1034*9f91b7e3SAndre Fischer{ 1035*9f91b7e3SAndre Fischer my ($file_list, $allvariables) = @_; 1036*9f91b7e3SAndre Fischer 1037*9f91b7e3SAndre Fischer my @file_table_data = (); 1038*9f91b7e3SAndre Fischer foreach my $file (@$file_list) 1039*9f91b7e3SAndre Fischer { 1040*9f91b7e3SAndre Fischer my $attributes; 1041*9f91b7e3SAndre Fischer if (has_style($file->{'Styles'}, "DONT_PACK")) 1042*9f91b7e3SAndre Fischer { 1043*9f91b7e3SAndre Fischer # Sourcefile is unpacked (msidbFileAttributesNoncompressed). 1044*9f91b7e3SAndre Fischer $attributes = "8192"; 1045*9f91b7e3SAndre Fischer } 1046*9f91b7e3SAndre Fischer else 1047*9f91b7e3SAndre Fischer { 1048*9f91b7e3SAndre Fischer # Sourcefile is packed (msidbFileAttributesCompressed). 1049*9f91b7e3SAndre Fischer $attributes = "16384"; 1050*9f91b7e3SAndre Fischer } 1051cdf0e10cSrcweir 1052*9f91b7e3SAndre Fischer my $row_data = { 1053*9f91b7e3SAndre Fischer 'File' => $file->{'uniquename'}, 1054*9f91b7e3SAndre Fischer 'Component_' => $file->{'componentname'}, 1055*9f91b7e3SAndre Fischer 'FileName' => $file->{'short_name'}, 1056*9f91b7e3SAndre Fischer 'FileSize' => get_filesize($file), 1057*9f91b7e3SAndre Fischer 'Version' => get_fileversion($file, $allvariables), 1058*9f91b7e3SAndre Fischer 'Language' => $file->{'windows_language'}, 1059*9f91b7e3SAndre Fischer 'Attributes' => $attributes, 1060*9f91b7e3SAndre Fischer 'Sequence' => $file->{'sequencenumber'} 1061*9f91b7e3SAndre Fischer }; 1062*9f91b7e3SAndre Fischer push @file_table_data, $row_data; 1063cdf0e10cSrcweir } 1064cdf0e10cSrcweir 1065*9f91b7e3SAndre Fischer return \@file_table_data; 1066*9f91b7e3SAndre Fischer} 1067*9f91b7e3SAndre Fischer 1068*9f91b7e3SAndre Fischer 1069*9f91b7e3SAndre Fischer 1070*9f91b7e3SAndre Fischer 1071*9f91b7e3SAndre Fischersub collect_components ($) 1072*9f91b7e3SAndre Fischer{ 1073*9f91b7e3SAndre Fischer my ($file_list) = @_; 1074*9f91b7e3SAndre Fischer 1075*9f91b7e3SAndre Fischer my %components = (); 1076*9f91b7e3SAndre Fischer foreach my $file (@$file_list) 1077*9f91b7e3SAndre Fischer { 1078*9f91b7e3SAndre Fischer $components{$file->{'componentname'}} = 1; 1079*9f91b7e3SAndre Fischer } 1080*9f91b7e3SAndre Fischer return keys %components; 1081*9f91b7e3SAndre Fischer} 1082*9f91b7e3SAndre Fischer 1083*9f91b7e3SAndre Fischer 1084*9f91b7e3SAndre Fischer 1085*9f91b7e3SAndre Fischer 1086*9f91b7e3SAndre Fischer=head filter_files($file_list, $allvariables) 1087*9f91b7e3SAndre Fischer 1088*9f91b7e3SAndre Fischer Filter out Java files when not building a Java product. 1089*9f91b7e3SAndre Fischer 1090*9f91b7e3SAndre Fischer Is this still triggered? 1091*9f91b7e3SAndre Fischer 1092*9f91b7e3SAndre Fischer=cut 1093*9f91b7e3SAndre Fischersub filter_files ($$) 1094*9f91b7e3SAndre Fischer{ 1095*9f91b7e3SAndre Fischer my ($file_list, $allvariables) = @_; 1096*9f91b7e3SAndre Fischer 1097*9f91b7e3SAndre Fischer if ($allvariables->{'JAVAPRODUCT'}) 1098*9f91b7e3SAndre Fischer { 1099*9f91b7e3SAndre Fischer return $file_list; 1100*9f91b7e3SAndre Fischer } 1101*9f91b7e3SAndre Fischer else 1102*9f91b7e3SAndre Fischer { 1103*9f91b7e3SAndre Fischer my @filtered_files = (); 1104*9f91b7e3SAndre Fischer foreach my $file (@$file_list) 1105*9f91b7e3SAndre Fischer { 1106*9f91b7e3SAndre Fischer if ( ! has_style($file->{'Styles'}, "JAVAFILE")) 1107*9f91b7e3SAndre Fischer { 1108*9f91b7e3SAndre Fischer push @filtered_files, $file; 1109*9f91b7e3SAndre Fischer } 1110*9f91b7e3SAndre Fischer } 1111*9f91b7e3SAndre Fischer return \@filtered_files; 1112*9f91b7e3SAndre Fischer } 1113*9f91b7e3SAndre Fischer} 1114cdf0e10cSrcweir 1115*9f91b7e3SAndre Fischer 1116*9f91b7e3SAndre Fischer 1117*9f91b7e3SAndre Fischer 1118*9f91b7e3SAndre Fischer# Structure of the files table: 1119*9f91b7e3SAndre Fischer# File Component_ FileName FileSize Version Language Attributes Sequence 1120*9f91b7e3SAndre Fischersub create_file_table ($$) 1121*9f91b7e3SAndre Fischer{ 1122*9f91b7e3SAndre Fischer my ($file_table_data, $basedir) = @_; 1123*9f91b7e3SAndre Fischer 1124*9f91b7e3SAndre Fischer # Set up the 'File' table. 1125*9f91b7e3SAndre Fischer my @filetable = (); 1126*9f91b7e3SAndre Fischer installer::windows::idtglobal::write_idt_header(\@filetable, "file"); 1127*9f91b7e3SAndre Fischer my @keys = ('File', 'Component_', 'FileName', 'FileSize', 'Version', 'Language', 'Attributes', 'Sequence'); 1128*9f91b7e3SAndre Fischer my $index = 0; 1129*9f91b7e3SAndre Fischer foreach my $row_data (@$file_table_data) 1130*9f91b7e3SAndre Fischer { 1131*9f91b7e3SAndre Fischer ++$index; 1132*9f91b7e3SAndre Fischer my @values = map {$row_data->{$_}} @keys; 1133*9f91b7e3SAndre Fischer my $line = join("\t", @values) . "\n"; 1134*9f91b7e3SAndre Fischer push(@filetable, $line); 1135*9f91b7e3SAndre Fischer } 1136*9f91b7e3SAndre Fischer 1137*9f91b7e3SAndre Fischer my $filetablename = $basedir . $installer::globals::separator . "File.idt"; 1138cdf0e10cSrcweir installer::files::save_file($filetablename ,\@filetable); 1139b274bc22SAndre Fischer $installer::logger::Lang->print("\n"); 1140b274bc22SAndre Fischer $installer::logger::Lang->printf("Created idt file: %s\n", $filetablename); 1141*9f91b7e3SAndre Fischer} 1142cdf0e10cSrcweir 1143cdf0e10cSrcweir 1144cdf0e10cSrcweir 1145*9f91b7e3SAndre Fischer 1146*9f91b7e3SAndre Fischersub create_filehash_table ($$) 1147*9f91b7e3SAndre Fischer{ 1148*9f91b7e3SAndre Fischer my ($file_list, $basedir) = @_; 1149*9f91b7e3SAndre Fischer 1150*9f91b7e3SAndre Fischer my @filehashtable = (); 1151*9f91b7e3SAndre Fischer 1152*9f91b7e3SAndre Fischer if ( $installer::globals::prepare_winpatch ) 1153*9f91b7e3SAndre Fischer { 1154*9f91b7e3SAndre Fischer 1155*9f91b7e3SAndre Fischer installer::windows::idtglobal::write_idt_header(\@filehashtable, "filehash"); 1156*9f91b7e3SAndre Fischer 1157*9f91b7e3SAndre Fischer foreach my $file (@$file_list) 1158*9f91b7e3SAndre Fischer { 1159*9f91b7e3SAndre Fischer my $path = $file->{'sourcepath'}; 1160*9f91b7e3SAndre Fischer if ($^O =~ /cygwin/i) 1161*9f91b7e3SAndre Fischer { 1162*9f91b7e3SAndre Fischer $path = $file->{'cyg_sourcepath'}; 1163*9f91b7e3SAndre Fischer } 1164*9f91b7e3SAndre Fischer 1165*9f91b7e3SAndre Fischer open(FILE, $path) or die "ERROR: Can't open $path for creating file hash"; 1166*9f91b7e3SAndre Fischer binmode(FILE); 1167*9f91b7e3SAndre Fischer my $hashinfo = pack("l", 20); 1168*9f91b7e3SAndre Fischer $hashinfo .= Digest::MD5->new->addfile(*FILE)->digest; 1169*9f91b7e3SAndre Fischer 1170*9f91b7e3SAndre Fischer my @i = unpack ('x[l]l4', $hashinfo); 1171*9f91b7e3SAndre Fischer my $oneline = join("\t", 1172*9f91b7e3SAndre Fischer ( 1173*9f91b7e3SAndre Fischer $file->{'uniquename'}, 1174*9f91b7e3SAndre Fischer "0", 1175*9f91b7e3SAndre Fischer @i 1176*9f91b7e3SAndre Fischer )); 1177*9f91b7e3SAndre Fischer push (@filehashtable, $oneline . "\n"); 1178*9f91b7e3SAndre Fischer } 1179*9f91b7e3SAndre Fischer 1180*9f91b7e3SAndre Fischer my $filehashtablename = $basedir . $installer::globals::separator . "MsiFileHash.idt"; 1181*9f91b7e3SAndre Fischer installer::files::save_file($filehashtablename ,\@filehashtable); 1182*9f91b7e3SAndre Fischer $installer::logger::Lang->print("\n"); 1183*9f91b7e3SAndre Fischer $installer::logger::Lang->printf("Created idt file: %s\n", $filehashtablename); 1184*9f91b7e3SAndre Fischer } 1185cdf0e10cSrcweir} 1186cdf0e10cSrcweir 1187*9f91b7e3SAndre Fischer 1188cdf0e10cSrcweir1; 1189